2*2 matrix manipulation
PhilipRBrenan@yahoo.com, 2004, Perl License
Example t/matrix2.t
#_ Matrix _____________________________________________________________ # Test 2*2 matrices # philiprbrenan@yahoo.com, 2004, Perl License #______________________________________________________________________ use Math::Zap::Matrix2 identity=>i; use Math::Zap::Vector2; use Test::Simple tests=>8; my ($a, $b, $c, $v); $a = matrix2 (8, 0, 0, 8, ); $b = matrix2 (4, 2, 2, 4, ); $c = matrix2 (2, 2, 1, 2, ); $v = vector2(1,2); ok($a/$a == i()); ok($b/$b == i()); ok($c/$c == i()); ok(2/$a*$a/2 == i()); ok(($a+$b)/($a+$b) == i()); ok(($a-$c)/($a-$c) == i()); ok(-$a/-$a == i()); ok(1/$a*($a*$v) == $v);
2*2 matrix manipulation
package Math::Zap::Matrix2; $VERSION=1.03; use Math::Zap::Vector2 check=>'vector2Check', is=>'vector2Is'; use Carp; use constant debug => 0; # Debugging level
Create a matrix
sub new($$$$)
{my
($a11, $a12,
$a21, $a22,
) = @_;
my $m = round(bless(
{11=>$a11, 12=>$a12,
21=>$a21, 22=>$a22,
}));
singular($m, 1);
$m;
}
Create a matrix. Synonym for new.
sub matrix2($$$$)
{new($_[0],$_[1],$_[2],$_[3]);
}
Identity matrix
sub identity()
{bless
{11=>1, 21=>0,
12=>0, 22=>1,
};
}
Create a matrix from two vectors
sub new2v($$)
{vector2Check(@_) if debug;
my ($a, $b, $c) = @_;
my $m = round(bless(
{11=>$a->{x}, 12=>$b->{x},
21=>$a->{y}, 22=>$b->{y},
}));
singular($m, 1);
$m;
}
Check its a matrix
sub check(@)
{if (debug)
{for my $m(@_)
{confess "$m is not a matrix2" unless ref($m) eq __PACKAGE__;
}
}
return (@_)
}
Test its a matrix
sub is(@)
{for my $m(@_)
{return 0 unless ref($m) eq __PACKAGE__;
}
'matrix2';
}
Get/Set accuracy
my $accuracy = 1e-10;
sub accuracy
{return $accuracy unless scalar(@_);
$accuracy = shift();
}
Round: round to nearest integer if within accuracy of that integer
sub round($)
{unless (debug)
{return $_[0];
}
else
{my ($a) = @_;
for my $k(keys(%$a))
{my $n = $a->{$k};
my $N = int($n);
$a->{$k} = $N if abs($n-$N) < $accuracy;
}
return $a;
}
}
Singular matrix?
sub singular($$)
{my $m = shift; # Matrix
my $a = 1e-2; # Accuracy
my $A = shift; # Action 0: return indicator, 1: confess
my $n = abs
($m->{11} * $m->{22} -
$m->{12} * $m->{21})
< $a;
confess "Singular matrix2" if $n and $A;
$n;
}
Create a matrix from another matrix
sub clone($)
{my ($m) = check(@_); # Matrix
round bless
{11=>$m->{11}, 12=>$m->{12},
21=>$m->{21}, 22=>$m->{22},
};
}
Print matrix
sub print($)
{my ($m) = check(@_); # Matrix
'matrix2('.$m->{11}.', '.$m->{12}.
', '.$m->{21}.', '.$m->{22}.
')';
}
Add matrices
sub add($$)
{my ($a, $b) = check(@_); # Matrices
my $m = round bless
{11=>$a->{11}+$b->{11}, 12=>$a->{12}+$b->{12},
21=>$a->{21}+$b->{21}, 22=>$a->{22}+$b->{22},
};
singular($m, 1);
$m;
}
Negate matrix
sub negate($)
{my ($a) = check(@_); # Matrices
my $m = round bless
{11=>-$a->{11}, 12=>-$a->{12},
21=>-$a->{21}, 22=>-$a->{22},
};
singular($m, 1);
$m;
}
Subtract matrices
sub subtract($$)
{my ($a, $b) = check(@_); # Matrices
my $m = round bless
{11=>$a->{11}-$b->{11}, 12=>$a->{12}-$b->{12},
21=>$a->{21}-$b->{21}, 22=>$a->{22}-$b->{22},
};
singular($m, 1);
$m;
}
Vector = Matrix * Vector
sub matrixVectorMultiply($$)
{ check(@_[0..0]) if debug; # Matrix
vector2Check(@_[1..1]) if debug; # Vector
my ($a, $b) = @_;
vector2
($a->{11}*$b->{x}+$a->{12}*$b->{y},
$a->{21}*$b->{x}+$a->{22}*$b->{y},
);
}
Matrix = Matrix * scalar
sub matrixScalarMultiply($$)
{my ($a) = check(@_[0..0]); # Matrix
my ($b) = @_[1..1]; # Scalar
confess "$b is not a scalar" if ref($b);
round bless
{11=>$a->{11}*$b, 12=>$a->{12}*$b,
21=>$a->{21}*$b, 22=>$a->{22}*$b,
};
}
Matrix = Matrix * Matrix
sub matrixMatrixMultiply($$)
{my ($a, $b) = check(@_); # Matrices
round bless
{11=>$a->{11}*$b->{11}+$a->{12}*$b->{21}, 12=>$a->{11}*$b->{12}+$a->{12}*$b->{22},
21=>$a->{21}*$b->{11}+$a->{22}*$b->{21}, 22=>$a->{21}*$b->{12}+$a->{22}*$b->{22},
};
}
Matrix=Matrix / non zero scalar
sub matrixScalarDivide($$)
{my ($a) = check(@_[0..0]); # Matrices
my ($b) = @_[1..1]; # Scalar
confess "$b is not a scalar" if ref($b);
confess "$b is zero" if $b == 0;
round bless
{11=>$a->{11}/$b, 12=>$a->{12}/$b,
21=>$a->{21}/$b, 22=>$a->{22}/$b,
};
}
Determinant of matrix.
sub det($)
{my ($a) = check(@_); # Matrices
+$a->{11}*$a->{22}
-$a->{12}*$a->{21}
}
Inverse of matrix
sub inverse($)
{my ($a) = check(@_); # Matrices
my $d = det($a);
return undef if $d == 0;
round bless
{11=> $a->{22}/$d, 21=>-$a->{21}/$d,
12=>-$a->{12}/$d, 22=> $a->{11}/$d,
};
}
Rotation matrix: rotate anti-clockwise by t radians
sub rotate($)
{my ($a) = @_;
bless
{11=>cos($t), 21=>-sin($t),
12=>sin($t), 22=> cos($t),
};
}
Equals to within accuracy
sub equals($$)
{my ($a, $b) = check(@_); # Matrices
abs($a->{11}-$b->{11}) < $accuracy and
abs($a->{12}-$b->{12}) < $accuracy and
abs($a->{21}-$b->{21}) < $accuracy and
abs($a->{22}-$b->{22}) < $accuracy;
}
Operator overloads
use overload '+' => \&add3, # Add two vectors '-' => \&subtract3, # Subtract one vector from another '*' => \&multiply3, # Times by a scalar, or vector dot product '/' => \÷3, # Divide by a scalar '!' => \&det3, # Determinant '==' => \&equals3, # Equals (to accuracy) '""' => \&print3, # Print 'fallback' => FALSE;
Add operator.
sub add3
{my ($a, $b) = @_;
$a->add($b);
}
Subtract operator.
sub subtract3
{my ($a, $b, $c) = @_;
return $a->subtract($b) if $b;
negate($a);
}
Multiply operator.
sub multiply3
{my ($a, $b) = @_;
return $a->matrixScalarMultiply($b) unless ref($b);
return $a->matrixVectorMultiply($b) if vector2Is($b);
return $a->matrixMatrixMultiply($b) if is($b);
confess "Cannot multiply $a by $b\n";
}
Divide operator.
sub divide3
{my ($a, $b, $c) = @_;
if (!ref($b))
{return $a->matrixScalarDivide($b) unless $c;
return $a->inverse->matrixScalarMultiply($b) if $c;
}
else
{return $a->inverse->matrixVectorMultiply($b) if vector2Is($b);
return $a->matrixMatrixMultiply($b->inverse) if is($b);
confess "Cannot multiply $a by $b\n";
}
}
Equals operator.
sub equals3
{my ($a, $b, $c) = @_;
return $a->equals($b);
}
Determinant of a matrix
sub det3
{my ($a, $b, $c) = @_;
$a->det;
}
Print a vector.
sub print3
{my ($a) = @_;
return $a->print;
}
use Math::Zap::Exports qw( matrix2 ($$$$) new2v ($$) identity () ); #_ Matrix2 ____________________________________________________________ # Package loaded successfully #______________________________________________________________________ 1;
Perl License.