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");