Mercurial > repos > deepakjadmin > mayatool3_test2
comparison lib/Vector.pm @ 0:4816e4a8ae95 draft default tip
Uploaded
| author | deepakjadmin |
|---|---|
| date | Wed, 20 Jan 2016 09:23:18 -0500 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:4816e4a8ae95 |
|---|---|
| 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 | |
| 1307 1; | |
| 1308 | |
| 1309 __END__ | |
| 1310 | |
| 1311 =head1 NAME | |
| 1312 | |
| 1313 Vector | |
| 1314 | |
| 1315 =head1 SYNOPSIS | |
| 1316 | |
| 1317 use Vector; | |
| 1318 | |
| 1319 use Vector qw(:all); | |
| 1320 | |
| 1321 =head1 DESCRIPTION | |
| 1322 | |
| 1323 B<Vector> class provides the following methods: | |
| 1324 | |
| 1325 new, AddValues, Copy, GetLength, GetMagnitude, GetNumOfNonZeroValues, | |
| 1326 GetPercentOfNonZeroValues, GetSize, GetValue, GetValues, GetX, GetXYZ, GetY, | |
| 1327 GetZ, IsVector, Normalize, SetValue, SetValuePrintFormat, | |
| 1328 SetX, SetXYZ, SetY, SetZ, StringifyVector, IsVector | |
| 1329 | |
| 1330 The following functions are available: | |
| 1331 | |
| 1332 IsVector, SetValuePrintFormat UnitXVector, UnitYVector, UnitZVector, UnitVector, | |
| 1333 ZeroVector | |
| 1334 | |
| 1335 The following operators are overloaded: | |
| 1336 | |
| 1337 "" 0+ bool | |
| 1338 @{} | |
| 1339 + - * / % | |
| 1340 x . | |
| 1341 == != < <= > >= | |
| 1342 neg | |
| 1343 abs exp log sqrt cos sin | |
| 1344 | |
| 1345 =head2 FUNCTIONS | |
| 1346 | |
| 1347 =over 4 | |
| 1348 | |
| 1349 =item B<new> | |
| 1350 | |
| 1351 $NewVector = new Vector(); | |
| 1352 $NewVector = new Vector(@Values); | |
| 1353 $NewVector = new Vector(\@Values); | |
| 1354 $NewVector = new Vector($AnotherVector); | |
| 1355 | |
| 1356 Creates a new B<Vector> object containing I<Values> and returns B<NewVector> object. | |
| 1357 In case no I<Values> are specified, an empty B<Vector> is created. | |
| 1358 | |
| 1359 =item B<AddValues> | |
| 1360 | |
| 1361 $Vector->AddValues(@Values); | |
| 1362 $Vector->AddValues(\@Values); | |
| 1363 $Vector->AddValues($AnotherVector); | |
| 1364 | |
| 1365 Adds values to I<Vector> using an array, reference to an array or another vector and returns | |
| 1366 I<Vector>. | |
| 1367 | |
| 1368 =item B<Copy> | |
| 1369 | |
| 1370 $NewVector = $Vector->Copy(); | |
| 1371 | |
| 1372 Creates a copy of I<Vector> and returns I<NewVector>. | |
| 1373 | |
| 1374 =item B<GetLength> | |
| 1375 | |
| 1376 $Length = $Vector->GetLength(); | |
| 1377 | |
| 1378 Returns I<Lengh> of a 3D I<Vector> corresponding to its dot product. | |
| 1379 | |
| 1380 =item B<GetMagnitude> | |
| 1381 | |
| 1382 $Length = $Vector->GetMagnitude(); | |
| 1383 | |
| 1384 Returns I<Lengh> of a 3D I<Vector> corresponding to its dot product. | |
| 1385 | |
| 1386 =item B<GetNumOfNonZeroValues> | |
| 1387 | |
| 1388 $Value = $Vector->GetNumOfNonZeroValues(); | |
| 1389 | |
| 1390 Returns number of non-zero values in I<Vector>. | |
| 1391 | |
| 1392 =item B<GetPercentOfNonZeroValues> | |
| 1393 | |
| 1394 $Value = $Vector->GetPercentOfNonZeroValues(); | |
| 1395 | |
| 1396 Returns percent of non-zero values in I<Vector>. | |
| 1397 | |
| 1398 =item B<GetSize> | |
| 1399 | |
| 1400 $Size = $Vector->GetSize(); | |
| 1401 | |
| 1402 Returns size of a I<Vector> corresponding to number of its values. | |
| 1403 | |
| 1404 =item B<GetValue> | |
| 1405 | |
| 1406 $Value = $Vector->GetValues($Index); | |
| 1407 | |
| 1408 Returns vector B<Value> specified using I<Index> starting at 0. | |
| 1409 | |
| 1410 =item B<GetValues> | |
| 1411 | |
| 1412 @Values = $Vector->GetValues(); | |
| 1413 $ValuesRef = $Vector->GetValues(); | |
| 1414 | |
| 1415 Returns an array or a reference to an array containing all I<Vector> values. | |
| 1416 | |
| 1417 =item B<GetX> | |
| 1418 | |
| 1419 $X = $Vector->GetX(); | |
| 1420 | |
| 1421 Returns B<X> value of a 3D I<Vector> | |
| 1422 | |
| 1423 =item B<GetXYZ> | |
| 1424 | |
| 1425 @XYZValues = $Vector->GetXYZ(); | |
| 1426 $XYZValuesRef = $Vector->GetXYZ(); | |
| 1427 | |
| 1428 Returns B<XYZ> values of a 3D I<Vector> as an array or a reference to an array | |
| 1429 containing the values. | |
| 1430 | |
| 1431 =item B<GetY> | |
| 1432 | |
| 1433 $Y = $Vector->GetY(); | |
| 1434 | |
| 1435 Returns B<Y> value of a 3D I<Vector>. | |
| 1436 | |
| 1437 =item B<GetZ> | |
| 1438 | |
| 1439 $Z = $Vector->GetZ(); | |
| 1440 | |
| 1441 Returns B<Z> value of a 3D I<Vector>. | |
| 1442 | |
| 1443 =item B<IsVector> | |
| 1444 | |
| 1445 $Status = Vector::IsVector($Object); | |
| 1446 | |
| 1447 Returns 1 or 0 based on whether I<Object> is a B<Vector> object. | |
| 1448 | |
| 1449 =item B<Normalize> | |
| 1450 | |
| 1451 $Vector->Normalize(); | |
| 1452 | |
| 1453 Normalizes a 3D I<Vector> by dividing its values by the length and returns I<Vector>. | |
| 1454 | |
| 1455 =item B<SetValue> | |
| 1456 | |
| 1457 $Vector->SetValue($Index, $Value); | |
| 1458 | |
| 1459 Sets a I<Vector> value specified by I<Index> to I<Value> and returns I<Vector>. | |
| 1460 | |
| 1461 =item B<SetValuePrintFormat> | |
| 1462 | |
| 1463 $Vector->SetValuePrintFormat($ValuePrintFormat); | |
| 1464 Vector::SetValuePrintFormat($ValuePrintFormat); | |
| 1465 | |
| 1466 Sets format for printing vector values for a specified I<Vector> or the whole class. Default | |
| 1467 format: I<%g>. | |
| 1468 | |
| 1469 =item B<SetX> | |
| 1470 | |
| 1471 $Vector->SetX($Value); | |
| 1472 | |
| 1473 Sets B<X> value of a 3D vector to I<Value> and returns I<Vector>. | |
| 1474 | |
| 1475 =item B<SetXYZ> | |
| 1476 | |
| 1477 $Vector->SetXYZ(@Values); | |
| 1478 $Vector->SetXYZ(\@Values); | |
| 1479 $Vector->SetXYZ($AnotherVector); | |
| 1480 | |
| 1481 Sets B<XYZ> values of a 3D vector and returns I<Vector>. | |
| 1482 | |
| 1483 =item B<SetY> | |
| 1484 | |
| 1485 $Vector->SetY($Value); | |
| 1486 | |
| 1487 Sets B<Y> value of a 3D vector to I<Value> and returns I<Vector>. | |
| 1488 | |
| 1489 =item B<SetZ> | |
| 1490 | |
| 1491 $Vector->SetZ($Value); | |
| 1492 | |
| 1493 Sets B<Z> value of a 3D vector to I<Value> and returns I<Vector>. | |
| 1494 | |
| 1495 =item B<StringifyVector> | |
| 1496 | |
| 1497 $String = $Vector->StringifyVector(); | |
| 1498 | |
| 1499 Returns a string containing information about I<Vector> object. | |
| 1500 | |
| 1501 =item B<UnitVector> | |
| 1502 | |
| 1503 $UnitVector = UnitVector([$Size]); | |
| 1504 $UnitVector = Vector::UnitVector([$Size]); | |
| 1505 | |
| 1506 Returns a B<UnitVector> of I<Size>. Default size: I<3>. | |
| 1507 | |
| 1508 =item B<UnitXVector> | |
| 1509 | |
| 1510 $UnitXVector = UnitXVector(); | |
| 1511 | |
| 1512 Returns a 3D B<UnitXVector>. | |
| 1513 | |
| 1514 =item B<UnitYVector> | |
| 1515 | |
| 1516 $UnitYVector = UnitYVector(); | |
| 1517 | |
| 1518 Returns a 3D B<UnitYVector>. | |
| 1519 | |
| 1520 =item B<UnitZVector> | |
| 1521 | |
| 1522 $UnitZVector = UnitZVector(); | |
| 1523 | |
| 1524 Returns a 3D B<UnitZVector>. | |
| 1525 | |
| 1526 =item B<ZeroVector> | |
| 1527 | |
| 1528 $UnitVector = ZeroVector([$Size]); | |
| 1529 $UnitVector = Vector::ZeroVector([$Size]); | |
| 1530 | |
| 1531 Returns a B<ZeroVector> of I<Size>. Default size: I<3>. | |
| 1532 | |
| 1533 =back | |
| 1534 | |
| 1535 =head1 AUTHOR | |
| 1536 | |
| 1537 Manish Sud <msud@san.rr.com> | |
| 1538 | |
| 1539 =head1 SEE ALSO | |
| 1540 | |
| 1541 BitVector.pm | |
| 1542 | |
| 1543 =head1 COPYRIGHT | |
| 1544 | |
| 1545 Copyright (C) 2015 Manish Sud. All rights reserved. | |
| 1546 | |
| 1547 This file is part of MayaChemTools. | |
| 1548 | |
| 1549 MayaChemTools is free software; you can redistribute it and/or modify it under | |
| 1550 the terms of the GNU Lesser General Public License as published by the Free | |
| 1551 Software Foundation; either version 3 of the License, or (at your option) | |
| 1552 any later version. | |
| 1553 | |
| 1554 =cut |
