Math-Quaternion-0.07/000700 000765 000024 00000000000 12242143306 014370 5ustar00jonstaff000000 000000 Math-Quaternion-0.07/Changes000644 000765 000024 00000002204 12242143067 015677 0ustar00jonstaff000000 000000 Revision history for Perl module Math::Quaternion 0.07 2013-11-17 13:34:00 UTC - Updated Changes to conform to CPAN::Changes::Spec (thanks to NEILB) - Patch from DJERIUS: rotation() incorrectly generates a non-rotating quaternion when passed two vectors which are parallel but opposite. 0.06 2013-08-24 12:40:20 BST - Updated Changelog! 0.05 2013-08-24 12:27:43 BST - Merged Bruce Gray's patch for exponentiation 0.04 2013-05-19 00:05:56 BST - Added code and tests to fix crashing when creating quaternion from two parallel vectors (i.e. cross product is zero). - Added guard code against zero-length rotation vectors. - Added new fields to META.yml; fixed or removed old fields. - Added thanks to Daniel Connelly and Luc Vereecken. - Fixed POD of method new() - axis and angle were swapped. 0.03 2008-05-05 00:41:56 BST - fixed a bug in the documentation pointed out by Andreas Lund - fixed a warning during 001_basic.t 0.02 2004-07-10 17:22:47 BST - some small markup fixes in the POD 0.01 2003-01-05 00:17:12 - original version; created by h2xs 1.22 with options -XAn Quaternion Math-Quaternion-0.07/lib/000700 000765 000024 00000000000 12242143306 015136 5ustar00jonstaff000000 000000 Math-Quaternion-0.07/Makefile.PL000644 000765 000024 00000001073 12242141716 016360 0ustar00jonstaff000000 000000 use 5.006; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Math::Quaternion', 'VERSION_FROM' => 'lib/Math/Quaternion.pm', # finds $VERSION 'PREREQ_PM' => { Test::More => 0, }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/Math/Quaternion.pm',# retrieve abstract from module AUTHOR => 'Jonathan Chin ') : ()), ); Math-Quaternion-0.07/MANIFEST000644 000765 000024 00000000400 12242143307 015526 0ustar00jonstaff000000 000000 Changes Makefile.PL MANIFEST lib/Math/Quaternion.pm README t/001_basic.t t/002_overloading.t META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Math-Quaternion-0.07/META.json000600 000765 000024 00000001603 12242143306 016013 0ustar00jonstaff000000 000000 { "abstract" : "Perl class to represent quaternions", "author" : [ "Jonathan Chin " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Math-Quaternion", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Test::More" : "0" } } }, "release_status" : "stable", "version" : "0.07" } Math-Quaternion-0.07/META.yml000600 000765 000024 00000001001 12242143306 015633 0ustar00jonstaff000000 000000 --- abstract: 'Perl class to represent quaternions' author: - 'Jonathan Chin ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Math-Quaternion no_index: directory: - t - inc requires: Test::More: 0 version: 0.07 Math-Quaternion-0.07/README000644 000765 000024 00000033467 12242141716 015302 0ustar00jonstaff000000 000000 NAME Math::Quaternion - Perl class to represent quaternions SYNOPSIS use Math::Quaternion qw(slerp); my $q = Math::Quaternion->new; # Make a new unit quaternion # Make a rotation about the axis (0,1,0) my $q2 = Math::Quaternion->new({axis=>[0,1,0],angle=>0.1}); my @v = (1,2,3); # A vector. my @vrotated = $q2->rotate_vector(@v); # Rotate @v about (0,1,0). my $q3 = Math::Quaternion::rotation(0.7,2,1,4); # A different rotation. my $q4 = slerp($q2,$q3,0.5); # Interpolated rotation. my @vinterp = $q4->rotate_vector(@v); DESCRIPTION This package lets you create and manipulate quaternions. A quaternion is a mathematical object developed as a kind of generalization of complex numbers, usually represented by an array of four real numbers, and is often used to represent rotations in three-dimensional space. See, for example, for more details on the mathematics of quaternions. Quaternions can be added, subtracted, and scaled just like complex numbers or vectors -- they can also be multiplied, but quaternion multiplication DOES NOT COMMUTE. That is to say, if you have quaternions $q1 and $q2, then in general $q1*$q2 != $q2*$q1. This is related to their use in representing rotations, which also do not commute. If you just want to represent rotations and don't care about the internal mathematical details, this should be all you need to know: All quaternions have a quantity called the "norm", similar to the length of a vector. A quaternion with norm equal to 1 is called a "unit quaternion". All quaternions which represent rotations are unit quaternions. If you call new() without any arguments, it will give you a unit quaternion which represents no rotation: $q = Math::Quaternion->new; You can make a quaternion which represents a rotation of a given angle (in radians) about a given axis: $qrot = Math::Quaternion->new({ axis => 0.1, angle => [ 2,3,4]}); Say you have two rotations, $q1 and $q2, and you want to make a quaternion representing a rotation of $q1 followed by $q2. Then, you do: $q3 = $q2 * $q1; # Rotate by $q1, followed by $q2. Remember that this is NOT the same as $q1 * $q2, which will reverse the order of the rotations. If you perform many iterated quaternion operations, the result may not quite be a unit quaternion due to numerical inaccuracies. You can make sure any quaternion has unit length, by doing: $unitquat = $anyquat->normalize; If you have a rotation quaternion, and you want to find the 3x3 matrix which represents the corresponding rotation, then: @matrix = $q->matrix3x3; Similarly, you can generate a 4x4 matrix of the sort you'd pass to OpenGL: @glmatrix = $q->matrix4x4; If you have a vector representing a direction, and you want to rotate the vector by a quaternion $q: my @vector = (0,0,1); # Vector pointing in the Z direction. my @newvec = $q->rotate_vector(@vector); # New direction. Say you're using quaternions to represent the orientation of a camera, and you have two quaternions: one to represent a starting orientation, and another to represent a finishing position. If you want to find all the quaternions representing the orientations in between, allowing your camera to move smoothly from start to finish, use the slerp() routine: use Math::Quaternion qw(slerp); my ($qstart, $qend) = ... ; # Set $tween to 9 points between start and end, exclusive. for my $t (1..9) { my $tween = slerp($qstart,$qend,0.1*$t); ... } METHODS new my $q = Math::Quaternion->new; # Make a new unit quaternion. my $q2 = Math::Quaternion->new(1,2,3,4);# Make a specific quaternion. my $q3 = Math::Quaternion->new($q2); # Copy an existing quaternion. my $q4 = Math::Quaternion->new(5.6); # Make the quaternion (5.6,0,0,0) my $q5 = Math::Quaternion->new(7,8,9); # Make the quaternion (0,7,8,9) my $q6 = Math::Quaternion->new({ # Make a quaternion corresponding axis => [ 1,2,3], # to a rotation of 0.2 radians angle => 0.2, # about the vector (1,2,3). }); my $q7 = Math::Quaternion->new({ # Make a quaternion which would 'v1' => [ 0,1,2], # rotate the vector (0,1,2) onto 'v2' => [ -1,2,0], # the vector (-1,2,0). }); If no parameters are given, a unit quaternion is returned. If one non-reference parameter is given, a "scalar" quaternion is returned. If one parameter is given and it is a reference to a quaternion or an array of four numbers, the corresponding quaternion object is returned. If three parameters are given, a "vector" quaternion is returned. If four parameters are given, the corresponding quaternion is returned. Rotation quaternions may also be created by passing a hashref with the axis and angle of rotation, or by specifying two vectors specifying start and finish directions. Bear in mind that the latter method will take the shortest path between the two vectors, ignoring the "roll" angle. unit Returns a unit quaternion. my $u = Math::Quaternion->unit; # Returns the quaternion (1,0,0,0). conjugate Returns the conjugate of its argument. my $q = Math::Quaternion->new(1,2,3,4); my $p = $q->conjugate; # (1,-2,-3,-4) inverse Returns the inverse of its argument. my $q = Math::Quaternion->new(1,2,3,4); my $qi = $q->inverse; normalize Returns its argument, normalized to unit norm. my $q = Math::Quaternion->new(1,2,3,4); my $qn = $q->normalize; modulus Returns the modulus of its argument, defined as the square root of the scalar obtained by multiplying the quaternion by its conjugate. my $q = Math::Quaternion->new(1,2,3,4); print $q->modulus; isreal Returns 1 if the given quaternion is real ,ie has no quaternion part, or else 0. my $q1 = Math::Quaternion->new(1,2,3,4); my $q2 = Math::Quaternion->new(5,0,0,0); print $q1->isreal; # 1; print $q2->isreal; # 0; multiply Performs a quaternion multiplication of its two arguments. If one of the arguments is a scalar, then performs a scalar multiplication instead. my $q1 = Math::Quaternion->new(1,2,3,4); my $q2 = Math::Quaternion->new(5,6,7,8); my $q3 = Math::Quaternion::multiply($q1,$q2); # (-60 12 30 24) my $q4 = Math::Quaternion::multiply($q1,$q1->inverse); # (1 0 0 0) dot Returns the dot product of two quaternions. my $q1=Math::Quaternion->new(1,2,3,4); my $q2=Math::Quaternion->new(2,4,5,6); my $q3 = Math::Quaternion::dot($q1,$q2); plus Performs a quaternion addition of its two arguments. my $q1 = Math::Quaternion->new(1,2,3,4); my $q2 = Math::Quaternion->new(5,6,7,8); my $q3 = Math::Quaternion::plus($q1,$q2); # (6 8 10 12) minus Performs a quaternion subtraction of its two arguments. my $q1 = Math::Quaternion->new(1,2,3,4); my $q2 = Math::Quaternion->new(5,6,7,8); my $q3 = Math::Quaternion::minus($q1,$q2); # (-4 -4 -4 -4) power Raise a quaternion to a scalar or quaternion power. my $q1 = Math::Quaternion->new(1,2,3,4); my $q2 = Math::Quaternion::power($q1,4); # ( 668 -224 -336 -448 ) my $q3 = $q1->power(4); # ( 668 -224 -336 -448 ) my $q4 = $q1**(-1); # Same as $q1->inverse use Math::Trig; my $q5 = exp(1)**( Math::Quaternion->new(pi,0,0) ); # approx (-1 0 0 0) negate Negates the given quaternion. my $q = Math::Quaternion->new(1,2,3,4); my $q1 = $q->negate; # (-1,-2,-3,-4) squarednorm Returns the squared norm of its argument. my $q1 = Math::Quaternion->new(1,2,3,4); my $sn = $q1->squarednorm; # 30 scale Performs a scalar multiplication of its two arguments. my $q = Math::Quaternion->new(1,2,3,4); my $qq = Math::Quaternion::scale($q,2); # ( 2 4 6 8) my $qqq= $q->scale(3); # ( 3 6 9 12 ) rotation Generates a quaternion corresponding to a rotation. If given three arguments, interprets them as an angle and the three components of an axis vector. use Math::Trig; # Define pi. my $theta = pi/2; # Angle of rotation my $rotquat = Math::Quaternion::rotation($theta,0,0,1); # $rotquat now represents a rotation of 90 degrees about Z axis. my ($x,$y,$z) = (1,0,0); # Unit vector in the X direction. my ($xx,$yy,$zz) = $rotquat->rotate_vector($x,$y,$z); # ($xx,$yy,$zz) is now ( 0, 1, 0), to within floating-point error. rotation() can also be passed a scalar angle and a reference to a vector (in either order), and will generate the corresponding rotation quaternion. my @axis = (0,0,1); # Rotate about Z axis $theta = pi/2; $rotquat = Math::Quaternion::rotation($theta,\@axis); If the arguments to rotation() are both references, they are interpreted as two vectors, and a quaternion is returned which rotates the first vector onto the second. my @startvec = (0,1,0); # Vector pointing north my @endvec = (-1,0,0); # Vector pointing west $rotquat = Math::Quaternion::rotation(\@startvec,\@endvec); my @newvec = $rotquat->rotate_vector(@startvec); # Same as @endvec rotation_angle Returns the angle of rotation represented by the quaternion argument. my $q = Math::Quaternion::rotation(0.1,2,3,4); my $theta = $q->rotation_angle; # Returns 0.1 . rotation_axis Returns the unit vector representing the axis about which rotations will be performed, for the rotation represented by the quaternion argument. my $q = Math::Quaternion::rotation(0.1,1,1,0); my @v = $q->rotation_axis; # Returns (0.5*sqrt(2),0.5*sqrt(2),0) rotate_vector When called as a method on a rotation quaternion, uses this quaternion to perform the corresponding rotation on the vector argument. use Math::Trig; # Define pi. my $theta = pi/2; # Rotate 90 degrees my $rotquat = Math::Quaternion::rotation($theta,0,0,1); # about Z axis my ($x,$y,$z) = (1,0,0); # Unit vector in the X direction. my ($xx,$yy,$zz) = $rotquat->rotate_vector($x,$y,$z) # ($xx,$yy,$zz) is now ( 0, 1, 0), to within floating-point error. matrix4x4 Takes one argument: a rotation quaternion. Returns a 16-element array, equal to the OpenGL matrix which represents the corresponding rotation. my $rotquat = Math::Quaternion::rotation($theta,@axis); # My rotation. my @m = $rotquat->matrix4x4; matrix3x3 Takes one argument: a rotation quaternion. Returns a 9-element array, equal to the 3x3 matrix which represents the corresponding rotation. my $rotquat = Math::Quaternion::rotation($theta,@axis); # My rotation. my @m = $rotquat->matrix3x3; matrix4x4andinverse Similar to matrix4x4, but returnes a list of two array references. The first is a reference to the rotation matrix; the second is a reference to its inverse. This may be useful when rendering sprites, since you can multiply by the rotation matrix for the viewer position, perform some translations, and then multiply by the inverse: any resulting rectangles drawn will always face the viewer. my $rotquat = Math::Quaternion::rotation($theta,@axis); # My rotation. my ($matref,$invref) = $rotquat->matrix4x4andinverse; stringify Returns a string representation of the quaternion. This is used to overload the '""' operator, so that quaternions may be freely interpolated in strings. my $q = Math::Quaternion->new(1,2,3,4); print $q->stringify; # "( 1 2 3 4 )" print "$q"; # "( 1 2 3 4 )" slerp Takes two quaternion arguments and one scalar; performs spherical linear interpolation between the two quaternions. The quaternion arguments are assumed to be unit quaternions, and the scalar is assumed to lie between 0 and 1: a scalar argument of zero will return the first quaternion argument, and a scalar argument of one will return the second. use Math::Trig; my @axis = (0,0,1); my $rq1 = Math::Quaternion::rotation(pi/2,\@axis); # 90 degs about Z my $rq2 = Math::Quaternion::rotation(pi,\@axis); # 180 degs about Z my $interp = Math::Quaternion::slerp($rq1,$rq2,0.5); # 135 degs about Z exp Exponential operator e^q. Any quaternion q can be written as x+uy, where x is a real number, and u is a unit pure quaternion. Then, exp(q) == exp(x) * ( cos(y) + u sin(y) ). my $q = Math::Quaternion->new(1,2,3,4); print Math::Quaternion::exp($q); log Returns the logarithm of its argument. The logarithm of a negative real quaternion can take any value of them form (log(-q0),u*pi) for any unit vector u. In these cases, u is chosen to be (1,0,0). my $q = Math::Quaternion->new(1,2,3,4); print Math::Quaternion::log($q); AUTHOR Jonathan Chin, ACKNOWLEDGEMENTS Thanks to Rene Uittenbogaard for useful suggestions. SEE ALSO Acts 12:4 COPYRIGHT AND LICENSE Copyright 2003 by Jonathan Chin This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Math-Quaternion-0.07/t/000700 000765 000024 00000000000 12242143306 014633 5ustar00jonstaff000000 000000 Math-Quaternion-0.07/t/001_basic.t000644 000765 000024 00000040456 12242142015 016500 0ustar00jonstaff000000 000000 use Test::More tests => 83; use Math::Trig; use strict; use Carp; use Math::Quaternion; # First, check that we can load the module... BEGIN { use_ok("Math::Quaternion"); } my $epsilon = 1e-10; # Precision to which I can be bothered with worrying. my $pi = 3.1459265358979323846; sub equal_fuzz { croak("Wrong number of args") unless (2==@_); my ($a,$b)=@_; if (0==$a) { if (abs($b)<$epsilon) { return 1; } else { return undef; } } if (0==$b) { if (abs($a)<$epsilon) { return 1; } else { return undef; } } if (abs(($a-$b)/$a) < $epsilon) { return 1; } else { return undef; } } # Take 5 args: a quat and four numbers. Return 1 if the quat is really a quat, # and equal to the four numbers. sub checkquat { croak("Wrong number of args") unless (5==@_); my ($q,@nos) = @_; if ("Math::Quaternion" ne ref $q) { return undef; } if ( equal_fuzz ($q->[0] , $nos[0]) && equal_fuzz ($q->[1] , $nos[1]) && equal_fuzz ($q->[2] , $nos[2]) && equal_fuzz ($q->[3] , $nos[3]) ) { return 1; } else { return undef; } } # take two vectors as array refs; return true if they are equivalent sub check_vector { croak("Wrong number of args") unless (2==@_); my ($v1, $v2) = @_; if ( equal_fuzz ($v1->[0] , $v2->[0]) && equal_fuzz ($v1->[1] , $v2->[1]) && equal_fuzz ($v1->[2] , $v2->[2]) ) { return 1; } else { return undef; } } sub quatequal_fuzz { my ($q1,$q2) = @_; if ( equal_fuzz ($q1->[0] , $q2->[0]) && equal_fuzz ($q1->[1] , $q2->[1]) && equal_fuzz ($q1->[2] , $q2->[2]) && equal_fuzz ($q1->[3] , $q2->[3]) ) { return 1; } else { return undef; } } # Build a random unit vector in R^3 sub random_unitvector { my $theta = rand($pi); my $phi = rand(2.0*$pi); my $ax = sin($theta) * cos($phi); my $ay = sin($theta) * sin($phi); my $az = cos($theta); return ($ax,$ay,$az); } # Test constructors. my $q=undef; ok( ref($q = Math::Quaternion->new) eq "Math::Quaternion", "Math::Quaternion->new() makes a new quaternion..." ); ok( checkquat($q,1,0,0,0), "...and it's a unit quaternion by default."); my ($a,$b,$c,$d) = map {rand} 1..4; my ($e,$f,$g,$h) = map {rand} 1..4; my @randoms = map {rand} 1..4; my $q1 = Math::Quaternion->new($a,$b,$c,$d); my $q2 = Math::Quaternion->new($e,$f,$g,$h); my $q3 = Math::Quaternion->new(@randoms); ok( checkquat( $q = Math::Quaternion->new(1,2,3,4), 1,2,3,4), "Math::Quaternion->new(1,2,3,4) builds the correct quaternion."); ok( checkquat(Math::Quaternion->new($q),1,2,3,4), "Math::Quaternion->new(\$q) copies quaternion \$q"); ok( checkquat(Math::Quaternion->new([5,6,7,8]),5,6,7,8), "Math::Quaternion->new([5,6,7,8]) builds the correct quaternion."); ok( checkquat(Math::Quaternion->new($a),$a,0,0,0), "Math::Quaternion->new(\$a) builds a scalar quaternion"); ok( checkquat(Math::Quaternion->new($a,$b,$c),0,$a,$b,$c), "Math::Quaternion->new(\$a,\$b,\$c) builds a vector quaternion"); ok( equal_fuzz(Math::Quaternion::dot($q1,$q2), $a*$e+$b*$f+$c*$g+$d*$h), "Math::Quaternion::dot(\$q1,\$q2) gives a dot product"); eval { Math::Quaternion->new(1,2) }; ok( $@,"Math::Quaternion->new(1,2) fails."); ok( checkquat(Math::Quaternion->unit, 1,0,0,0), "Math::Quaternion->unit() builds a new unit quaternion"); ok( checkquat(Math::Quaternion::conjugate($q),1,-2,-3,-4), "Math::Quaternion::conjugate() conjugates"); ok( checkquat($q,1,2,3,4), "Math::Quaternion::conjugate leaves argument unchanged."); ok( checkquat(Math::Quaternion::negate($q1), -($q1->[0]), -($q1->[1]), -($q1->[2]), -($q1->[3])), "Math::Quaternion::negate() negates"); ok( checkquat( Math::Quaternion::plus($q1,$q2), $a+$e, $b+$f, $c+$g, $d+$h), "Math::Quaternion::plus() adds."); ok( checkquat( Math::Quaternion::plus($q2,$q1), $a+$e, $b+$f, $c+$g, $d+$h), "Math::Quaternion::plus() commutes."); ok( checkquat( Math::Quaternion::minus($q1,$q2), $a-$e, $b-$f, $c-$g, $d-$h), "Math::Quaternion::minus() subtracts."); ok( Math::Quaternion::squarednorm($q1) == $a*$a+$b*$b+$c*$c+$d*$d, "Math::Quaternion::squarednorm(\$q) returns squared norm of \$q"); ok( checkquat(Math::Quaternion::scale($q1,$e),$a*$e,$b*$e,$c*$e,$d*$e), "Math::Quaternion::scale() performs scalar multiplication"); my $q1c = Math::Quaternion::conjugate($q1); my $q1i = Math::Quaternion::inverse($q1); ok( checkquat(Math::Quaternion::multiply($q1,$q1c), Math::Quaternion::squarednorm($q1),0,0,0), "Multiplying with a conjugate gives the squared norm"); ok( checkquat(Math::Quaternion::multiply($q1,$q1i), 1,0,0,0), "Multiplying with inverse gives unit quaternion"); ok( quatequal_fuzz( Math::Quaternion::multiply( $q1, Math::Quaternion::plus($q2,$q3) ), Math::Quaternion::plus( Math::Quaternion::multiply($q1,$q2), Math::Quaternion::multiply($q1,$q3) ) ), "Quaternion multiplication is left-distributive"); ok( quatequal_fuzz( Math::Quaternion::multiply( Math::Quaternion::plus($q1,$q2), $q3, ), Math::Quaternion::plus( Math::Quaternion::multiply($q1,$q3), Math::Quaternion::multiply($q2,$q3) ) ), "Quaternion multiplication is right-distributive"); ok( quatequal_fuzz( Math::Quaternion::multiply($q1,Math::Quaternion::multiply($q2,$q3)), Math::Quaternion::multiply(Math::Quaternion::multiply($q1,$q2),$q3), ), "Quaternion multiplication is associative"); my $q1q2 = Math::Quaternion::multiply($q1,$q2); my ($a0,$a1,$a2,$a3) = @$q1; my ($b0,$b1,$b2,$b3) = @$q2; ok( checkquat($q1q2, $a0*$b0 - $a1*$b1 - $a2*$b2 - $a3*$b3, $a0*$b1 + $b0*$a1 + $a2*$b3 - $a3*$b2, $a0*$b2 + $b0*$a2 + $a3*$b1 - $a1*$b3, $a0*$b3 + $b0*$a3 + $a1*$b2 - $a2*$b1 ), "Math::Quaternion::multiply multiplies."); ok( equal_fuzz(1.0,Math::Quaternion::squarednorm(Math::Quaternion::normalize($q1))), "Math::Quaternion::normalize() produces a unit quaternion"); ok( quatequal_fuzz( Math::Quaternion::inverse(Math::Quaternion::normalize($q1)), Math::Quaternion::conjugate(Math::Quaternion::normalize($q1))), "The inverse of a unit quaternion is its conjugate"); my $exponent = int rand 100; my $q1manual = $q1; for (1..($exponent-1)) { $q1manual = Math::Quaternion::multiply($q1,$q1manual); } my $q1expon = Math::Quaternion::power($q1,$exponent); ok( quatequal_fuzz($q1manual,$q1expon), "Quaternions can be raised to integer exponents"); $exponent = rand 10; $q1expon = Math::Quaternion::power($q1,$exponent); ok( equal_fuzz($q1expon->modulus,($q1->modulus)**$exponent), "Quaternion powers raise magnitude to same power"); ok( quatequal_fuzz($q1i,Math::Quaternion::power($q1,-1)), "Quaternion raised to (-1)th power is inverse"); { # RT#86098 my $q = Math::Quaternion->new( -9, 0, 0, 0 ); ok( $q->isreal, 'A quaternion (which ->isreal)'); my $q_q = $q * $q; my $q_2 = eval { $q->power(2); }; my $lived = !$@; ok( checkquat($q_q, 81,0,0,0), "...can be multiplied by its self,"); ok( checkquat($q_2, 81,0,0,0), "...and can be raised to the power of 2"); ok( $lived, "...without dying."); } # Check exponentiation { my ($ux,$uy,$uz) = random_unitvector(); my $x = rand; my $y = rand; my $z = rand; my $theta = rand; my $q = Math::Quaternion->new($x,$y*$ux,$y*$uy,$y*$uz); my $etox = exp($x); my $cy = cos($y); my $yc = $etox * sin($y); # exp(q) for q=(r,0,0,0) should give (exp(r),0,0,0) ok(checkquat(Math::Quaternion::exp(Math::Quaternion->new($z)),exp($z),0,0,0), "Exponentiation of real quaternion works"); # exp(ut) for unit u, scalar t should give # ( cos(t), u*sin(t) ) ok(checkquat( Math::Quaternion::exp(Math::Quaternion->new($theta*$ux,$theta*$uy,$theta*$uz)), cos($theta),$ux*sin($theta),$uy*sin($theta),$uz*sin($theta)), "Exponentiation of pure quaternion works"); # exp(x+uy) = exp(x) ( cos(y) + u sin(y) ) ok(checkquat( Math::Quaternion::exp($q), $etox*$cy,$yc*$ux,$yc*$uy,$yc*$uz), "Quaternion exponentiation exponentiates"); # Check logarithms ok(checkquat(Math::Quaternion::log(Math::Quaternion->new($x)),log($x),0,0,0), "Logarithm of real quaternion works"); my $explogq = Math::Quaternion::exp(Math::Quaternion::log($q1)); my $logexpq = Math::Quaternion::log(Math::Quaternion::exp($q1)); ok(quatequal_fuzz($explogq,$logexpq), "Exponentiation and Logarithm are mutually inverse"); ok(quatequal_fuzz(Math::Quaternion::log($q1),Math::Quaternion::log([$a0,$a1,$a2,$a3])), "Math::Quaternion::log([a,b,c,d]) works"); } { my $ql = Math::Quaternion->new(-2,0,0,0); my $logq = Math::Quaternion::log($ql); ok( checkquat($logq, CORE::log(2),pi,0,0), "log( (-2,0,0,0) ) = (log(2),pi,0,0)"); } # Check that exp(q) is the same as e**q ok(quatequal_fuzz( Math::Quaternion::power(exp(1),$q1), Math::Quaternion::exp($q1)), "Scalar exp(1) raised to quaternion power is the same as exponentiation" ); my $s = rand; # Random scalar ok(quatequal_fuzz(Math::Quaternion::power($s,$q2), Math::Quaternion::exp(Math::Quaternion::multiply($q2,log($s)))), "a**b == exp(b*log(a)) for scalar a, quaternion b"); ok(quatequal_fuzz(Math::Quaternion::power($q1,$s), Math::Quaternion::exp(Math::Quaternion::multiply($s,Math::Quaternion::log($q1)))), "a**b == exp(b*log(a)) for quaternion a, scalar b"); ok(quatequal_fuzz(Math::Quaternion::power($q1,$q2), Math::Quaternion::exp(Math::Quaternion::multiply($q2,Math::Quaternion::log($q1)))), "a**b == exp(b*log(a)) for quaternion a,b"); # Build a random unit vector in R^3. my ($ax,$ay,$az) = random_unitvector(); my ($bx,$by,$bz) = random_unitvector(); ok( equal_fuzz(1,sqrt($ax*$ax+$ay*$ay+$az*$az)), "Sanity check: I can make a random unit vector properly"); my $theta = rand(0.25*$pi); my $rotquat = undef; my $rq2 = undef; ok( $rotquat = Math::Quaternion::rotation($theta,$ax,$ay,$az), "Math::Quaternion::rotation does not fail"); ok( equal_fuzz($rotquat->rotation_angle , $theta), "rotation_angle works"); ok( $rq2 = Math::Quaternion->new({axis => [$ax,$ay,$az],angle=>$theta}), "Math::Quaternion->new(\\\%hash) does not fail"); ok( quatequal_fuzz($rotquat,$rq2), "Math::Quaternion->new(\\\%hash) produces correct rotation"); ok(!defined( eval { Math::Quaternion::rotation(23,"skidoo"); 1; }), "Math::Quaternion::rotation(rubbish) fails"); ok(!defined( eval { Math::Quaternion::rotation(23,"skidoo",3,4,5); 1; }), "Math::Quaternion::rotation(much rubbish) fails"); my @vec = ($ax,$ay,$az); $rq2 = Math::Quaternion::rotation($theta,\@vec); ok(quatequal_fuzz($rotquat,$rq2),"Math::Quaternion::rotation(\$theta,\\\@vec) works"); $rq2 = Math::Quaternion::rotation(\@vec,$theta); ok(quatequal_fuzz($rotquat,$rq2),"Math::Quaternion::rotation(\\\@vec,\$theta) works"); my ($rax,$ray,$raz); ($rax,$ray,$raz) = $rotquat->rotation_axis; ok( equal_fuzz($rax,$ax) && equal_fuzz($ray,$ay) && equal_fuzz($raz,$az), "rotation_axis works"); { my $qnull = Math::Quaternion->new(1,0,0,0); my ($zx,$zy,$zz) = $qnull->rotation_axis; ok(equal_fuzz(0,$zx) && equal_fuzz(0,$zy) && equal_fuzz($zz,1), "(1,0,0,0)->rotation_axis() returns Z axis rather than crashing"); } my ($x,$y,$z) = map {rand} 1..3; my @r=$rotquat->rotate_vector($x,$y,$z); ok( 3==@r, "Math::Quaternion::rotate_vector() produces a 3-vector"); my ($xx,$yy,$zz) = @r; my $m1 = sqrt($x*$x+$y*$y+$z*$z); my $m2 = sqrt($xx*$xx + $yy*$yy + $zz*$zz); ok( equal_fuzz($m1,$m2), "Rotation preserves length"); # Let v and a be vectors. The component of v parallel to a is # |v| cos theta = (v.a)/|a|, or (v.a) ahat, in vector form. # Hence, the component of v perp to a is v - (v.a) ahat ; if # a is a unit vector, then it's just v - (v.a) a . # Let v' be v rotated by angle phi about a. Let # u' and u be the components of v' and v perpendicular to a. # Then u.u' == |u| |u'| cos phi == |u|^2 cos phi my $vdota = $x*$ax + $y*$ay + $z*$az; my ($ux,$uy,$uz) = ($x -$vdota*$ax, $y -$vdota*$ay, $z -$vdota*$az); my ($uxx,$uyy,$uzz) = ($xx-$vdota*$ax, $yy-$vdota*$ay, $zz-$vdota*$az); my $dotproduct = $ux*$uxx + $uy*$uyy + $uz*$uzz; my $modu = sqrt($ux*$ux+$uy*$uy+$uz*$uz); my $moduu = sqrt($uxx*$uxx+$uyy*$uyy+$uzz*$uzz); ok( equal_fuzz($modu,$moduu), "Rotation preserves component perpendicular to axes"); ok( equal_fuzz($dotproduct,$modu*$moduu*cos($theta)), "Rotated vector makes correct dot product with original"); my @m; ok( @m = $rotquat->matrix4x4, "matrix4x4() doesn't fail..."); ok( 16==@m, "...and produces a 4x4 matrix..."); my $mx = $m[ 0]*$x + $m[ 4]*$y + $m[ 8]*$z; my $my = $m[ 1]*$x + $m[ 5]*$y + $m[ 9]*$z; my $mz = $m[ 2]*$x + $m[ 6]*$y + $m[10]*$z; ok( equal_fuzz($mx,$xx) && equal_fuzz($my,$yy) && equal_fuzz($mz,$zz), "...which produces the same rotation as the quaternion."); my ($mr,$mir) = $rotquat->matrix4x4andinverse; my @mr = @$mr; my @mir = @$mir; $mx = $mr[ 0]*$x + $mr[ 4]*$y + $mr[ 8]*$z; $my = $mr[ 1]*$x + $mr[ 5]*$y + $mr[ 9]*$z; $mz = $mr[ 2]*$x + $mr[ 6]*$y + $mr[10]*$z; ok( equal_fuzz($mx,$xx) && equal_fuzz($my,$yy) && equal_fuzz($mz,$zz), "matrix4x4andinverse() produces the same rotation matrix..."); my $mmx = $mir[ 0]*$mx + $mir[ 4]*$my + $mir[ 8]*$mz; my $mmy = $mir[ 1]*$mx + $mir[ 5]*$my + $mir[ 9]*$mz; my $mmz = $mir[ 2]*$mx + $mir[ 6]*$my + $mir[10]*$mz; ok( equal_fuzz($mmx,$x) && equal_fuzz($mmy,$y) && equal_fuzz($mmz,$z), "...as well as its inverse."); ok( @m = $rotquat->matrix3x3, "matrix3x3() doesn't fail..."); ok( 9==@m, "...and produces a 3x3 matrix..."); $mx = $m[ 0]*$x + $m[ 3]*$y + $m[ 6]*$z; $my = $m[ 1]*$x + $m[ 4]*$y + $m[ 7]*$z; $mz = $m[ 2]*$x + $m[ 5]*$y + $m[ 8]*$z; ok( equal_fuzz($mx,$xx) && equal_fuzz($my,$yy) && equal_fuzz($mz,$zz), "...which produces the same rotation as the quaternion."); my @v1=($ax,$ay,$az); my @v2=($bx,$by,$bz); ok($rotquat = Math::Quaternion::rotation(\@v1,\@v2), "Math::Quaternion::rotation(\\\@v1,\\\@v2) does not fail"); ok($rq2 = Math::Quaternion->new({ 'v1'=>\@v1, 'v2'=>\@v2 }), "Math::Quaternion->new({v1=>..,v2=>..}) does not fail"); ok(quatequal_fuzz($rotquat,$rq2), "Math::Quaternion->new({v1=>..,v2=>..}) produces correct quaternion"); ok(!defined( eval { Math::Quaternion->new({badger=>1,wibble=>7}); 1; }), "Math::Quaternion->new(rubbish) fails"); my ($cx,$cy,$cz) = $rotquat->rotation_axis; ok( equal_fuzz(0,$ax*$cx+$ay*$cy+$az*$cz) && equal_fuzz(0,$bx*$cx+$by*$cy+$bz*$cz) , "Rotation axis perpendicular to start and end orientations"); my $dotprod = $ax*$bx+$ay*$by+$az*$bz; my $moda = sqrt($ax*$ax+$ay*$ay+$az*$az); my $modb = sqrt($bx*$bx+$by*$by+$bz*$bz); ok( equal_fuzz($dotprod,$moda*$modb*cos($rotquat->rotation_angle)), "Rotation angle is angle between start and end vectors"); my ($dx,$dy,$dz) = $rotquat->rotate_vector($ax,$ay,$az); ok( equal_fuzz($bx,$dx) && equal_fuzz($by,$dy) && equal_fuzz($bz,$dz), "Rotation maps start vector onto end vector" ); my $squat = Math::Quaternion->new(0,1,2,3); ok( Math::Quaternion::stringify($squat) eq "( 0 1 2 3 )", "Stringification works"); { my @axis = (0,0,1); my $rq1 = Math::Quaternion::rotation(pi/2,\@axis); # 90 degrees about Z my $rq2 = Math::Quaternion::rotation(pi,\@axis); # 180 degrees about Z my $interp = Math::Quaternion::slerp($rq1,$rq2,0.5); # 135 degrees about Z my ($ax,$ay,$az) = $interp->rotation_axis; ok( equal_fuzz(0,$ax) && equal_fuzz(0,$ay) && equal_fuzz(1,$az), "Math::Quaternion::slerp() produces correct rotation axis"); ok( equal_fuzz(0.75*pi,$interp->rotation_angle), "Math::Quaternion::slerp() produces correct rotation angle"); $rq2 = Math::Quaternion::rotation((pi/2)+1e-6,\@axis); $interp = Math::Quaternion::slerp($rq1,$rq2,0.75); ok( quatequal_fuzz($interp, Math::Quaternion::plus( Math::Quaternion::scale($rq1,0.25), Math::Quaternion::scale($rq2,0.75) )), "Math::Quaternion::slerp works linearly for small angles"); $rq1 = Math::Quaternion->new({ axis=>[0,0,1],angle=>0.25*pi}); $rq2 = Math::Quaternion->new({ axis=>[0,0,1],angle=>1.5*pi}); $interp = Math::Quaternion::slerp($rq1,$rq2,0.75); ($ax,$ay,$az) = $interp->rotation_axis; ok( equal_fuzz(0,$ax) && equal_fuzz(0,$ay) && equal_fuzz(-1,$az), "Math::Quaternion::slerp() gives correct axis for -ve dp"); ok( equal_fuzz(0.3125*pi,$interp->rotation_angle), "Math::Quaternion::slerp() gives correct angle for -ve dp"); } my $uq = Math::Quaternion->new({v1 => [ 1,1,1], v2 => [ 2,2,2], }); ok( checkquat($uq,1,0,0,0), "Creating Quaternion from two parallel vectors does not crash"); # quaternion from parallel but opposite vectors { my $v1 = [ 1, 0, 0 ]; my $v2 = [ -1, 0, 0 ]; my $q = Math::Quaternion->new({ v1 => $v1, v2 => $v2 }); my $v1_v2 = [ $q->rotate_vector( @$v1 ) ]; ok( check_vector( $v2, $v1_v2 ), "Rotate opposite but parallel vectors" ); } Math-Quaternion-0.07/t/002_overloading.t000644 000765 000024 00000007113 12242141716 017731 0ustar00jonstaff000000 000000 use Test::More tests => 25; use strict; use Carp; use Math::Quaternion; # Maybe I should roll these into the main module. Then again, # putting floating-point fuzz correction into '==' might not # be the Right Thing to do. my $epsilon = 1e-10; # Precision to which I can be bothered with worrying. my $pi = 3.1459265358979323846; sub equal_fuzz { croak("Wrong number of args") unless (2==@_); my ($a,$b)=@_; if (0==$a) { if (abs($b)<$epsilon) { return 1; } else { return undef; } } if (0==$b) { if (abs($a)<$epsilon) { return 1; } else { return undef; } } if (abs(($a-$b)/$a) < $epsilon) { return 1; } else { return undef; } } # Take 5 args: a quat and four numbers. Return 1 if the quat is really a quat, # and equal to the four numbers. sub checkquat { croak("Wrong number of args") unless (5==@_); my ($q,@nos) = @_; if ("Math::Quaternion" ne ref $q) { return undef; } if ( equal_fuzz ($q->[0] , $nos[0]) && equal_fuzz ($q->[1] , $nos[1]) && equal_fuzz ($q->[2] , $nos[2]) && equal_fuzz ($q->[3] , $nos[3]) ) { return 1; } else { return undef; } } sub quatequal_fuzz { my ($q1,$q2) = @_; if ( equal_fuzz ($q1->[0] , $q2->[0]) && equal_fuzz ($q1->[1] , $q2->[1]) && equal_fuzz ($q1->[2] , $q2->[2]) && equal_fuzz ($q1->[3] , $q2->[3]) ) { return 1; } else { return undef; } } my ($a,$b,$c,$d,$e,$f,$g,$h) = map { rand } 1..8; my $q1 = new Math::Quaternion($a,$b,$c,$d); my $q2 = new Math::Quaternion($e,$f,$g,$h); my $q3 = new Math::Quaternion(rand,rand,rand); ok(defined($q1) && defined($q2), "Sanity check: can make random quaternions"); ok($q1,"Quaternions evaluate to true"); ok(new Math::Quaternion(0,0,0,0),"...even the zero quaternion."); my $q1q2 = undef; my $q1c = $q1->conjugate; my $q1i = $q1->inverse; ok( $q1q2 = $q1 + $q2, "'+' is defined"); ok( quatequal_fuzz($q1+$q2,$q2+$q1), "'+' commutes"); ok( quatequal_fuzz( $q1->conjugate, ~$q1 ), "'~' conjugates"); ok( checkquat($q1+$q2,$a+$e,$b+$f,$c+$g,$d+$h),"'+' adds"); ok( $q1q2 = $q1 - $q2, "'-' is defined"); ok( checkquat($q1-$q2,$a-$e,$b-$f,$c-$g,$d-$h),"'-' subtracts"); ok( checkquat(-$q1,-$a,-$b,-$c,-$d),"Unary '-' negates"); ok( $q1q2= $q1 * $q2, "'*' is defined"); ok( checkquat($q1*$q1c,$q1->squarednorm,0,0,0), "'*'ing with a conjugate gives the squared norm"); ok( checkquat($q1*$q1i, 1,0,0,0), "'*'ing with inverse gives unit quaternion"); ok( quatequal_fuzz( $q1* ( $q2 + $q3) , ($q1*$q2) + ($q1 * $q3) ), "'*' is left-distributive"); ok( quatequal_fuzz( ($q1 + $q2) * $q3, ($q1*$q3 + $q2*$q3) ), "'*' is right-distributive"); ok( checkquat($q1*$q2, $a*$e - $b*$f - $c*$g - $d*$h, $a*$f + $e*$b + $c*$h - $d*$g, $a*$g + $e*$c + $d*$f - $b*$h, $a*$h + $e*$d + $b*$g - $c*$f ), "'*' multiplies."); my $s = rand; ok( checkquat($q1*$s, $a*$s,$b*$s,$c*$s,$d*$s), "Scalar left-multiplication works"); ok( checkquat($s*$q1, $a*$s,$b*$s,$c*$s,$d*$s), "Scalar right-multiplication works"); ok( equal_fuzz(abs($q1),sqrt($a*$a+$b*$b+$c*$c+$d*$d)), "abs() gives the norm"); my $q = new Math::Quaternion(1,2,3,4); ok( "$q" eq "( 1 2 3 4 )","Stringification works"); ok(quatequal_fuzz(Math::Quaternion::exp($q1),exp($q1)), "Exponentiation works"); ok(quatequal_fuzz(Math::Quaternion::log($q2),log($q2)), "Logarithm works"); ok(quatequal_fuzz($q1**$s,Math::Quaternion::power($q1,$s)), "a**b works for quaternion a, scalar b"); ok(quatequal_fuzz($s**$q2,Math::Quaternion::power($s,$q2)), "a**b works for scalar a, quaternion b"); ok(quatequal_fuzz($q1**$q2,Math::Quaternion::power($q1,$q2)), "a**b works for quaternion a,b"); Math-Quaternion-0.07/lib/Math/000700 000765 000024 00000000000 12242143306 016027 5ustar00jonstaff000000 000000 Math-Quaternion-0.07/lib/Math/Quaternion.pm000644 000765 000024 00000064602 12242143110 020525 0ustar00jonstaff000000 000000 package Math::Quaternion; use 5.004; use strict; use warnings; use Carp; use Math::Trig; # What?!? Where's acos()? You can't have cos and not acos! require Exporter; use overload '+' => \&plus, '-' => \&minus, 'bool' => sub { 1; }, # So we can do if ($foo=Math::Quaternion->new) { .. } '""' => \&stringify, '*' => \&multiply, '~' => \&conjugate, 'abs' => \&modulus, 'neg' => \&negate, '**' => \&power, 'exp' => \&exp, 'log' => \&log, ; our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use Math::Quaternion ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( unit conjugate inverse normalize modulus isreal multiply dot plus minus power negate squarednorm scale rotation rotation_angle rotation_axis rotate_vector matrix4x4 matrix3x3 matrix4x4andinverse stringify slerp exp log ) ], ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); our $VERSION = '0.07'; # Preloaded methods go here. # Below is stub documentation for your module. You'd better edit it! =head1 NAME Math::Quaternion - Perl class to represent quaternions =head1 SYNOPSIS use Math::Quaternion qw(slerp); my $q = Math::Quaternion->new; # Make a new unit quaternion # Make a rotation about the axis (0,1,0) my $q2 = Math::Quaternion->new({axis=>[0,1,0],angle=>0.1}); my @v = (1,2,3); # A vector. my @vrotated = $q2->rotate_vector(@v); # Rotate @v about (0,1,0). my $q3 = Math::Quaternion::rotation(0.7,2,1,4); # A different rotation. my $q4 = slerp($q2,$q3,0.5); # Interpolated rotation. my @vinterp = $q4->rotate_vector(@v); =head1 DESCRIPTION This package lets you create and manipulate quaternions. A quaternion is a mathematical object developed as a kind of generalization of complex numbers, usually represented by an array of four real numbers, and is often used to represent rotations in three-dimensional space. See, for example, L for more details on the mathematics of quaternions. Quaternions can be added, subtracted, and scaled just like complex numbers or vectors -- they can also be multiplied, but quaternion multiplication DOES NOT COMMUTE. That is to say, if you have quaternions $q1 and $q2, then in general $q1*$q2 != $q2*$q1. This is related to their use in representing rotations, which also do not commute. If you just want to represent rotations and don't care about the internal mathematical details, this should be all you need to know: All quaternions have a quantity called the "norm", similar to the length of a vector. A quaternion with norm equal to 1 is called a "unit quaternion". All quaternions which represent rotations are unit quaternions. If you call new() without any arguments, it will give you a unit quaternion which represents no rotation: $q = Math::Quaternion->new; You can make a quaternion which represents a rotation of a given angle (in radians) about a given axis: $qrot = Math::Quaternion->new({ angle => 0.1, axis => [ 2,3,4]}); Say you have two rotations, $q1 and $q2, and you want to make a quaternion representing a rotation of $q1 followed by $q2. Then, you do: $q3 = $q2 * $q1; # Rotate by $q1, followed by $q2. Remember that this is NOT the same as $q1 * $q2, which will reverse the order of the rotations. If you perform many iterated quaternion operations, the result may not quite be a unit quaternion due to numerical inaccuracies. You can make sure any quaternion has unit length, by doing: $unitquat = $anyquat->normalize; If you have a rotation quaternion, and you want to find the 3x3 matrix which represents the corresponding rotation, then: @matrix = $q->matrix3x3; Similarly, you can generate a 4x4 matrix of the sort you'd pass to OpenGL: @glmatrix = $q->matrix4x4; If you have a vector representing a direction, and you want to rotate the vector by a quaternion $q: my @vector = (0,0,1); # Vector pointing in the Z direction. my @newvec = $q->rotate_vector(@vector); # New direction. Say you're using quaternions to represent the orientation of a camera, and you have two quaternions: one to represent a starting orientation, and another to represent a finishing position. If you want to find all the quaternions representing the orientations in between, allowing your camera to move smoothly from start to finish, use the slerp() routine: use Math::Quaternion qw(slerp); my ($qstart, $qend) = ... ; # Set $tween to 9 points between start and end, exclusive. for my $t (1..9) { my $tween = slerp($qstart,$qend,0.1*$t); ... } =head1 METHODS =over 1 =item B my $q = Math::Quaternion->new; # Make a new unit quaternion. my $q2 = Math::Quaternion->new(1,2,3,4);# Make a specific quaternion. my $q3 = Math::Quaternion->new($q2); # Copy an existing quaternion. my $q4 = Math::Quaternion->new(5.6); # Make the quaternion (5.6,0,0,0) my $q5 = Math::Quaternion->new(7,8,9); # Make the quaternion (0,7,8,9) my $q6 = Math::Quaternion->new({ # Make a quaternion corresponding axis => [ 1,2,3], # to a rotation of 0.2 radians angle => 0.2, # about the vector (1,2,3). }); my $q7 = Math::Quaternion->new({ # Make a quaternion which would 'v1' => [ 0,1,2], # rotate the vector (0,1,2) onto 'v2' => [ -1,2,0], # the vector (-1,2,0). }); If no parameters are given, a unit quaternion is returned. If one non-reference parameter is given, a "scalar" quaternion is returned. If one parameter is given and it is a reference to a quaternion or an array of four numbers, the corresponding quaternion object is returned. If three parameters are given, a "vector" quaternion is returned. If four parameters are given, the corresponding quaternion is returned. Rotation quaternions may also be created by passing a hashref with the axis and angle of rotation, or by specifying two vectors specifying start and finish directions. Bear in mind that the latter method will take the shortest path between the two vectors, ignoring the "roll" angle. =cut sub new { my $class = shift; my $arr=undef; if (0==@_) { # No arguments, default to unit quaternion. $arr = [ 1,0,0,0]; } elsif (1==@_) { # One argument: if it's not a reference, construct # a "scalar quaternion" (x 0 0 0). my $arg = $_[0]; my $reftype = ref($arg); if (!$reftype) { $arr = [ $arg,0,0,0]; } else { # We've been passed a reference. If it's an array # ref, then construct a quaternion out of the # corresponding array. if ("ARRAY" eq $reftype) { return Math::Quaternion->new(@$arg); } elsif ("Math::Quaternion" eq $reftype) { # If it's a reference to another quaternion, # copy it. return Math::Quaternion->new(@$arg); } elsif ("HASH" eq $reftype) { # Hashref. my %hash = %$arg; if (defined($hash{'axis'})) { # Construct a rotation. return rotation( $hash{'angle'}, @{$hash{'axis'}} ); } elsif (defined($hash{'v2'})) { return rotation( $hash{'v1'},$hash{'v2'} ); } } croak("Don't understand arguments to new()"); } } elsif (3==@_) { # Three arguments: construct a quaternion to represent # the corresponding vector. $arr = [ 0, @_[0,1,2] ]; } elsif (4==@_) { # Four arguments: just slot the numbers right in. $arr = [ @_[0,1,2,3] ]; } else { croak("Don't understand arguments passed to new()"); } bless $arr, $class; } =item B Returns a unit quaternion. my $u = Math::Quaternion->unit; # Returns the quaternion (1,0,0,0). =cut sub unit { my $class = shift; bless [ 1,0,0,0 ], $class; } =item B Returns the conjugate of its argument. my $q = Math::Quaternion->new(1,2,3,4); my $p = $q->conjugate; # (1,-2,-3,-4) =cut sub conjugate { my $q=shift; return Math::Quaternion->new( $q->[0], - $q->[1], - $q->[2], - $q->[3], ); } =item B Returns the inverse of its argument. my $q = Math::Quaternion->new(1,2,3,4); my $qi = $q->inverse; =cut sub inverse { my $q = shift; return scale(conjugate($q),1.0/squarednorm($q)); } =item B Returns its argument, normalized to unit norm. my $q = Math::Quaternion->new(1,2,3,4); my $qn = $q->normalize; =cut sub normalize { my $q = shift; return scale($q,1.0/sqrt(squarednorm($q))); } =item B Returns the modulus of its argument, defined as the square root of the scalar obtained by multiplying the quaternion by its conjugate. my $q = Math::Quaternion->new(1,2,3,4); print $q->modulus; =cut sub modulus { my $q = shift; return sqrt(squarednorm($q)); } =item B Returns 1 if the given quaternion is real ,ie has no quaternion part, or else 0. my $q1 = Math::Quaternion->new(1,2,3,4); my $q2 = Math::Quaternion->new(5,0,0,0); print $q1->isreal; # 0; print $q2->isreal; # 1; =cut sub isreal { my $q = shift; my ($q0,$q1,$q2,$q3)=@$q; if ( (0.0==$q1) && (0.0==$q2) && (0.0==$q3) ) { return 1; } else { return 0; } } =item B Performs a quaternion multiplication of its two arguments. If one of the arguments is a scalar, then performs a scalar multiplication instead. my $q1 = Math::Quaternion->new(1,2,3,4); my $q2 = Math::Quaternion->new(5,6,7,8); my $q3 = Math::Quaternion::multiply($q1,$q2); # (-60 12 30 24) my $q4 = Math::Quaternion::multiply($q1,$q1->inverse); # (1 0 0 0) =cut sub multiply { my ($a,$b,$reversed) = @_; ($a,$b) = ($b,$a) if $reversed; if (!ref $a) { return scale($b,$a); } if (!ref $b) { return scale($a,$b); } my $q = new Math::Quaternion; $q->[0] = $a->[0] * $b->[0] - $a->[1]*$b->[1] - $a->[2]*$b->[2] - $a->[3]*$b->[3]; $q->[1] = $a->[0] * $b->[1] + $b->[0] * $a->[1] + $a->[2] * $b->[3] - $a->[3] * $b->[2]; $q->[2] = $a->[0] * $b->[2] + $b->[0] * $a->[2] + $a->[3] * $b->[1] - $a->[1] * $b->[3]; $q->[3] = $a->[0] * $b->[3] + $b->[0] * $a->[3] + $a->[1] * $b->[2] - $a->[2] * $b->[1]; return $q; } =item B Returns the dot product of two quaternions. my $q1=Math::Quaternion->new(1,2,3,4); my $q2=Math::Quaternion->new(2,4,5,6); my $q3 = Math::Quaternion::dot($q1,$q2); =cut sub dot { my ($q1,$q2) = @_; my ($a0,$a1,$a2,$a3) = @$q1; my ($b0,$b1,$b2,$b3) = @$q2; return $a0*$b0 + $a1*$b1 + $a2*$b2 + $a3*$b3 ; } =item B Performs a quaternion addition of its two arguments. my $q1 = Math::Quaternion->new(1,2,3,4); my $q2 = Math::Quaternion->new(5,6,7,8); my $q3 = Math::Quaternion::plus($q1,$q2); # (6 8 10 12) =cut sub plus { my ($a,$b,$reversed)=@_; my $q = Math::Quaternion->new( $a->[0] + $b->[0], $a->[1] + $b->[1], $a->[2] + $b->[2], $a->[3] + $b->[3], ); return $q; } =item B Performs a quaternion subtraction of its two arguments. my $q1 = Math::Quaternion->new(1,2,3,4); my $q2 = Math::Quaternion->new(5,6,7,8); my $q3 = Math::Quaternion::minus($q1,$q2); # (-4 -4 -4 -4) =cut sub minus { my ($a,$b,$reversed)=@_; ($a,$b) = ($b,$a) if $reversed; my $q = Math::Quaternion->new( $a->[0] - $b->[0], $a->[1] - $b->[1], $a->[2] - $b->[2], $a->[3] - $b->[3], ); return $q; } =item B Raise a quaternion to a scalar or quaternion power. my $q1 = Math::Quaternion->new(1,2,3,4); my $q2 = Math::Quaternion::power($q1,4); # ( 668 -224 -336 -448 ) my $q3 = $q1->power(4); # ( 668 -224 -336 -448 ) my $q4 = $q1**(-1); # Same as $q1->inverse use Math::Trig; my $q5 = exp(1)**( Math::Quaternion->new(pi,0,0) ); # approx (-1 0 0 0) =cut sub power { my ($a,$b,$reversed)=@_; ($a,$b) = ($b,$a) if $reversed; if (ref $a) { $a = Math::Quaternion->new($a); } if (ref $b) { # For quaternion^quaternion, use exp and log. return Math::Quaternion::exp(Math::Quaternion::multiply($b,Math::Quaternion::log($a))); } # For real_quaternion^real_number, use built-in power. if ($a->isreal) { return Math::Quaternion->new( $a->[0] ** $b, 0, 0, 0 ) ; } # For quat raised to a scalar power, do it manually. my ($a0,$a1,$a2,$a3) = @$a; my $s = sqrt($a->squarednorm); my $theta = Math::Trig::acos($a0/$s); my $vecmod = sqrt($a1*$a1+$a2*$a2+$a3*$a3); my $stob = ($s**$b); my $coeff = $stob/$vecmod*sin($b*$theta); my $u1 = $a1*$coeff; my $u2 = $a2*$coeff; my $u3 = $a3*$coeff; return Math::Quaternion->new( $stob * cos($b*$theta), $u1,$u2,$u3 ); } =item B Negates the given quaternion. my $q = Math::Quaternion->new(1,2,3,4); my $q1 = $q->negate; # (-1,-2,-3,-4) =cut sub negate { my $q = shift; return Math::Quaternion->new( -($q->[0]), -($q->[1]), -($q->[2]), -($q->[3]), ); } =item B Returns the squared norm of its argument. my $q1 = Math::Quaternion->new(1,2,3,4); my $sn = $q1->squarednorm; # 30 =cut sub squarednorm { my $q = shift; return $q->[0]*$q->[0] + $q->[1]*$q->[1] + $q->[2]*$q->[2] + $q->[3]*$q->[3]; } =item B Performs a scalar multiplication of its two arguments. my $q = Math::Quaternion->new(1,2,3,4); my $qq = Math::Quaternion::scale($q,2); # ( 2 4 6 8) my $qqq= $q->scale(3); # ( 3 6 9 12 ) =cut sub scale { my ($q,$s)=@_; return Math::Quaternion->new( $q->[0] * $s, $q->[1] * $s, $q->[2] * $s, $q->[3] * $s ); } =item B Generates a quaternion corresponding to a rotation. If given three arguments, interprets them as an angle and the three components of an axis vector. use Math::Trig; # Define pi. my $theta = pi/2; # Angle of rotation my $rotquat = Math::Quaternion::rotation($theta,0,0,1); # $rotquat now represents a rotation of 90 degrees about Z axis. my ($x,$y,$z) = (1,0,0); # Unit vector in the X direction. my ($xx,$yy,$zz) = $rotquat->rotate_vector($x,$y,$z); # ($xx,$yy,$zz) is now ( 0, 1, 0), to within floating-point error. rotation() can also be passed a scalar angle and a reference to a vector (in either order), and will generate the corresponding rotation quaternion. my @axis = (0,0,1); # Rotate about Z axis $theta = pi/2; $rotquat = Math::Quaternion::rotation($theta,\@axis); If the arguments to rotation() are both references, they are interpreted as two vectors, and a quaternion is returned which rotates the first vector onto the second. my @startvec = (0,1,0); # Vector pointing north my @endvec = (-1,0,0); # Vector pointing west $rotquat = Math::Quaternion::rotation(\@startvec,\@endvec); my @newvec = $rotquat->rotate_vector(@startvec); # Same as @endvec =cut sub rotation { my ($theta,$x,$y,$z); if (2==@_) { if (ref($_[0])) { if (ref($_[1])) { # Both args references to vectors my ($ax,$ay,$az)=@{$_[0]}; my ($bx,$by,$bz)=@{$_[1]}; if ( (($ax == 0) and ($ay == 0) and ($az == 0)) or (($bx == 0) and ($by == 0) and ($bz == 0)) ) { croak("Math::Quaternion::rotation() passed zero-length vector"); } # Find cross product. This is a vector perpendicular to both # argument vectors, and is therefore the axis of rotation. $x = $ay*$bz-$az*$by; $y = $az*$bx-$ax*$bz; $z = $ax*$by-$ay*$bx; # find the dot product. my $dotprod = $ax*$bx+$ay*$by+$az*$bz; my $mod1 = sqrt($ax*$ax+$ay*$ay+$az*$az); my $mod2 = sqrt($bx*$bx+$by*$by+$bz*$bz); # Find the angle of rotation. $theta=Math::Trig::acos($dotprod/($mod1*$mod2)); # Check for parallel vectors (cross product is zero) if (($x == 0) and ($y == 0) and ($z == 0)) { # Vectors a and b are parallel, such that rotation # vector is the zero-length vector (0,0,0), with # theta either 0 or pi (if vectors are opposite). # To remove round-off errors in theta, explicitly # set it. $theta = $dotprod > 0 ? 0 : pi; # Such a zero-length rotation vector is annoying (e.g. # division by 0 on normalization, and problems combining # rotations). To solve this, select a random rotation # vector that is also perpendicular to both parallel # vectors a and b. This satisfies the rotation requirement, # and helps programs relying on the logic that the rotation # vector has to be perpendicular to both vectors given # (even if there are an infinite amount of rotation vectors # that would satisfy that condition). Algorithm: Find a # random vector b at any non-zero angle to vector a. One of # the main axis will do. To reduce round-off errors, make b # as perpendicular as possible to a by selecting one of the # smallest components of vector a as the main component of # b. This also avoid accidentally selecting a vector # parallel to a if ( (abs($ax) <= abs($ay)) and (abs($ax) <= abs($az)) ) { ($bx,$by,$bz)=(1,0,0); } elsif ( (abs($ay) <= abs($ax)) and (abs($ay) <= abs($az)) ) { ($bx,$by,$bz)=(0,1,0); } else { ($bx,$by,$bz)=(0,0,1); } # Then, take the cross product between vector a and the new # vector b, to generate some vector exactly perpendicular # to vector a and hence also perpendicular to the original # vector b (i.e. @{$_[1]}) $x = $ay*$bz-$az*$by; $y = $az*$bx-$ax*$bz; $z = $ax*$by-$ay*$bx; # ($x,$y,$z) is now a random yet valid rotation vector # perpendicular to the two original vectors. } } else { # 0 is a ref, 1 is not. $theta = $_[1]; ($x,$y,$z)=@{$_[0]}; } } else { if (ref($_[1])) { # 1 is a ref, 0 is not $theta = $_[0]; ($x,$y,$z)=@{$_[1]}; } else { croak("Math::Quaternion::rotation() passed 2 nonref args"); } } } elsif (4==@_) { ($theta,$x,$y,$z) = @_; } else { croak("Math::Quaternion::rotation() passed wrong no of arguments"); } my $modulus = sqrt($x*$x+$y*$y+$z*$z); # Make it a unit vector if ($modulus == 0) { croak("Math::Quaternion::rotation() passed zero-length rotation vector"); } $x /= $modulus; $y /= $modulus; $z /= $modulus; my $st = sin(0.5 * $theta); my $ct = cos(0.5 * $theta); return Math::Quaternion->new( $ct, $x * $st, $y * $st, $z * $st ); } =item B Returns the angle of rotation represented by the quaternion argument. my $q = Math::Quaternion::rotation(0.1,2,3,4); my $theta = $q->rotation_angle; # Returns 0.1 . =cut sub rotation_angle { my $q = shift; return 2.0 * Math::Trig::acos($q->[0]); } =item B Returns the unit vector representing the axis about which rotations will be performed, for the rotation represented by the quaternion argument. my $q = Math::Quaternion::rotation(0.1,1,1,0); my @v = $q->rotation_axis; # Returns (0.5*sqrt(2),0.5*sqrt(2),0) =cut sub rotation_axis { my $q = shift; my $theta = Math::Trig::acos($q->[0]); my $st = sin($theta); if (0==$st) { return (0,0,1); } # Rotation of angle zero about Z axis my ($x,$y,$z) = @{$q}[1,2,3]; return ( $x/$st, $y/$st, $z/$st ); } =item B When called as a method on a rotation quaternion, uses this quaternion to perform the corresponding rotation on the vector argument. use Math::Trig; # Define pi. my $theta = pi/2; # Rotate 90 degrees my $rotquat = Math::Quaternion::rotation($theta,0,0,1); # about Z axis my ($x,$y,$z) = (1,0,0); # Unit vector in the X direction. my ($xx,$yy,$zz) = $rotquat->rotate_vector($x,$y,$z) # ($xx,$yy,$zz) is now ( 0, 1, 0), to within floating-point error. =cut sub rotate_vector { my ($q,$x,$y,$z) = @_; my $p = Math::Quaternion->new($x,$y,$z); my $qq = multiply($q,multiply($p,inverse($q))); return @{$qq}[1,2,3]; } =item B Takes one argument: a rotation quaternion. Returns a 16-element array, equal to the OpenGL matrix which represents the corresponding rotation. my $rotquat = Math::Quaternion::rotation($theta,@axis); # My rotation. my @m = $rotquat->matrix4x4; =cut sub matrix4x4 { my $q = shift; my ($w,$x,$y,$z) = @{$q}; return ( 1 - 2*$y*$y - 2*$z*$z, 2*$x*$y + 2*$w*$z, 2*$x*$z - 2*$w*$y, 0, 2*$x*$y - 2*$w*$z, 1 - 2*$x*$x - 2*$z*$z, 2*$y*$z + 2*$w*$x, 0, 2*$x*$z + 2*$w*$y, 2*$y*$z - 2*$w*$x, 1 - 2*$x*$x - 2*$y*$y, 0, 0, 0, 0, 1 ); } =item B Takes one argument: a rotation quaternion. Returns a 9-element array, equal to the 3x3 matrix which represents the corresponding rotation. my $rotquat = Math::Quaternion::rotation($theta,@axis); # My rotation. my @m = $rotquat->matrix3x3; =cut sub matrix3x3 { my $q = shift; my ($w,$x,$y,$z) = @{$q}; return ( 1 - 2*$y*$y - 2*$z*$z, 2*$x*$y + 2*$w*$z, 2*$x*$z - 2*$w*$y, 2*$x*$y - 2*$w*$z, 1 - 2*$x*$x - 2*$z*$z, 2*$y*$z + 2*$w*$x, 2*$x*$z + 2*$w*$y, 2*$y*$z - 2*$w*$x, 1 - 2*$x*$x - 2*$y*$y, ); } =item B Similar to matrix4x4, but returnes a list of two array references. The first is a reference to the rotation matrix; the second is a reference to its inverse. This may be useful when rendering sprites, since you can multiply by the rotation matrix for the viewer position, perform some translations, and then multiply by the inverse: any resulting rectangles drawn will always face the viewer. my $rotquat = Math::Quaternion::rotation($theta,@axis); # My rotation. my ($matref,$invref) = $rotquat->matrix4x4andinverse; =cut sub matrix4x4andinverse { my $q = shift; my ($w,$x,$y,$z) = @{$q}; my (@m,@mi); $mi[ 0] = $m[ 0] = 1 - 2*$y*$y - 2*$z*$z; $mi[ 4] = $m[ 1] = 2*$x*$y + 2*$w*$z; $mi[ 8] = $m[ 2] = 2*$x*$z - 2*$w*$y; $mi[12] = $m[ 3] = 0; $mi[ 1] = $m[ 4] = 2*$x*$y - 2*$w*$z; $mi[ 5] = $m[ 5] = 1 - 2*$x*$x - 2*$z*$z; $mi[ 9] = $m[ 6] = 2*$y*$z + 2*$w*$x; $mi[13] = $m[ 7] = 0; $mi[ 2] = $m[ 8] = 2*$x*$z + 2*$w*$y; $mi[ 6] = $m[ 9] = 2*$y*$z - 2*$w*$x; $mi[10] = $m[10] = 1 - 2*$x*$x - 2*$y*$y; $mi[14] = $m[11] = 0; $mi[ 3] = $m[12] = 0; $mi[ 7] = $m[13] = 0; $mi[11] = $m[14] = 0; $mi[15] = $m[15] = 1; return (\@m,\@mi); } =item B Returns a string representation of the quaternion. This is used to overload the '""' operator, so that quaternions may be freely interpolated in strings. my $q = Math::Quaternion->new(1,2,3,4); print $q->stringify; # "( 1 2 3 4 )" print "$q"; # "( 1 2 3 4 )" =cut sub stringify { my $self = shift; return "( ".join(" ",@$self)." )"; } =item B Takes two quaternion arguments and one scalar; performs spherical linear interpolation between the two quaternions. The quaternion arguments are assumed to be unit quaternions, and the scalar is assumed to lie between 0 and 1: a scalar argument of zero will return the first quaternion argument, and a scalar argument of one will return the second. use Math::Trig; my @axis = (0,0,1); my $rq1 = Math::Quaternion::rotation(pi/2,\@axis); # 90 degs about Z my $rq2 = Math::Quaternion::rotation(pi,\@axis); # 180 degs about Z my $interp = Math::Quaternion::slerp($rq1,$rq2,0.5); # 135 degs about Z =cut sub slerp { my ($q0,$q1,$t) = @_; my $dotprod = dot($q0,$q1); if ($dotprod<0) { # Reverse signs so we travel the short way round $dotprod = -$dotprod; $q1 = negate($q1); } my $theta = Math::Trig::acos($dotprod); if (abs($theta) < 1e-5) { # In the limit theta->0 , spherical interpolation is # approximated by linear interpolation, which also # avoids division-by-zero problems. return plus(scale($q0,(1-$t)) ,scale($q1,$t)); } my $st = sin($theta); my $ist = 1.0/$st; my $q = plus( scale($q0,($ist * sin( (1-$t)*$theta ))), scale($q1,($ist*sin($t*$theta))) ); return normalize($q); } =item B Exponential operator e^q. Any quaternion q can be written as x+uy, where x is a real number, and u is a unit pure quaternion. Then, exp(q) == exp(x) * ( cos(y) + u sin(y) ). my $q = Math::Quaternion->new(1,2,3,4); print Math::Quaternion::exp($q); =cut sub exp { my $q = shift; if (isreal($q)) { return Math::Quaternion->new(CORE::exp($q->[0]),0,0,0); } my ($q0,$q1,$q2,$q3)=@$q; my $y = sqrt($q1*$q1+$q2*$q2+$q3*$q3); # Length of pure-quat part. my ($ux,$uy,$uz) = ($q1/$y,$q2/$y,$q3/$y); # Unit vector. my $ex = CORE::exp($q0); my $exs = $ex*sin($y); return Math::Quaternion->new($ex*cos($y),$exs*$ux,$exs*$uy,$exs*$uz); } =item B Returns the logarithm of its argument. The logarithm of a negative real quaternion can take any value of them form (log(-q0),u*pi) for any unit vector u. In these cases, u is chosen to be (1,0,0). my $q = Math::Quaternion->new(1,2,3,4); print Math::Quaternion::log($q); =cut sub log { my $q = shift; if (ref $q) { if ("Math::Quaternion" ne ref $q) { $q = Math::Quaternion->new($q); } } else { $q = Math::Quaternion->new($q); } if (isreal($q)) { if ($q->[0] > 0) { return Math::Quaternion->new(CORE::log($q->[0])); } else { return Math::Quaternion->new(CORE::log(-($q->[0])),pi,0,0); } } my ($q0,$q1,$q2,$q3)=@$q; my $modq = sqrt($q0*$q0 + $q1*$q1 + $q2*$q2 + $q3*$q3); my $x = CORE::log($modq); my $qquatmod = sqrt($q1*$q1+$q2*$q2+$q3*$q3); # mod of quat part my $y = atan2($qquatmod,$q0); my $c = $y/$qquatmod; return Math::Quaternion->new($x,$c*$q1,$c*$q2,$c*$q3); } =back =head1 AUTHOR Jonathan Chin, Ejon-quaternion.pm@earth.liE =head1 ACKNOWLEDGEMENTS Thanks to Rene Uittenbogaard and Daniel Connelly for useful suggestions, and Luc Vereecken and Bruce Gray for patches. =head1 SEE ALSO =over 4 =item L =item L =item Acts 12:4 =back =head1 COPYRIGHT AND LICENSE Copyright 2003 by Jonathan Chin This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; __END__