1 package Vector; 2 # 3 # $RCSfile: Vector.pm,v $ 4 # $Date: 2015/02/28 20:47:30 $ 5 # $Revision: 1.34 $ 6 # 7 # Author: Manish Sud <msud@san.rr.com> 8 # 9 # Copyright (C) 2015 Manish Sud. All rights reserved. 10 # 11 # This file is part of MayaChemTools. 12 # 13 # MayaChemTools is free software; you can redistribute it and/or modify it under 14 # the terms of the GNU Lesser General Public License as published by the Free 15 # Software Foundation; either version 3 of the License, or (at your option) any 16 # later version. 17 # 18 # MayaChemTools is distributed in the hope that it will be useful, but without 19 # any warranty; without even the implied warranty of merchantability of fitness 20 # for a particular purpose. See the GNU Lesser General Public License for more 21 # details. 22 # 23 # You should have received a copy of the GNU Lesser General Public License 24 # along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or 25 # write to the Free Software Foundation Inc., 59 Temple Place, Suite 330, 26 # Boston, MA, 02111-1307, USA. 27 # 28 29 use strict; 30 use Carp; 31 use Exporter; 32 use Scalar::Util (); 33 use StatisticsUtil (); 34 35 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); 36 37 @ISA = qw(Exporter); 38 @EXPORT = qw(IsVector UnitXVector UnitYVector UnitZVector UnitVector ZeroVector); 39 @EXPORT_OK = qw(SetValuePrintFormat); 40 41 %EXPORT_TAGS = ( 42 all => [@EXPORT, @EXPORT_OK] 43 ); 44 45 # Setup class variables... 46 my($ClassName, $ValueFormat); 47 _InitializeClass(); 48 49 # 50 # Using the following explicity overloaded operators, Perl automatically generates methods 51 # for operations with no explicitly defined methods. Autogenerated methods are possible for 52 # these operators: 53 # 54 # o Arithmetic operators: += -= *= /= **= %= ++ -- x= .= 55 # o Increment and decrement: ++ -- 56 # 57 # 'fallback' is set to 'false' to raise exception for all other operators. 58 # 59 use overload '""' => 'StringifyVector', 60 61 '0+' => '_NumifyVector', 62 63 '@{}' => '_VectorToArrayOperator', 64 65 '+' => '_VectorAdditionOperator', 66 '-' => '_VectorSubtractionOperator', 67 '*' => '_VectorMultiplicationOperator', 68 '/' => '_VectorDivisionOperator', 69 '**' => '_VectorExponentiationOperator', 70 '%' => '_VectorModulusOperator', 71 72 'x' => '_VectorCrossProductOperator', 73 '.' => '_VectorDotProductOperator', 74 75 'bool' => '_VectorBooleanOperator', 76 '!' => '_VectorNotBooleanOperator', 77 78 '==' => '_VectorEqualOperator', 79 '!=' => '_VectorNotEqualOperator', 80 '<' => '_VectorLessThanOperator', 81 '<=' => '_VectorLessThanEqualOperator', 82 '>' => '_VectorGreatarThanOperator', 83 '>=' => '_VectorGreatarThanEqualOperator', 84 85 'neg' => '_VectorNegativeValueOperator', 86 87 'abs' => '_VectorAbsoluteValueOperator', 88 'exp' => '_VectorExpNaturalBaseOperator', 89 'log' => '_VectorLogNaturalBaseOperator', 90 'sqrt' => '_VectorSquareRootOperator', 91 'cos' => '_VectorCosineOperator', 92 'sin' => '_VectorSineOperator', 93 94 'fallback' => undef; 95 96 # Class constructor... 97 sub new { 98 my($Class, @Values) = @_; 99 100 # Initialize object... 101 my $This = {}; 102 bless $This, ref($Class) || $Class; 103 $This->_InitializeVector(); 104 105 $This->_AddValues(@Values); 106 107 return $This; 108 } 109 110 # Initialize object data... 111 # 112 sub _InitializeVector { 113 my($This) = @_; 114 115 @{$This->{Values}} = (); 116 } 117 118 # Initialize class ... 119 sub _InitializeClass { 120 #Class name... 121 $ClassName = __PACKAGE__; 122 123 # Print format for vector values... 124 $ValueFormat = "%g"; 125 } 126 127 # Initialize vector values using: 128 # o List of values 129 # o Reference to an list of values 130 # o Another vector object 131 # 132 sub _AddValues { 133 my($This, @Values) = @_; 134 135 if (!@Values) { 136 return; 137 } 138 139 # Set vector values... 140 my($FirstValue, $TypeOfFirstValue); 141 $FirstValue = $Values[0]; 142 $TypeOfFirstValue = ref $FirstValue; 143 if ($TypeOfFirstValue =~ /^(SCALAR|HASH|CODE|REF|GLOB)/) { 144 croak "Error: ${ClassName}->_AddValues: Trying to add values to vector object with a reference to unsupported value format..."; 145 } 146 147 if (_IsVector($FirstValue)) { 148 # Initialize using Vector... 149 push @{$This->{Values}}, @{$FirstValue->{Values}}; 150 } 151 elsif ($TypeOfFirstValue =~ /^ARRAY/) { 152 # Initialize using array refernce... 153 push @{$This->{Values}}, @{$FirstValue}; 154 } 155 else { 156 # It's a list of values... 157 push @{$This->{Values}}, @Values; 158 } 159 } 160 161 # Add values to a vector using a vector, reference to an array or an array... 162 sub AddValues { 163 my($This, @Values) = @_; 164 165 $This->_AddValues(@Values); 166 167 return $This; 168 } 169 170 # Copy vector... 171 sub Copy { 172 my($This) = @_; 173 my($Vector); 174 175 # Copy vector values... 176 $Vector = (ref $This)->new(\@{$This->{Values}}); 177 178 # Copy value format for stringification... 179 if (exists $This->{ValueFormat}) { 180 $Vector->{ValueFormat} = $This->{ValueFormat}; 181 } 182 return $Vector; 183 } 184 185 # Get 3D vector length... 186 sub GetLength { 187 my($This) = @_; 188 189 if ($This->GetSize() != 3) { 190 croak "Error: ${ClassName}->GetGetLength: Object must be a 3D vector..."; 191 } 192 my($Length, $DotProduct); 193 $DotProduct = $This . $This; 194 $Length = sqrt $DotProduct; 195 196 return $Length; 197 } 198 199 # Length of a 3D vector by another name... 200 sub GetMagnitude { 201 my($This) = @_; 202 return $This->GetLength(); 203 } 204 205 # Normalize 3D vector... 206 sub Normalize { 207 my($This) = @_; 208 209 if ($This->GetSize() != 3) { 210 croak "Error: ${ClassName}->GetGetLength: Object must be a 3D vector..."; 211 } 212 my($Vector, $Length); 213 $Length = $This->GetLength(); 214 $Vector = $This / $Length; 215 216 return $Vector; 217 } 218 219 # Is it a vector object? 220 sub IsVector ($) { 221 my($Object) = @_; 222 223 return _IsVector($Object); 224 } 225 226 # Get size... 227 sub GetSize { 228 my($This) = @_; 229 230 return scalar @{$This->{Values}}; 231 } 232 233 # Get X value of a 3D vector... 234 sub GetX { 235 my($This) = @_; 236 237 if ($This->GetSize() != 3) { 238 croak "Error: ${ClassName}->GetX: Object must be a 3D vector..."; 239 } 240 return $This->_GetValue(0); 241 } 242 243 # Set X value of a 3D vector... 244 sub SetX { 245 my($This, $Value) = @_; 246 247 if ($This->GetSize() != 3) { 248 croak "Error: ${ClassName}->SetX: Object must be a 3D vector..."; 249 } 250 return $This->_SetValue(0, $Value); 251 } 252 253 # Get Y value of a 3D vector... 254 sub GetY { 255 my($This) = @_; 256 257 if ($This->GetSize() != 3) { 258 croak "Error: ${ClassName}->GetY: Object must be a 3D vector..."; 259 } 260 return $This->_GetValue(1); 261 } 262 263 # Set Y value of a 3D vector... 264 sub SetY { 265 my($This, $Value) = @_; 266 267 if ($This->GetSize() != 3) { 268 croak "Error: ${ClassName}->SetY: Object must be a 3D vector..."; 269 } 270 return $This->_SetValue(1, $Value); 271 } 272 273 # Get Z value of a 3D vector... 274 sub GetZ { 275 my($This) = @_; 276 277 if ($This->GetSize() != 3) { 278 croak "Error: ${ClassName}->GetZ: Object must be a 3D vector..."; 279 } 280 return $This->_GetValue(2); 281 } 282 283 # Set Z value of a 3D vector... 284 sub SetZ { 285 my($This, $Value) = @_; 286 287 if ($This->GetSize() != 3) { 288 croak "Error: ${ClassName}->SetZ: Object must be a 3D vector..."; 289 } 290 return $This->_SetValue(2, $Value); 291 } 292 293 # Set XYZ value of a 3D vector using: 294 # o List of values 295 # o Reference to an list of values 296 # o Another vector object 297 # 298 sub SetXYZ { 299 my($This, @Values) = @_; 300 301 if (!@Values) { 302 croak "Error: ${ClassName}->SetXYZ: No values specified..."; 303 } 304 305 if ($This->GetSize() != 3) { 306 croak "Error: ${ClassName}->SetXYZ: Object must be a 3D vector..."; 307 } 308 309 # Set vector values... 310 my($FirstValue, $TypeOfFirstValue); 311 $FirstValue = $Values[0]; 312 $TypeOfFirstValue = ref $FirstValue; 313 if ($TypeOfFirstValue =~ /^(SCALAR|HASH|CODE|REF|GLOB)/) { 314 croak "Error: ${ClassName}->SetXYZ: A reference to unsupported value format specified..."; 315 } 316 317 my($X, $Y, $Z); 318 if (_IsVector($FirstValue)) { 319 # SetXYZ using vector... 320 if ($FirstValue->GetSize() != 3) { 321 croak "Error: ${ClassName}->SetXYZ: Input object must be a 3D vector..."; 322 } 323 ($X, $Y, $Z) = @{$FirstValue->{Values}}; 324 } 325 elsif ($TypeOfFirstValue =~ /^ARRAY/) { 326 # SetXYZ using array reference... 327 if (@{$FirstValue} != 3) { 328 croak "Error: ${ClassName}->SetXYZ: Input array reference must correspond to an array with three values..."; 329 } 330 ($X, $Y, $Z) = @{$FirstValue}; 331 } 332 else { 333 # It's a list of values... 334 if (@Values != 3) { 335 croak "Error: ${ClassName}->SetXYZ: Input array must contain three values..."; 336 } 337 ($X, $Y, $Z) = @Values; 338 } 339 $This->{Values}[0] = $X; 340 $This->{Values}[1] = $Y; 341 $This->{Values}[2] = $Z; 342 343 return $This; 344 } 345 346 # Get XYZ as an array or a reference to an array... 347 # 348 sub GetXYZ { 349 my($This) = @_; 350 351 if ($This->GetSize() != 3) { 352 croak "Error: ${ClassName}->GetXYZ: Object must be a 3D vector..."; 353 } 354 return wantarray ? @{$This->{Values}} : \@{$This->{Values}}; 355 } 356 357 # Get a specific value from vector with indicies starting from 0.. 358 sub GetValue { 359 my($This, $Index) = @_; 360 361 if ($Index < 0) { 362 croak "Error: ${ClassName}->GetValue: Index value must be a positive number..."; 363 } 364 if ($Index >= $This->GetSize()) { 365 croak "Error: ${ClassName}->GetValue: Index value must be less than size of vector..."; 366 } 367 return $This->_GetValue($Index); 368 } 369 370 # Get a vector value... 371 sub _GetValue { 372 my($This, $Index) = @_; 373 374 return $This->{Values}[$Index]; 375 } 376 377 # Set a specific value in vector with indicies starting from 0.. 378 sub SetValue { 379 my($This, $Index, $Value, $SkipCheck) = @_; 380 381 # Just set it... 382 if ($SkipCheck) { 383 return $This->_SetValue($Index, $Value); 384 } 385 386 # Check and set... 387 if ($Index < 0) { 388 croak "Error: ${ClassName}->SetValue: Index value must be a positive number..."; 389 } 390 if ($Index >= $This->GetSize()) { 391 croak "Error: ${ClassName}->SetValue: Index vaue must be less than size of vector..."; 392 } 393 394 return $This->_SetValue($Index, $Value); 395 } 396 397 # Set a vector value... 398 sub _SetValue { 399 my($This, $Index, $Value) = @_; 400 401 $This->{Values}[$Index] = $Value; 402 403 return $This; 404 } 405 406 # Return vector values as an array or reference to an array... 407 sub GetValues { 408 my($This) = @_; 409 410 return wantarray ? @{$This->{Values}} : \@{$This->{Values}}; 411 } 412 413 # Get number of non-zero values in vector... 414 # 415 sub GetNumOfNonZeroValues { 416 my($This) = @_; 417 my($Count, $Index, $Size); 418 419 $Count = 0; 420 $Size = $This->GetSize(); 421 422 for $Index (0 .. ($Size -1)) { 423 if ($This->{Values}[$Index] != 0) { 424 $Count++; 425 } 426 } 427 return $Count; 428 } 429 430 # Get percent of non-zero values... 431 # 432 sub GetPercentOfNonZeroValues { 433 my($This) = @_; 434 435 return $This->GetSize() ? (($This->GetNumOfNonZeroValues()/$This->GetSize())*100) : 0; 436 } 437 438 # Set value print format for an individual object or the whole class... 439 sub SetValuePrintFormat ($;$) { 440 my($FirstParameter, $SecondParameter) = @_; 441 442 if ((@_ == 2) && (_IsVector($FirstParameter))) { 443 # Set value print format for the specific object... 444 my($This, $ValuePrintFormat) = ($FirstParameter, $SecondParameter); 445 446 $This->{ValueFormat} = $ValuePrintFormat; 447 } 448 else { 449 # Set value print format for the class... 450 my($ValuePrintFormat) = ($FirstParameter); 451 452 $ValueFormat = $ValuePrintFormat; 453 } 454 } 455 456 # Zero vector of specified size or size 3... 457 sub ZeroVector (;$) { 458 my($Size) = @_; 459 my($Vector, @Values); 460 461 $Size = (defined $Size) ? $Size : 3; 462 @Values = ('0') x $Size; 463 464 $Vector = new Vector(\@Values); 465 return $Vector; 466 } 467 468 # Unit vector of specified size or size 3... 469 sub UnitVector (;$) { 470 my($Size) = @_; 471 my($Vector, @Values); 472 473 $Size = (defined $Size) ? $Size : 3; 474 @Values = ('1') x $Size; 475 476 $Vector = new Vector(\@Values); 477 return $Vector; 478 } 479 480 # Unit X vector of size 3... 481 sub UnitXVector () { 482 my($Vector); 483 484 $Vector = new Vector(1, 0, 0); 485 return $Vector; 486 } 487 488 # Unit Y vector of size 3... 489 sub UnitYVector () { 490 my($Vector); 491 492 $Vector = new Vector(0, 1, 0); 493 return $Vector; 494 } 495 496 # Unit Z vector of size 3... 497 sub UnitZVector () { 498 my($Vector); 499 500 $Vector = new Vector(0, 0, 1); 501 return $Vector; 502 } 503 504 # 505 # Vector addition operator supports two addition modes: 506 # . Addition of two vectors by adding corresponding vector values 507 # . Addition of a scalar value to vector values ($Vector + 1) 508 # 509 # Caveats: 510 # . Addition of a vector to scalar is not allowed (1 + $Vector) 511 # 512 sub _VectorAdditionOperator { 513 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 514 515 $ErrorMsg = "_VectorAdditionOperator: Vector addition failed"; 516 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 517 518 # Do the addition. Order can be ignored: It's a commumative operation. 519 my($Vector, $ThisSize, $Index); 520 $Vector = $This->Copy(); 521 $ThisSize = $This->GetSize(); 522 523 if ($OtherIsVector) { 524 # $OrderFlipped is set to false for two vectors... 525 for $Index (0 .. ($ThisSize -1)) { 526 $Vector->{Values}[$Index] += $Other->{Values}[$Index]; 527 } 528 } 529 else { 530 if ($OrderFlipped) { 531 croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; 532 } 533 # Scalar addition... 534 for $Index (0 .. ($ThisSize -1)) { 535 $Vector->{Values}[$Index] += $Other; 536 } 537 } 538 return $Vector; 539 } 540 541 # 542 # Vector subtraction operator supports two subtraction modes: 543 # . Subtraction of two vectors by subtracting corresponding vector values 544 # . Subtraction of a scalar value from vector values ($Vector - 1) 545 # 546 # Caveats: 547 # . Subtraction of a vector from scalar is not allowed (1 - $Vector) 548 # 549 sub _VectorSubtractionOperator { 550 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 551 552 $ErrorMsg = "_VectorSubtractionOperator: Vector subtracttion failed"; 553 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 554 555 # Do the subtraction... 556 my($Vector, $ThisSize, $Index); 557 $Vector = $This->Copy(); 558 $ThisSize = $This->GetSize(); 559 560 if ($OtherIsVector) { 561 # $OrderFlipped is set to false for two vectors... 562 for $Index (0 .. ($ThisSize -1)) { 563 $Vector->{Values}[$Index] -= $Other->{Values}[$Index]; 564 } 565 } 566 else { 567 # Scalar subtraction... 568 if ($OrderFlipped) { 569 croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; 570 } 571 for $Index (0 .. ($ThisSize -1)) { 572 $Vector->{Values}[$Index] -= $Other; 573 } 574 } 575 return $Vector; 576 } 577 578 # 579 # Vector multiplication operator supports two multiplication modes: 580 # . Multiplication of two vectors by multiplying corresponding vector values 581 # . Multiplying vector values by a scalar ($Vector * 1) 582 # 583 # Caveats: 584 # . Multiplication of a scalar by a vector is not allowed (1 * $Vector) 585 # 586 sub _VectorMultiplicationOperator { 587 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 588 589 $ErrorMsg = "_VectorMultiplicationOperator: Vector addition failed"; 590 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 591 592 # Do the multiplication... 593 my($Vector, $ThisSize, $Index); 594 $Vector = $This->Copy(); 595 $ThisSize = $This->GetSize(); 596 597 if ($OtherIsVector) { 598 # $OrderFlipped is set to false for two vectors... 599 for $Index (0 .. ($ThisSize -1)) { 600 $Vector->{Values}[$Index] *= $Other->{Values}[$Index]; 601 } 602 } 603 else { 604 if ($OrderFlipped) { 605 croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; 606 } 607 # Scalar multiplication... 608 for $Index (0 .. ($ThisSize -1)) { 609 $Vector->{Values}[$Index] *= $Other; 610 } 611 } 612 return $Vector; 613 } 614 615 # 616 # Vector division operator supports two division modes: 617 # . Division of two vectors by dividing corresponding vector values 618 # . Dividing vector values by a scalar ($Vector / 2) 619 # 620 # Caveats: 621 # . Division of a scalar by a vector is not allowed (1 / $Vector) 622 # 623 sub _VectorDivisionOperator { 624 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 625 626 $ErrorMsg = "_VectorDivisionOperator: Vector division failed"; 627 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 628 629 # Do the division... 630 my($Vector, $ThisSize, $Index); 631 $Vector = $This->Copy(); 632 $ThisSize = $This->GetSize(); 633 634 if ($OtherIsVector) { 635 # $OrderFlipped is set to false for two vectors... 636 for $Index (0 .. ($ThisSize -1)) { 637 $Vector->{Values}[$Index] /= $Other->{Values}[$Index]; 638 } 639 } 640 else { 641 if ($OrderFlipped) { 642 croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; 643 } 644 # Scalar divison... 645 for $Index (0 .. ($ThisSize -1)) { 646 $Vector->{Values}[$Index] /= $Other; 647 } 648 } 649 return $Vector; 650 } 651 652 # 653 # Vector exponentiation operator supports two exponentiation modes: 654 # . Exponentiation of two vectors by exponentiation of corresponding vector values 655 # . Exponentiation of vector values by a scalar ($Vector ** 2) 656 # 657 # Caveats: 658 # . Exponent of scalar by a vector is not allowed (2 ** $Vector) 659 # 660 sub _VectorExponentiationOperator { 661 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 662 663 $ErrorMsg = "_VectorExponentiationOperator: Vector exponentiation failed"; 664 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 665 666 # Do the exponentiation... 667 my($Vector, $ThisSize, $Index); 668 $Vector = $This->Copy(); 669 $ThisSize = $This->GetSize(); 670 671 if ($OtherIsVector) { 672 # $OrderFlipped is set to false for two vectors... 673 for $Index (0 .. ($ThisSize -1)) { 674 $Vector->{Values}[$Index] **= $Other->{Values}[$Index]; 675 } 676 } 677 else { 678 if ($OrderFlipped) { 679 croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; 680 } 681 # Scalar exponentiation... 682 for $Index (0 .. ($ThisSize -1)) { 683 $Vector->{Values}[$Index] **= $Other; 684 } 685 } 686 return $Vector; 687 } 688 689 # 690 # Vector modulus operator supports two modulus modes: 691 # . Modulus of two vectors by taking modulus between corresponding vector values 692 # . Modulus of vector values by a scalar ($Vector % 2) 693 # 694 # Caveats: 695 # . Modulus of scalar by a vector is not allowed (2 % $Vector) 696 # 697 sub _VectorModulusOperator { 698 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 699 700 $ErrorMsg = "_VectorModulusOperator: Vector exponentiation failed"; 701 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 702 703 # Take the modulus... 704 my($Vector, $ThisSize, $Index); 705 $Vector = $This->Copy(); 706 $ThisSize = $This->GetSize(); 707 708 if ($OtherIsVector) { 709 # $OrderFlipped is set to false for two vectors... 710 for $Index (0 .. ($ThisSize -1)) { 711 $Vector->{Values}[$Index] %= $Other->{Values}[$Index]; 712 } 713 } 714 else { 715 if ($OrderFlipped) { 716 croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; 717 } 718 # Scalar modulus... 719 for $Index (0 .. ($ThisSize -1)) { 720 $Vector->{Values}[$Index] %= $Other; 721 } 722 } 723 return $Vector; 724 } 725 726 # 727 # Vector dot product operator supports two modes: 728 # . Dot product of two 3D vectors 729 # . Concatenation of a vector and a scalar 730 # 731 sub _VectorDotProductOperator { 732 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 733 734 $ErrorMsg = "_VectorDotProductOperator: Vector dot product failed"; 735 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 736 737 if ($OtherIsVector) { 738 # Calculate dot product of two 3D vectors... 739 my($DotProduct); 740 if ($This->GetSize() != 3) { 741 croak "Error: ${ClassName}->${ErrorMsg}: Both vectors must be 3D vectors..."; 742 } 743 $DotProduct = $This->GetX() * $Other->GetX + $This->GetY() * $Other->GetY() + $This->GetZ * $Other->GetZ(); 744 return $DotProduct; 745 } 746 else { 747 # Do a string concatenation and return the string... 748 if ($OrderFlipped) { 749 return $Other . $This->StringifyVector(); 750 } 751 else { 752 return $This->StringifyVector() . $Other; 753 } 754 } 755 } 756 757 # 758 # Vector cross product operator genrates a new vector which is the cross 759 # product of two 3D vectors. 760 # 761 # For two vectors, V1 (X1, Y1, Z1) and V2 (X2, Y2, Z2), cross product 762 # V1 x V2 corresponds: (Y1.Z2 - Z1.Y2), (Z1.X2 - X1.Z2), (X1.Y2 - Y1.X2) 763 # 764 sub _VectorCrossProductOperator { 765 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 766 767 $ErrorMsg = "_VectorCrossProductOperator: Vector cross product failed"; 768 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 769 770 if (!$OtherIsVector) { 771 croak "Error: ${ClassName}->${ErrorMsg}: Both object must be vectors..."; 772 } 773 774 # Calculate cross product of two 3D vectors... 775 if ($This->GetSize() != 3) { 776 croak "Error: ${ClassName}->${ErrorMsg}: Both vectors must be 3D vectors..."; 777 } 778 my($Vector, $X, $Y, $Z); 779 $X = $This->GetY() * $Other->GetZ() - $This->GetZ() * $Other->GetY(); 780 $Y = $This->GetZ() * $Other->GetX() - $This->GetX() * $Other->GetZ(); 781 $Z = $This->GetX() * $Other->GetY() - $This->GetY() * $Other->GetX(); 782 783 $Vector = (ref $This)->new($X, $Y, $Z); 784 785 return $Vector; 786 } 787 788 # 789 # Vector booelan operator checks whether a vector contains at least one non-zero 790 # value... 791 # 792 sub _VectorBooleanOperator { 793 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 794 795 $ErrorMsg = "_VectorBooleanOperator: Vector boolean operation failed"; 796 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 797 798 my($Size, $Index); 799 $Size = $This->GetSize(); 800 801 for $Index (0 .. ($Size - 1)) { 802 if ($This->{Values}[$Index] != 0) { 803 return 1; 804 } 805 } 806 return 0; 807 } 808 809 # 810 # Vector not booelan operator checks whether all values of a vector are zero. 811 # 812 sub _VectorNotBooleanOperator { 813 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 814 815 $ErrorMsg = "_VectorNotBooleanOperator: Vector not boolean operation failed"; 816 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 817 818 my($Size, $Index); 819 $Size = $This->GetSize(); 820 821 for $Index (0 .. ($Size - 1)) { 822 if ($This->{Values}[$Index] != 0) { 823 return 0; 824 } 825 } 826 return 1; 827 } 828 829 # 830 # Vector equal operator supports two modes: 831 # . Comparion of corresponding values in two vectors 832 # . Comparing vectors values to a scalar ($Vector == 2) 833 # 834 # Caveats: 835 # . Comparison of a scalar to vector values is not allowed (2 == $Vector) 836 # 837 sub _VectorEqualOperator { 838 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg, $CheckVectorSizes); 839 840 $ErrorMsg = "_VectorEqualOperator: Vector equal comparison failed"; 841 $CheckVectorSizes = 0; 842 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckVectorSizes); 843 844 # Do the comparison... 845 my($ThisSize, $Index); 846 $ThisSize = $This->GetSize(); 847 848 if ($OtherIsVector) { 849 # $OrderFlipped is set to false for two vectors... 850 my($OtherSize) = $Other->GetSize(); 851 if ($ThisSize != $OtherSize) { 852 return 0; 853 } 854 for $Index (0 .. ($ThisSize -1)) { 855 if ($This->{Values}[$Index] != $Other->{Values}[$Index]) { 856 return 0; 857 } 858 } 859 } 860 else { 861 if ($OrderFlipped) { 862 croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; 863 } 864 # Scalar comparison... 865 for $Index (0 .. ($ThisSize -1)) { 866 if ($This->{Values}[$Index] != $Other) { 867 return 0; 868 } 869 } 870 } 871 return 1; 872 } 873 874 # 875 # Vector not equal operator supports two modes: 876 # . Comparion of corresponding values in two vectors 877 # . Comparing vectors values to a scalar ($Vector != 2) 878 # 879 # Caveats: 880 # . Comparison of a scalar to vector values is not allowed (2 != $Vector2) 881 # 882 sub _VectorNotEqualOperator { 883 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg, $CheckVectorSizes); 884 885 $ErrorMsg = "_VectorNotEqualOperator: Vector not equal comparison failed"; 886 $CheckVectorSizes = 0; 887 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckVectorSizes); 888 889 # Do the comparison... 890 my($ThisSize, $Index); 891 $ThisSize = $This->GetSize(); 892 893 if ($OtherIsVector) { 894 # $OrderFlipped is set to false for two vectors... 895 my($OtherSize) = $Other->GetSize(); 896 if ($ThisSize != $OtherSize) { 897 return 1; 898 } 899 for $Index (0 .. ($ThisSize -1)) { 900 if ($This->{Values}[$Index] == $Other->{Values}[$Index]) { 901 return 0; 902 } 903 } 904 } 905 else { 906 if ($OrderFlipped) { 907 croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; 908 } 909 # Scalar comparison... 910 for $Index (0 .. ($ThisSize -1)) { 911 if ($This->{Values}[$Index] == $Other) { 912 return 0; 913 } 914 } 915 } 916 return 1; 917 } 918 919 # 920 # Vector less than operator supports two modes: 921 # . Comparion of corresponding values in two vectors 922 # . Comparing vectors values to a scalar ($Vector < 2) 923 # 924 # Caveats: 925 # . Comparison of a scalar to vector values is not allowed (2 < $Vector2) 926 # 927 sub _VectorLessThanOperator { 928 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 929 930 $ErrorMsg = "_VectorLessThanOperator: Vector less than comparison failed"; 931 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 932 933 # Do the comparison... 934 my($ThisSize, $Index); 935 $ThisSize = $This->GetSize(); 936 937 if ($OtherIsVector) { 938 # $OrderFlipped is set to false for two vectors... 939 for $Index (0 .. ($ThisSize -1)) { 940 if ($This->{Values}[$Index] >= $Other->{Values}[$Index]) { 941 return 0; 942 } 943 } 944 } 945 else { 946 if ($OrderFlipped) { 947 croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; 948 } 949 # Scalar comparison... 950 for $Index (0 .. ($ThisSize -1)) { 951 if ($This->{Values}[$Index] >= $Other) { 952 return 0; 953 } 954 } 955 } 956 return 1; 957 } 958 959 # 960 # Vector less than equla operator supports two modes: 961 # . Comparion of corresponding values in two vectors 962 # . Comparing vectors values to a scalar ($Vector <= 2) 963 # 964 # Caveats: 965 # . Comparison of a scalar to vector values is not allowed (2 <= $Vector2) 966 # 967 sub _VectorLessThanEqualOperator { 968 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 969 970 $ErrorMsg = "_VectorLessThanEqualOperator: Vector less than equal comparison failed"; 971 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 972 973 # Do the comparison... 974 my($ThisSize, $Index); 975 $ThisSize = $This->GetSize(); 976 977 if ($OtherIsVector) { 978 # $OrderFlipped is set to false for two vectors... 979 for $Index (0 .. ($ThisSize -1)) { 980 if ($This->{Values}[$Index] > $Other->{Values}[$Index]) { 981 return 0; 982 } 983 } 984 } 985 else { 986 if ($OrderFlipped) { 987 croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; 988 } 989 # Scalar comparison... 990 for $Index (0 .. ($ThisSize -1)) { 991 if ($This->{Values}[$Index] > $Other) { 992 return 0; 993 } 994 } 995 } 996 return 1; 997 } 998 999 # 1000 # Vector greatar than operator supports two modes: 1001 # . Comparion of corresponding values in two vectors 1002 # . Comparing vectors values to a scalar ($Vector > 2) 1003 # 1004 # Caveats: 1005 # . Comparison of a scalar to vector values is not allowed (2 > $Vector2) 1006 # 1007 sub _VectorGreatarThanOperator { 1008 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 1009 1010 $ErrorMsg = "_VectorGreatarThanOperator: Vector greatar than comparison failed"; 1011 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 1012 1013 # Do the comparison... 1014 my($ThisSize, $Index); 1015 $ThisSize = $This->GetSize(); 1016 1017 if ($OtherIsVector) { 1018 # $OrderFlipped is set to false for two vectors... 1019 for $Index (0 .. ($ThisSize -1)) { 1020 if ($This->{Values}[$Index] <= $Other->{Values}[$Index]) { 1021 return 0; 1022 } 1023 } 1024 } 1025 else { 1026 if ($OrderFlipped) { 1027 croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; 1028 } 1029 # Scalar comparison... 1030 for $Index (0 .. ($ThisSize -1)) { 1031 if ($This->{Values}[$Index] <= $Other) { 1032 return 0; 1033 } 1034 } 1035 } 1036 return 1; 1037 } 1038 1039 # 1040 # Vector greatar than equal operator supports two modes: 1041 # . Comparion of corresponding values in two vectors 1042 # . Comparing vectors values to a scalar ($Vector >= 2) 1043 # 1044 # Caveats: 1045 # . Comparison of a scalar to vector values is not allowed (2 <= $Vector2) 1046 # 1047 sub _VectorGreatarThanEqualOperator { 1048 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 1049 1050 $ErrorMsg = "_VectorGreatarThanEqualOperator: Vector greatar than equal comparison failed"; 1051 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 1052 1053 # Do the comparison... 1054 my($ThisSize, $Index); 1055 $ThisSize = $This->GetSize(); 1056 1057 if ($OtherIsVector) { 1058 # $OrderFlipped is set to false for two vectors... 1059 for $Index (0 .. ($ThisSize -1)) { 1060 if ($This->{Values}[$Index] < $Other->{Values}[$Index]) { 1061 return 0; 1062 } 1063 } 1064 } 1065 else { 1066 if ($OrderFlipped) { 1067 croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; 1068 } 1069 # Scalar comparison... 1070 for $Index (0 .. ($ThisSize -1)) { 1071 if ($This->{Values}[$Index] < $Other) { 1072 return 0; 1073 } 1074 } 1075 } 1076 return 1; 1077 } 1078 1079 # 1080 # Vector negative value operator returns a vector with values corresponding to 1081 # negative values of a vector 1082 # 1083 sub _VectorNegativeValueOperator { 1084 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 1085 1086 $ErrorMsg = "_VectorNegativeValueOperator: Vector negative value operation failed"; 1087 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 1088 1089 # Take the negative value... 1090 my($Vector, $ThisSize, $Index); 1091 $Vector = $This->Copy(); 1092 $ThisSize = $This->GetSize(); 1093 1094 for $Index (0 .. ($ThisSize -1)) { 1095 $Vector->{Values}[$Index] = - $This->{Values}[$Index]; 1096 } 1097 return $Vector; 1098 } 1099 1100 # 1101 # Vector absolute value operator returns a vector with values corresponding to 1102 # absolute values of a vector 1103 # 1104 sub _VectorAbsoluteValueOperator { 1105 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 1106 1107 $ErrorMsg = "_VectorAbsoluteValueOperator: Vector absolute value operation failed"; 1108 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 1109 1110 # Take the absolute value... 1111 my($Vector, $ThisSize, $Index); 1112 $Vector = $This->Copy(); 1113 $ThisSize = $This->GetSize(); 1114 1115 for $Index (0 .. ($ThisSize -1)) { 1116 $Vector->{Values}[$Index] = abs $This->{Values}[$Index]; 1117 } 1118 return $Vector; 1119 } 1120 1121 # 1122 # Vector exp natural base operator returns a vector with values corresponding to 1123 # e raised to the power of values in a vector 1124 # 1125 sub _VectorExpNaturalBaseOperator { 1126 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 1127 1128 $ErrorMsg = "_VectorExpNaturalBaseOperator: Vector exp operation failed"; 1129 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 1130 1131 # Take the absolute value... 1132 my($Vector, $ThisSize, $Index); 1133 $Vector = $This->Copy(); 1134 $ThisSize = $This->GetSize(); 1135 1136 for $Index (0 .. ($ThisSize -1)) { 1137 $Vector->{Values}[$Index] = exp $This->{Values}[$Index]; 1138 } 1139 return $Vector; 1140 } 1141 1142 # 1143 # Vector log natural base operator returns a vector with values corresponding to 1144 # log of values in a vector 1145 # 1146 sub _VectorLogNaturalBaseOperator { 1147 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 1148 1149 $ErrorMsg = "_VectorLogNaturalBaseOperator: Vector log operation failed"; 1150 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 1151 1152 # Take the absolute value... 1153 my($Vector, $ThisSize, $Index); 1154 $Vector = $This->Copy(); 1155 $ThisSize = $This->GetSize(); 1156 1157 for $Index (0 .. ($ThisSize -1)) { 1158 $Vector->{Values}[$Index] = log $This->{Values}[$Index]; 1159 } 1160 return $Vector; 1161 } 1162 1163 # 1164 # Vector cosine operator returns a vector with values corresponding to cosine of values 1165 # in a vector. Input vector values are assumed to be in radians. 1166 # 1167 sub _VectorCosineOperator { 1168 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 1169 1170 $ErrorMsg = "_VectorCosineOperator: Vector cos operation failed"; 1171 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 1172 1173 # Take the absolute value... 1174 my($Vector, $ThisSize, $Index); 1175 $Vector = $This->Copy(); 1176 $ThisSize = $This->GetSize(); 1177 1178 for $Index (0 .. ($ThisSize -1)) { 1179 $Vector->{Values}[$Index] = cos $This->{Values}[$Index]; 1180 } 1181 return $Vector; 1182 } 1183 1184 # 1185 # Vector sine operator returns a vector with values corresponding to sine of values 1186 # in a vector. Input vector values are assumed to be in radians. 1187 # 1188 sub _VectorSineOperator { 1189 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 1190 1191 $ErrorMsg = "_VectorSineOperator: Vector sin operation failed"; 1192 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 1193 1194 # Take the absolute value... 1195 my($Vector, $ThisSize, $Index); 1196 $Vector = $This->Copy(); 1197 $ThisSize = $This->GetSize(); 1198 1199 for $Index (0 .. ($ThisSize -1)) { 1200 $Vector->{Values}[$Index] = sin $This->{Values}[$Index]; 1201 } 1202 return $Vector; 1203 } 1204 1205 # 1206 # Vector square root returns a vector with values corresponding to sqrt of values 1207 # in a vector. 1208 # 1209 sub _VectorSquareRootOperator { 1210 my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); 1211 1212 $ErrorMsg = "_VectorSquareRootOperator: Vector sqrt operation failed"; 1213 ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); 1214 1215 # Take the absolute value... 1216 my($Vector, $ThisSize, $Index); 1217 $Vector = $This->Copy(); 1218 $ThisSize = $This->GetSize(); 1219 1220 for $Index (0 .. ($ThisSize -1)) { 1221 $Vector->{Values}[$Index] = sqrt $This->{Values}[$Index]; 1222 } 1223 return $Vector; 1224 } 1225 1226 # Turn vector into array for @{$Vector} operation... 1227 sub _VectorToArrayOperator { 1228 my($This) = @_; 1229 1230 return \@{$This->{Values}}; 1231 } 1232 1233 # Turn vector into number for $#Vector operation: It's the size of vector... 1234 sub _NumifyVector { 1235 my($This) = @_; 1236 1237 return $This->GetSize(); 1238 } 1239 1240 # Process parameters passed to overloaded operators... 1241 # 1242 # For uninary operators, $SecondParameter is not defined. 1243 sub _ProcessOverloadedOperatorParameters { 1244 my($ErrorMsg, $FirstParameter, $SecondParameter, $ParametersOrderStatus, $CheckVectorSizesStatus) = @_; 1245 my($This, $Other, $OrderFlipped, $OtherIsVector, $CheckVectorSizes); 1246 1247 ($This, $Other) = ($FirstParameter, $SecondParameter); 1248 $OrderFlipped = (defined($ParametersOrderStatus) && $ParametersOrderStatus) ? 1 : 0; 1249 $CheckVectorSizes = (defined $CheckVectorSizesStatus) ? $CheckVectorSizesStatus : 1; 1250 1251 _ValidateVector($ErrorMsg, $This); 1252 1253 $OtherIsVector = 0; 1254 if (defined($Other) && (ref $Other)) { 1255 # Make sure $Other is a vector... 1256 _ValidateVector($ErrorMsg, $Other); 1257 if ($CheckVectorSizes) { 1258 _ValidateVectorSizesAreEqual($ErrorMsg, $This, $Other); 1259 } 1260 $OtherIsVector = 1; 1261 } 1262 return ($This, $Other, $OrderFlipped, $OtherIsVector); 1263 } 1264 1265 # Is it a vector object? 1266 sub _IsVector { 1267 my($Object) = @_; 1268 1269 return (Scalar::Util::blessed($Object) && $Object->isa($ClassName)) ? 1 : 0; 1270 } 1271 1272 # Make sure it's a vector reference... 1273 sub _ValidateVector { 1274 my($ErrorMsg, $Vector) = @_; 1275 1276 if (!_IsVector($Vector)) { 1277 croak "Error: ${ClassName}->${ErrorMsg}: Object must be a vector..."; 1278 } 1279 } 1280 1281 # Make sure size of the two vectors contain the same number of values... 1282 sub _ValidateVectorSizesAreEqual { 1283 my($ErrorMsg, $Vector1, $Vector2) = @_; 1284 1285 if ($Vector1->GetSize() != $Vector2->GetSize()) { 1286 croak "Error: ${ClassName}->${ErrorMsg}: Size of the vectors must be same..."; 1287 } 1288 } 1289 1290 # Return a string containing vector values... 1291 sub StringifyVector { 1292 my($This) = @_; 1293 my($VectorString, $FormatString, $PrintFormat, $Size, @ValuesFormat); 1294 1295 $PrintFormat = (exists $This->{ValueFormat}) ? $This->{ValueFormat} : $ValueFormat; 1296 1297 @ValuesFormat = ($PrintFormat) x scalar @{$This->{Values}}; 1298 $FormatString = join ' ', @ValuesFormat; 1299 1300 $Size = $This->GetSize(); 1301 1302 $VectorString = sprintf "<Size: $Size; Values: [ $FormatString ] >", @{$This->{Values}}; 1303 1304 return $VectorString; 1305 } 1306