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 |