Mercurial > repos > deepakjadmin > mayatool3_test2
view lib/Vector.pm @ 0:4816e4a8ae95 draft default tip
Uploaded
author | deepakjadmin |
---|---|
date | Wed, 20 Jan 2016 09:23:18 -0500 |
parents | |
children |
line wrap: on
line source
package Vector; # # $RCSfile: Vector.pm,v $ # $Date: 2015/02/28 20:47:30 $ # $Revision: 1.34 $ # # Author: Manish Sud <msud@san.rr.com> # # Copyright (C) 2015 Manish Sud. All rights reserved. # # This file is part of MayaChemTools. # # MayaChemTools is free software; you can redistribute it and/or modify it under # the terms of the GNU Lesser General Public License as published by the Free # Software Foundation; either version 3 of the License, or (at your option) any # later version. # # MayaChemTools is distributed in the hope that it will be useful, but without # any warranty; without even the implied warranty of merchantability of fitness # for a particular purpose. See the GNU Lesser General Public License for more # details. # # You should have received a copy of the GNU Lesser General Public License # along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or # write to the Free Software Foundation Inc., 59 Temple Place, Suite 330, # Boston, MA, 02111-1307, USA. # use strict; use Carp; use Exporter; use Scalar::Util (); use StatisticsUtil (); use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @ISA = qw(Exporter); @EXPORT = qw(IsVector UnitXVector UnitYVector UnitZVector UnitVector ZeroVector); @EXPORT_OK = qw(SetValuePrintFormat); %EXPORT_TAGS = ( all => [@EXPORT, @EXPORT_OK] ); # Setup class variables... my($ClassName, $ValueFormat); _InitializeClass(); # # Using the following explicity overloaded operators, Perl automatically generates methods # for operations with no explicitly defined methods. Autogenerated methods are possible for # these operators: # # o Arithmetic operators: += -= *= /= **= %= ++ -- x= .= # o Increment and decrement: ++ -- # # 'fallback' is set to 'false' to raise exception for all other operators. # use overload '""' => 'StringifyVector', '0+' => '_NumifyVector', '@{}' => '_VectorToArrayOperator', '+' => '_VectorAdditionOperator', '-' => '_VectorSubtractionOperator', '*' => '_VectorMultiplicationOperator', '/' => '_VectorDivisionOperator', '**' => '_VectorExponentiationOperator', '%' => '_VectorModulusOperator', 'x' => '_VectorCrossProductOperator', '.' => '_VectorDotProductOperator', 'bool' => '_VectorBooleanOperator', '!' => '_VectorNotBooleanOperator', '==' => '_VectorEqualOperator', '!=' => '_VectorNotEqualOperator', '<' => '_VectorLessThanOperator', '<=' => '_VectorLessThanEqualOperator', '>' => '_VectorGreatarThanOperator', '>=' => '_VectorGreatarThanEqualOperator', 'neg' => '_VectorNegativeValueOperator', 'abs' => '_VectorAbsoluteValueOperator', 'exp' => '_VectorExpNaturalBaseOperator', 'log' => '_VectorLogNaturalBaseOperator', 'sqrt' => '_VectorSquareRootOperator', 'cos' => '_VectorCosineOperator', 'sin' => '_VectorSineOperator', 'fallback' => undef; # Class constructor... sub new { my($Class, @Values) = @_; # Initialize object... my $This = {}; bless $This, ref($Class) || $Class; $This->_InitializeVector(); $This->_AddValues(@Values); return $This; } # Initialize object data... # sub _InitializeVector { my($This) = @_; @{$This->{Values}} = (); } # Initialize class ... sub _InitializeClass { #Class name... $ClassName = __PACKAGE__; # Print format for vector values... $ValueFormat = "%g"; } # Initialize vector values using: # o List of values # o Reference to an list of values # o Another vector object # sub _AddValues { my($This, @Values) = @_; if (!@Values) { return; } # Set vector values... my($FirstValue, $TypeOfFirstValue); $FirstValue = $Values[0]; $TypeOfFirstValue = ref $FirstValue; if ($TypeOfFirstValue =~ /^(SCALAR|HASH|CODE|REF|GLOB)/) { croak "Error: ${ClassName}->_AddValues: Trying to add values to vector object with a reference to unsupported value format..."; } if (_IsVector($FirstValue)) { # Initialize using Vector... push @{$This->{Values}}, @{$FirstValue->{Values}}; } elsif ($TypeOfFirstValue =~ /^ARRAY/) { # Initialize using array refernce... push @{$This->{Values}}, @{$FirstValue}; } else { # It's a list of values... push @{$This->{Values}}, @Values; } } # Add values to a vector using a vector, reference to an array or an array... sub AddValues { my($This, @Values) = @_; $This->_AddValues(@Values); return $This; } # Copy vector... sub Copy { my($This) = @_; my($Vector); # Copy vector values... $Vector = (ref $This)->new(\@{$This->{Values}}); # Copy value format for stringification... if (exists $This->{ValueFormat}) { $Vector->{ValueFormat} = $This->{ValueFormat}; } return $Vector; } # Get 3D vector length... sub GetLength { my($This) = @_; if ($This->GetSize() != 3) { croak "Error: ${ClassName}->GetGetLength: Object must be a 3D vector..."; } my($Length, $DotProduct); $DotProduct = $This . $This; $Length = sqrt $DotProduct; return $Length; } # Length of a 3D vector by another name... sub GetMagnitude { my($This) = @_; return $This->GetLength(); } # Normalize 3D vector... sub Normalize { my($This) = @_; if ($This->GetSize() != 3) { croak "Error: ${ClassName}->GetGetLength: Object must be a 3D vector..."; } my($Vector, $Length); $Length = $This->GetLength(); $Vector = $This / $Length; return $Vector; } # Is it a vector object? sub IsVector ($) { my($Object) = @_; return _IsVector($Object); } # Get size... sub GetSize { my($This) = @_; return scalar @{$This->{Values}}; } # Get X value of a 3D vector... sub GetX { my($This) = @_; if ($This->GetSize() != 3) { croak "Error: ${ClassName}->GetX: Object must be a 3D vector..."; } return $This->_GetValue(0); } # Set X value of a 3D vector... sub SetX { my($This, $Value) = @_; if ($This->GetSize() != 3) { croak "Error: ${ClassName}->SetX: Object must be a 3D vector..."; } return $This->_SetValue(0, $Value); } # Get Y value of a 3D vector... sub GetY { my($This) = @_; if ($This->GetSize() != 3) { croak "Error: ${ClassName}->GetY: Object must be a 3D vector..."; } return $This->_GetValue(1); } # Set Y value of a 3D vector... sub SetY { my($This, $Value) = @_; if ($This->GetSize() != 3) { croak "Error: ${ClassName}->SetY: Object must be a 3D vector..."; } return $This->_SetValue(1, $Value); } # Get Z value of a 3D vector... sub GetZ { my($This) = @_; if ($This->GetSize() != 3) { croak "Error: ${ClassName}->GetZ: Object must be a 3D vector..."; } return $This->_GetValue(2); } # Set Z value of a 3D vector... sub SetZ { my($This, $Value) = @_; if ($This->GetSize() != 3) { croak "Error: ${ClassName}->SetZ: Object must be a 3D vector..."; } return $This->_SetValue(2, $Value); } # Set XYZ value of a 3D vector using: # o List of values # o Reference to an list of values # o Another vector object # sub SetXYZ { my($This, @Values) = @_; if (!@Values) { croak "Error: ${ClassName}->SetXYZ: No values specified..."; } if ($This->GetSize() != 3) { croak "Error: ${ClassName}->SetXYZ: Object must be a 3D vector..."; } # Set vector values... my($FirstValue, $TypeOfFirstValue); $FirstValue = $Values[0]; $TypeOfFirstValue = ref $FirstValue; if ($TypeOfFirstValue =~ /^(SCALAR|HASH|CODE|REF|GLOB)/) { croak "Error: ${ClassName}->SetXYZ: A reference to unsupported value format specified..."; } my($X, $Y, $Z); if (_IsVector($FirstValue)) { # SetXYZ using vector... if ($FirstValue->GetSize() != 3) { croak "Error: ${ClassName}->SetXYZ: Input object must be a 3D vector..."; } ($X, $Y, $Z) = @{$FirstValue->{Values}}; } elsif ($TypeOfFirstValue =~ /^ARRAY/) { # SetXYZ using array reference... if (@{$FirstValue} != 3) { croak "Error: ${ClassName}->SetXYZ: Input array reference must correspond to an array with three values..."; } ($X, $Y, $Z) = @{$FirstValue}; } else { # It's a list of values... if (@Values != 3) { croak "Error: ${ClassName}->SetXYZ: Input array must contain three values..."; } ($X, $Y, $Z) = @Values; } $This->{Values}[0] = $X; $This->{Values}[1] = $Y; $This->{Values}[2] = $Z; return $This; } # Get XYZ as an array or a reference to an array... # sub GetXYZ { my($This) = @_; if ($This->GetSize() != 3) { croak "Error: ${ClassName}->GetXYZ: Object must be a 3D vector..."; } return wantarray ? @{$This->{Values}} : \@{$This->{Values}}; } # Get a specific value from vector with indicies starting from 0.. sub GetValue { my($This, $Index) = @_; if ($Index < 0) { croak "Error: ${ClassName}->GetValue: Index value must be a positive number..."; } if ($Index >= $This->GetSize()) { croak "Error: ${ClassName}->GetValue: Index value must be less than size of vector..."; } return $This->_GetValue($Index); } # Get a vector value... sub _GetValue { my($This, $Index) = @_; return $This->{Values}[$Index]; } # Set a specific value in vector with indicies starting from 0.. sub SetValue { my($This, $Index, $Value, $SkipCheck) = @_; # Just set it... if ($SkipCheck) { return $This->_SetValue($Index, $Value); } # Check and set... if ($Index < 0) { croak "Error: ${ClassName}->SetValue: Index value must be a positive number..."; } if ($Index >= $This->GetSize()) { croak "Error: ${ClassName}->SetValue: Index vaue must be less than size of vector..."; } return $This->_SetValue($Index, $Value); } # Set a vector value... sub _SetValue { my($This, $Index, $Value) = @_; $This->{Values}[$Index] = $Value; return $This; } # Return vector values as an array or reference to an array... sub GetValues { my($This) = @_; return wantarray ? @{$This->{Values}} : \@{$This->{Values}}; } # Get number of non-zero values in vector... # sub GetNumOfNonZeroValues { my($This) = @_; my($Count, $Index, $Size); $Count = 0; $Size = $This->GetSize(); for $Index (0 .. ($Size -1)) { if ($This->{Values}[$Index] != 0) { $Count++; } } return $Count; } # Get percent of non-zero values... # sub GetPercentOfNonZeroValues { my($This) = @_; return $This->GetSize() ? (($This->GetNumOfNonZeroValues()/$This->GetSize())*100) : 0; } # Set value print format for an individual object or the whole class... sub SetValuePrintFormat ($;$) { my($FirstParameter, $SecondParameter) = @_; if ((@_ == 2) && (_IsVector($FirstParameter))) { # Set value print format for the specific object... my($This, $ValuePrintFormat) = ($FirstParameter, $SecondParameter); $This->{ValueFormat} = $ValuePrintFormat; } else { # Set value print format for the class... my($ValuePrintFormat) = ($FirstParameter); $ValueFormat = $ValuePrintFormat; } } # Zero vector of specified size or size 3... sub ZeroVector (;$) { my($Size) = @_; my($Vector, @Values); $Size = (defined $Size) ? $Size : 3; @Values = ('0') x $Size; $Vector = new Vector(\@Values); return $Vector; } # Unit vector of specified size or size 3... sub UnitVector (;$) { my($Size) = @_; my($Vector, @Values); $Size = (defined $Size) ? $Size : 3; @Values = ('1') x $Size; $Vector = new Vector(\@Values); return $Vector; } # Unit X vector of size 3... sub UnitXVector () { my($Vector); $Vector = new Vector(1, 0, 0); return $Vector; } # Unit Y vector of size 3... sub UnitYVector () { my($Vector); $Vector = new Vector(0, 1, 0); return $Vector; } # Unit Z vector of size 3... sub UnitZVector () { my($Vector); $Vector = new Vector(0, 0, 1); return $Vector; } # # Vector addition operator supports two addition modes: # . Addition of two vectors by adding corresponding vector values # . Addition of a scalar value to vector values ($Vector + 1) # # Caveats: # . Addition of a vector to scalar is not allowed (1 + $Vector) # sub _VectorAdditionOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorAdditionOperator: Vector addition failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Do the addition. Order can be ignored: It's a commumative operation. my($Vector, $ThisSize, $Index); $Vector = $This->Copy(); $ThisSize = $This->GetSize(); if ($OtherIsVector) { # $OrderFlipped is set to false for two vectors... for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] += $Other->{Values}[$Index]; } } else { if ($OrderFlipped) { croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; } # Scalar addition... for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] += $Other; } } return $Vector; } # # Vector subtraction operator supports two subtraction modes: # . Subtraction of two vectors by subtracting corresponding vector values # . Subtraction of a scalar value from vector values ($Vector - 1) # # Caveats: # . Subtraction of a vector from scalar is not allowed (1 - $Vector) # sub _VectorSubtractionOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorSubtractionOperator: Vector subtracttion failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Do the subtraction... my($Vector, $ThisSize, $Index); $Vector = $This->Copy(); $ThisSize = $This->GetSize(); if ($OtherIsVector) { # $OrderFlipped is set to false for two vectors... for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] -= $Other->{Values}[$Index]; } } else { # Scalar subtraction... if ($OrderFlipped) { croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; } for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] -= $Other; } } return $Vector; } # # Vector multiplication operator supports two multiplication modes: # . Multiplication of two vectors by multiplying corresponding vector values # . Multiplying vector values by a scalar ($Vector * 1) # # Caveats: # . Multiplication of a scalar by a vector is not allowed (1 * $Vector) # sub _VectorMultiplicationOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorMultiplicationOperator: Vector addition failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Do the multiplication... my($Vector, $ThisSize, $Index); $Vector = $This->Copy(); $ThisSize = $This->GetSize(); if ($OtherIsVector) { # $OrderFlipped is set to false for two vectors... for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] *= $Other->{Values}[$Index]; } } else { if ($OrderFlipped) { croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; } # Scalar multiplication... for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] *= $Other; } } return $Vector; } # # Vector division operator supports two division modes: # . Division of two vectors by dividing corresponding vector values # . Dividing vector values by a scalar ($Vector / 2) # # Caveats: # . Division of a scalar by a vector is not allowed (1 / $Vector) # sub _VectorDivisionOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorDivisionOperator: Vector division failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Do the division... my($Vector, $ThisSize, $Index); $Vector = $This->Copy(); $ThisSize = $This->GetSize(); if ($OtherIsVector) { # $OrderFlipped is set to false for two vectors... for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] /= $Other->{Values}[$Index]; } } else { if ($OrderFlipped) { croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; } # Scalar divison... for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] /= $Other; } } return $Vector; } # # Vector exponentiation operator supports two exponentiation modes: # . Exponentiation of two vectors by exponentiation of corresponding vector values # . Exponentiation of vector values by a scalar ($Vector ** 2) # # Caveats: # . Exponent of scalar by a vector is not allowed (2 ** $Vector) # sub _VectorExponentiationOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorExponentiationOperator: Vector exponentiation failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Do the exponentiation... my($Vector, $ThisSize, $Index); $Vector = $This->Copy(); $ThisSize = $This->GetSize(); if ($OtherIsVector) { # $OrderFlipped is set to false for two vectors... for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] **= $Other->{Values}[$Index]; } } else { if ($OrderFlipped) { croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; } # Scalar exponentiation... for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] **= $Other; } } return $Vector; } # # Vector modulus operator supports two modulus modes: # . Modulus of two vectors by taking modulus between corresponding vector values # . Modulus of vector values by a scalar ($Vector % 2) # # Caveats: # . Modulus of scalar by a vector is not allowed (2 % $Vector) # sub _VectorModulusOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorModulusOperator: Vector exponentiation failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Take the modulus... my($Vector, $ThisSize, $Index); $Vector = $This->Copy(); $ThisSize = $This->GetSize(); if ($OtherIsVector) { # $OrderFlipped is set to false for two vectors... for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] %= $Other->{Values}[$Index]; } } else { if ($OrderFlipped) { croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; } # Scalar modulus... for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] %= $Other; } } return $Vector; } # # Vector dot product operator supports two modes: # . Dot product of two 3D vectors # . Concatenation of a vector and a scalar # sub _VectorDotProductOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorDotProductOperator: Vector dot product failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); if ($OtherIsVector) { # Calculate dot product of two 3D vectors... my($DotProduct); if ($This->GetSize() != 3) { croak "Error: ${ClassName}->${ErrorMsg}: Both vectors must be 3D vectors..."; } $DotProduct = $This->GetX() * $Other->GetX + $This->GetY() * $Other->GetY() + $This->GetZ * $Other->GetZ(); return $DotProduct; } else { # Do a string concatenation and return the string... if ($OrderFlipped) { return $Other . $This->StringifyVector(); } else { return $This->StringifyVector() . $Other; } } } # # Vector cross product operator genrates a new vector which is the cross # product of two 3D vectors. # # For two vectors, V1 (X1, Y1, Z1) and V2 (X2, Y2, Z2), cross product # V1 x V2 corresponds: (Y1.Z2 - Z1.Y2), (Z1.X2 - X1.Z2), (X1.Y2 - Y1.X2) # sub _VectorCrossProductOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorCrossProductOperator: Vector cross product failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); if (!$OtherIsVector) { croak "Error: ${ClassName}->${ErrorMsg}: Both object must be vectors..."; } # Calculate cross product of two 3D vectors... if ($This->GetSize() != 3) { croak "Error: ${ClassName}->${ErrorMsg}: Both vectors must be 3D vectors..."; } my($Vector, $X, $Y, $Z); $X = $This->GetY() * $Other->GetZ() - $This->GetZ() * $Other->GetY(); $Y = $This->GetZ() * $Other->GetX() - $This->GetX() * $Other->GetZ(); $Z = $This->GetX() * $Other->GetY() - $This->GetY() * $Other->GetX(); $Vector = (ref $This)->new($X, $Y, $Z); return $Vector; } # # Vector booelan operator checks whether a vector contains at least one non-zero # value... # sub _VectorBooleanOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorBooleanOperator: Vector boolean operation failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); my($Size, $Index); $Size = $This->GetSize(); for $Index (0 .. ($Size - 1)) { if ($This->{Values}[$Index] != 0) { return 1; } } return 0; } # # Vector not booelan operator checks whether all values of a vector are zero. # sub _VectorNotBooleanOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorNotBooleanOperator: Vector not boolean operation failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); my($Size, $Index); $Size = $This->GetSize(); for $Index (0 .. ($Size - 1)) { if ($This->{Values}[$Index] != 0) { return 0; } } return 1; } # # Vector equal operator supports two modes: # . Comparion of corresponding values in two vectors # . Comparing vectors values to a scalar ($Vector == 2) # # Caveats: # . Comparison of a scalar to vector values is not allowed (2 == $Vector) # sub _VectorEqualOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg, $CheckVectorSizes); $ErrorMsg = "_VectorEqualOperator: Vector equal comparison failed"; $CheckVectorSizes = 0; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckVectorSizes); # Do the comparison... my($ThisSize, $Index); $ThisSize = $This->GetSize(); if ($OtherIsVector) { # $OrderFlipped is set to false for two vectors... my($OtherSize) = $Other->GetSize(); if ($ThisSize != $OtherSize) { return 0; } for $Index (0 .. ($ThisSize -1)) { if ($This->{Values}[$Index] != $Other->{Values}[$Index]) { return 0; } } } else { if ($OrderFlipped) { croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; } # Scalar comparison... for $Index (0 .. ($ThisSize -1)) { if ($This->{Values}[$Index] != $Other) { return 0; } } } return 1; } # # Vector not equal operator supports two modes: # . Comparion of corresponding values in two vectors # . Comparing vectors values to a scalar ($Vector != 2) # # Caveats: # . Comparison of a scalar to vector values is not allowed (2 != $Vector2) # sub _VectorNotEqualOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg, $CheckVectorSizes); $ErrorMsg = "_VectorNotEqualOperator: Vector not equal comparison failed"; $CheckVectorSizes = 0; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckVectorSizes); # Do the comparison... my($ThisSize, $Index); $ThisSize = $This->GetSize(); if ($OtherIsVector) { # $OrderFlipped is set to false for two vectors... my($OtherSize) = $Other->GetSize(); if ($ThisSize != $OtherSize) { return 1; } for $Index (0 .. ($ThisSize -1)) { if ($This->{Values}[$Index] == $Other->{Values}[$Index]) { return 0; } } } else { if ($OrderFlipped) { croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; } # Scalar comparison... for $Index (0 .. ($ThisSize -1)) { if ($This->{Values}[$Index] == $Other) { return 0; } } } return 1; } # # Vector less than operator supports two modes: # . Comparion of corresponding values in two vectors # . Comparing vectors values to a scalar ($Vector < 2) # # Caveats: # . Comparison of a scalar to vector values is not allowed (2 < $Vector2) # sub _VectorLessThanOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorLessThanOperator: Vector less than comparison failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Do the comparison... my($ThisSize, $Index); $ThisSize = $This->GetSize(); if ($OtherIsVector) { # $OrderFlipped is set to false for two vectors... for $Index (0 .. ($ThisSize -1)) { if ($This->{Values}[$Index] >= $Other->{Values}[$Index]) { return 0; } } } else { if ($OrderFlipped) { croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; } # Scalar comparison... for $Index (0 .. ($ThisSize -1)) { if ($This->{Values}[$Index] >= $Other) { return 0; } } } return 1; } # # Vector less than equla operator supports two modes: # . Comparion of corresponding values in two vectors # . Comparing vectors values to a scalar ($Vector <= 2) # # Caveats: # . Comparison of a scalar to vector values is not allowed (2 <= $Vector2) # sub _VectorLessThanEqualOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorLessThanEqualOperator: Vector less than equal comparison failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Do the comparison... my($ThisSize, $Index); $ThisSize = $This->GetSize(); if ($OtherIsVector) { # $OrderFlipped is set to false for two vectors... for $Index (0 .. ($ThisSize -1)) { if ($This->{Values}[$Index] > $Other->{Values}[$Index]) { return 0; } } } else { if ($OrderFlipped) { croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; } # Scalar comparison... for $Index (0 .. ($ThisSize -1)) { if ($This->{Values}[$Index] > $Other) { return 0; } } } return 1; } # # Vector greatar than operator supports two modes: # . Comparion of corresponding values in two vectors # . Comparing vectors values to a scalar ($Vector > 2) # # Caveats: # . Comparison of a scalar to vector values is not allowed (2 > $Vector2) # sub _VectorGreatarThanOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorGreatarThanOperator: Vector greatar than comparison failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Do the comparison... my($ThisSize, $Index); $ThisSize = $This->GetSize(); if ($OtherIsVector) { # $OrderFlipped is set to false for two vectors... for $Index (0 .. ($ThisSize -1)) { if ($This->{Values}[$Index] <= $Other->{Values}[$Index]) { return 0; } } } else { if ($OrderFlipped) { croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; } # Scalar comparison... for $Index (0 .. ($ThisSize -1)) { if ($This->{Values}[$Index] <= $Other) { return 0; } } } return 1; } # # Vector greatar than equal operator supports two modes: # . Comparion of corresponding values in two vectors # . Comparing vectors values to a scalar ($Vector >= 2) # # Caveats: # . Comparison of a scalar to vector values is not allowed (2 <= $Vector2) # sub _VectorGreatarThanEqualOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorGreatarThanEqualOperator: Vector greatar than equal comparison failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Do the comparison... my($ThisSize, $Index); $ThisSize = $This->GetSize(); if ($OtherIsVector) { # $OrderFlipped is set to false for two vectors... for $Index (0 .. ($ThisSize -1)) { if ($This->{Values}[$Index] < $Other->{Values}[$Index]) { return 0; } } } else { if ($OrderFlipped) { croak "Error: ${ClassName}->${ErrorMsg}: First object must be a vector..."; } # Scalar comparison... for $Index (0 .. ($ThisSize -1)) { if ($This->{Values}[$Index] < $Other) { return 0; } } } return 1; } # # Vector negative value operator returns a vector with values corresponding to # negative values of a vector # sub _VectorNegativeValueOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorNegativeValueOperator: Vector negative value operation failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Take the negative value... my($Vector, $ThisSize, $Index); $Vector = $This->Copy(); $ThisSize = $This->GetSize(); for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] = - $This->{Values}[$Index]; } return $Vector; } # # Vector absolute value operator returns a vector with values corresponding to # absolute values of a vector # sub _VectorAbsoluteValueOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorAbsoluteValueOperator: Vector absolute value operation failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Take the absolute value... my($Vector, $ThisSize, $Index); $Vector = $This->Copy(); $ThisSize = $This->GetSize(); for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] = abs $This->{Values}[$Index]; } return $Vector; } # # Vector exp natural base operator returns a vector with values corresponding to # e raised to the power of values in a vector # sub _VectorExpNaturalBaseOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorExpNaturalBaseOperator: Vector exp operation failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Take the absolute value... my($Vector, $ThisSize, $Index); $Vector = $This->Copy(); $ThisSize = $This->GetSize(); for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] = exp $This->{Values}[$Index]; } return $Vector; } # # Vector log natural base operator returns a vector with values corresponding to # log of values in a vector # sub _VectorLogNaturalBaseOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorLogNaturalBaseOperator: Vector log operation failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Take the absolute value... my($Vector, $ThisSize, $Index); $Vector = $This->Copy(); $ThisSize = $This->GetSize(); for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] = log $This->{Values}[$Index]; } return $Vector; } # # Vector cosine operator returns a vector with values corresponding to cosine of values # in a vector. Input vector values are assumed to be in radians. # sub _VectorCosineOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorCosineOperator: Vector cos operation failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Take the absolute value... my($Vector, $ThisSize, $Index); $Vector = $This->Copy(); $ThisSize = $This->GetSize(); for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] = cos $This->{Values}[$Index]; } return $Vector; } # # Vector sine operator returns a vector with values corresponding to sine of values # in a vector. Input vector values are assumed to be in radians. # sub _VectorSineOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorSineOperator: Vector sin operation failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Take the absolute value... my($Vector, $ThisSize, $Index); $Vector = $This->Copy(); $ThisSize = $This->GetSize(); for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] = sin $This->{Values}[$Index]; } return $Vector; } # # Vector square root returns a vector with values corresponding to sqrt of values # in a vector. # sub _VectorSquareRootOperator { my($This, $Other, $OrderFlipped, $OtherIsVector, $ErrorMsg); $ErrorMsg = "_VectorSquareRootOperator: Vector sqrt operation failed"; ($This, $Other, $OrderFlipped, $OtherIsVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_); # Take the absolute value... my($Vector, $ThisSize, $Index); $Vector = $This->Copy(); $ThisSize = $This->GetSize(); for $Index (0 .. ($ThisSize -1)) { $Vector->{Values}[$Index] = sqrt $This->{Values}[$Index]; } return $Vector; } # Turn vector into array for @{$Vector} operation... sub _VectorToArrayOperator { my($This) = @_; return \@{$This->{Values}}; } # Turn vector into number for $#Vector operation: It's the size of vector... sub _NumifyVector { my($This) = @_; return $This->GetSize(); } # Process parameters passed to overloaded operators... # # For uninary operators, $SecondParameter is not defined. sub _ProcessOverloadedOperatorParameters { my($ErrorMsg, $FirstParameter, $SecondParameter, $ParametersOrderStatus, $CheckVectorSizesStatus) = @_; my($This, $Other, $OrderFlipped, $OtherIsVector, $CheckVectorSizes); ($This, $Other) = ($FirstParameter, $SecondParameter); $OrderFlipped = (defined($ParametersOrderStatus) && $ParametersOrderStatus) ? 1 : 0; $CheckVectorSizes = (defined $CheckVectorSizesStatus) ? $CheckVectorSizesStatus : 1; _ValidateVector($ErrorMsg, $This); $OtherIsVector = 0; if (defined($Other) && (ref $Other)) { # Make sure $Other is a vector... _ValidateVector($ErrorMsg, $Other); if ($CheckVectorSizes) { _ValidateVectorSizesAreEqual($ErrorMsg, $This, $Other); } $OtherIsVector = 1; } return ($This, $Other, $OrderFlipped, $OtherIsVector); } # Is it a vector object? sub _IsVector { my($Object) = @_; return (Scalar::Util::blessed($Object) && $Object->isa($ClassName)) ? 1 : 0; } # Make sure it's a vector reference... sub _ValidateVector { my($ErrorMsg, $Vector) = @_; if (!_IsVector($Vector)) { croak "Error: ${ClassName}->${ErrorMsg}: Object must be a vector..."; } } # Make sure size of the two vectors contain the same number of values... sub _ValidateVectorSizesAreEqual { my($ErrorMsg, $Vector1, $Vector2) = @_; if ($Vector1->GetSize() != $Vector2->GetSize()) { croak "Error: ${ClassName}->${ErrorMsg}: Size of the vectors must be same..."; } } # Return a string containing vector values... sub StringifyVector { my($This) = @_; my($VectorString, $FormatString, $PrintFormat, $Size, @ValuesFormat); $PrintFormat = (exists $This->{ValueFormat}) ? $This->{ValueFormat} : $ValueFormat; @ValuesFormat = ($PrintFormat) x scalar @{$This->{Values}}; $FormatString = join ' ', @ValuesFormat; $Size = $This->GetSize(); $VectorString = sprintf "<Size: $Size; Values: [ $FormatString ] >", @{$This->{Values}}; return $VectorString; } 1; __END__ =head1 NAME Vector =head1 SYNOPSIS use Vector; use Vector qw(:all); =head1 DESCRIPTION B<Vector> class provides the following methods: new, AddValues, Copy, GetLength, GetMagnitude, GetNumOfNonZeroValues, GetPercentOfNonZeroValues, GetSize, GetValue, GetValues, GetX, GetXYZ, GetY, GetZ, IsVector, Normalize, SetValue, SetValuePrintFormat, SetX, SetXYZ, SetY, SetZ, StringifyVector, IsVector The following functions are available: IsVector, SetValuePrintFormat UnitXVector, UnitYVector, UnitZVector, UnitVector, ZeroVector The following operators are overloaded: "" 0+ bool @{} + - * / % x . == != < <= > >= neg abs exp log sqrt cos sin =head2 FUNCTIONS =over 4 =item B<new> $NewVector = new Vector(); $NewVector = new Vector(@Values); $NewVector = new Vector(\@Values); $NewVector = new Vector($AnotherVector); Creates a new B<Vector> object containing I<Values> and returns B<NewVector> object. In case no I<Values> are specified, an empty B<Vector> is created. =item B<AddValues> $Vector->AddValues(@Values); $Vector->AddValues(\@Values); $Vector->AddValues($AnotherVector); Adds values to I<Vector> using an array, reference to an array or another vector and returns I<Vector>. =item B<Copy> $NewVector = $Vector->Copy(); Creates a copy of I<Vector> and returns I<NewVector>. =item B<GetLength> $Length = $Vector->GetLength(); Returns I<Lengh> of a 3D I<Vector> corresponding to its dot product. =item B<GetMagnitude> $Length = $Vector->GetMagnitude(); Returns I<Lengh> of a 3D I<Vector> corresponding to its dot product. =item B<GetNumOfNonZeroValues> $Value = $Vector->GetNumOfNonZeroValues(); Returns number of non-zero values in I<Vector>. =item B<GetPercentOfNonZeroValues> $Value = $Vector->GetPercentOfNonZeroValues(); Returns percent of non-zero values in I<Vector>. =item B<GetSize> $Size = $Vector->GetSize(); Returns size of a I<Vector> corresponding to number of its values. =item B<GetValue> $Value = $Vector->GetValues($Index); Returns vector B<Value> specified using I<Index> starting at 0. =item B<GetValues> @Values = $Vector->GetValues(); $ValuesRef = $Vector->GetValues(); Returns an array or a reference to an array containing all I<Vector> values. =item B<GetX> $X = $Vector->GetX(); Returns B<X> value of a 3D I<Vector> =item B<GetXYZ> @XYZValues = $Vector->GetXYZ(); $XYZValuesRef = $Vector->GetXYZ(); Returns B<XYZ> values of a 3D I<Vector> as an array or a reference to an array containing the values. =item B<GetY> $Y = $Vector->GetY(); Returns B<Y> value of a 3D I<Vector>. =item B<GetZ> $Z = $Vector->GetZ(); Returns B<Z> value of a 3D I<Vector>. =item B<IsVector> $Status = Vector::IsVector($Object); Returns 1 or 0 based on whether I<Object> is a B<Vector> object. =item B<Normalize> $Vector->Normalize(); Normalizes a 3D I<Vector> by dividing its values by the length and returns I<Vector>. =item B<SetValue> $Vector->SetValue($Index, $Value); Sets a I<Vector> value specified by I<Index> to I<Value> and returns I<Vector>. =item B<SetValuePrintFormat> $Vector->SetValuePrintFormat($ValuePrintFormat); Vector::SetValuePrintFormat($ValuePrintFormat); Sets format for printing vector values for a specified I<Vector> or the whole class. Default format: I<%g>. =item B<SetX> $Vector->SetX($Value); Sets B<X> value of a 3D vector to I<Value> and returns I<Vector>. =item B<SetXYZ> $Vector->SetXYZ(@Values); $Vector->SetXYZ(\@Values); $Vector->SetXYZ($AnotherVector); Sets B<XYZ> values of a 3D vector and returns I<Vector>. =item B<SetY> $Vector->SetY($Value); Sets B<Y> value of a 3D vector to I<Value> and returns I<Vector>. =item B<SetZ> $Vector->SetZ($Value); Sets B<Z> value of a 3D vector to I<Value> and returns I<Vector>. =item B<StringifyVector> $String = $Vector->StringifyVector(); Returns a string containing information about I<Vector> object. =item B<UnitVector> $UnitVector = UnitVector([$Size]); $UnitVector = Vector::UnitVector([$Size]); Returns a B<UnitVector> of I<Size>. Default size: I<3>. =item B<UnitXVector> $UnitXVector = UnitXVector(); Returns a 3D B<UnitXVector>. =item B<UnitYVector> $UnitYVector = UnitYVector(); Returns a 3D B<UnitYVector>. =item B<UnitZVector> $UnitZVector = UnitZVector(); Returns a 3D B<UnitZVector>. =item B<ZeroVector> $UnitVector = ZeroVector([$Size]); $UnitVector = Vector::ZeroVector([$Size]); Returns a B<ZeroVector> of I<Size>. Default size: I<3>. =back =head1 AUTHOR Manish Sud <msud@san.rr.com> =head1 SEE ALSO BitVector.pm =head1 COPYRIGHT Copyright (C) 2015 Manish Sud. All rights reserved. This file is part of MayaChemTools. MayaChemTools is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. =cut