1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
|
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");
|