Bad matrix inversion algorithm, or implemented incorrectly? - perl

Question

Trying to implement matrix inversion in Perl myself, I found An Efficient and Simple Algorithm for Matrix Inversion (only two pages of the article).
After my attempt to implement it in Perl, I see that it does not work.
I had spend a lot of time trying to find out what's wrong, so I concluded that
either the algorithm is not correct
I misinterpreted the algorithm
my implementation is not correct
Before presenting the code, here's a debug session with an example from Wikipedia: Inverse Matrix:
DB<229> $m=[[2,5],[1,3]]
DB<230> x invert($m)
pe[0] == 2
(pivot row 0) 2x2:
2.000 2.500
1.000 3.000
(pivot column 0) 2x2:
2.000 2.500
-0.500 3.000
(rest 0) 2x2:
2.000 2.500
-0.500 1.750
(pivot 0) 2x2:
0.500 2.500
-0.500 1.750
pe[1] == 1.75
(pivot row 1) 2x2:
0.500 2.500
-0.286 1.750
(pivot column 1) 2x2:
0.500 -1.429
-0.286 1.750
(rest 1) 2x2:
0.908 -1.429
-0.286 1.750
(pivot 1) 2x2:
0.908 -1.429
-0.286 0.571
0 1
1 3.5
DB<231>
So here's the code I wrote:
#!/usr/bin/perl -w
use 5.026;
use strict;
# invert matrix
# An Efficient and Simple Algorithm for Matrix Inversion
# Ahmad Farooq, King Khalid University, Saudi Arabia
# Khan Hamid, National University of Computer and Emerging Sciences (NUCES),
# Pakistan
sub invert($)
{
my $m = shift; # matrix is an array of rows
my ($pp, $det);
my ($rp, $pe);
my $n = scalar(#$m);
for ($pp = 0, $det = 1.0; $pp < $n; ++$pp) {
$rp = $m->[$pp]; # pivot row
$pe = $rp->[$pp]; # pivot element
print "pe[$pp] == $pe\n";
last if ($pe == 0); # Epsilon test?
$det *= $pe;
# calculate pivot row
for (my $j = 0; $j < $n; ++$j) {
next if ($j == $pp);
$rp->[$j] /= $pe;
}
pm($m, "pivot row $pp");
# calculate pivot column
for (my $i = 0; $i < $n; ++$i) {
next if ($i == $pp);
$m->[$i]->[$pp] /= -$pe;
}
pm($m, "pivot column $pp");
for (my $j = 0; $j < $n; ++$j) {
next if ($j == $pp);
for (my ($i, $rj) = (0, $m->[$j]); $i < $n; ++$i) {
next if ($i == $pp);
$rj->[$i] += $rp->[$j] * $m->[$i]->[$pp];
}
}
pm($m, "rest $pp");
$rp->[$pp] = 1.0 / $pe;
pm($m, "pivot $pp");
}
return ($pe != 0.0, $det);
}
The pm() function is just a "print matrix" for debugging purposes:
# print matrix
sub pm($;$)
{
my ($m, $label) = #_;
my $n = scalar(#$m);
print "($label) " if ($label);
print "${n}x${n}:\n";
for (my $i = 0; $i < $n; ++$i) {
for (my $j = 0; $j < $n; ++$j) {
if (defined(my $v = $m->[$i]->[$j])) {
printf('%8.3f', $v);
} else {
print ' ???????';
}
}
print "\n";
}
}
Any insights?
Hint for Reproduction (added 2019-08-28)
I had thought it was obvious, but just in case:
If you want to reproduce the output shown in the debug session, maybe just add these two lines at the end of the code:
my $m=[[2,5],[1,3]]; # matrix to invert
print join(', ', invert($m)), "\n"; # invert $m, printing result
Note (added 2019-09-02):
The algorithm fails for the 3x3 matrix given in the Wikipedia article ($m = [[1, 2, 0], [2, 4, 1], [2, 1, 0]]), so real implementations should head towards the improved algorithm (that can select pivot elements outside the diagonal).

Answer 1

When in doubt, write tests.
First, put your code into a module (lib/My/Matrix.pm or whatever you want to call it):
package My::Matrix; # this must match the file name
use strict;
use warnings;
use Exporter qw(import);
our #EXPORT_OK = qw( invert pm );
# your code here ...
1; # at end of module
There is a lot of documentation regarding writing modules, not sure if perldoc perlmod is a good starting point.
Now write a test - documentation is here (t/001-invert.t):
#!perl
use strict;
use warnings;
use Test::More;
use Matrix qw(invert);
ok_invert( [[1,0], [0,1]], [[1,0], [0,1]], "unit matrix" );
# insert more matrices here
done_testing;
sub ok_invert {
my ($input, $output, $msg) = #_;
invert( $output );
is_deeply $input, $output, $msg
or diag "got: ", explain $input, "expected: ", explain $output;
};
Run the test as perl -Ilib t/001-invert.t or prove -Ilib t if you want to run multiple tests.
You can now add simple corner cases to the test until the problem is isolated.
Of course, finding the correct inverse matrix by hand is tedious, so you may want to use multiplication instead. So the next steps to improve your code would be:
make sure invert does not modify its input and returns the inverted matrix instead;
Sidenote. It's generally a good idea to make sure a function returns the desired value and does not modify its arguments. It's not always possible but when it is, it saves a ton of debugging time.
implement multiplication;
implement is_unit_matrix check;
rewrite the test function as follows (the next snippet was not tested):
sub ok_invert {
my ($input, $msg) = #_;
my ($invert, $det) = invert( $input );
ok is_unit_matrix( multiply( $invert, $input ) ), $msg
or diag explain $invert, " is not the inverse of ", explain $input;
}
Hope this helps.

Answer 2

The pseudocode in the original paper is not correct.
Steps I have done so far:
inserted the pseudocode into the Perl source
used the naming of the pseudocode
test cases
tested the test cases
tested with Math::Matrix as a reference
reviewed (many times)
At least I read the note in paper:
Note that in step 7 of the following algorithm a'[i, p]
on the LHS means that the latest value of the pivot row
is to be used in the calculations.
This note is not really precise. After additional attempts I gave up, wanted to post my findings here, and read the answer of Håkon Hægland. Yes, his solution works and he earns the honor.
If the steps in the pseudocode are reordered it passes my 3 tests:
Step 1
Step 2
Step 3
Step 4
Step 6
Step 7
Step 5
Step 8
Step 9
Step 10
Here is the version with pseudocode included and using the original naming:
sub invert_corr($) {
my $A = shift; # matrix is an array of rows
my $n = scalar(#$A);
# Step 1: Let p = 0, d = 1;
my $p = 0;
my $det;
# Step 2: p <= p +1
for (my $pi = 0,$det = 1.0; $pi < $n; ++$pi) {
$p = $pi;
# Step 3: If a[p,p] == 0 then cannot calculate inverse, go to step 10.
if ($A->[$p]->[$p] == 0) { last; }
# Step 4: d <= d x a[p, p]
$det = $det * $A->[$p]->[$p];
# Step 6: Calculate the new elements of the pivot column by:
# a_new[i,p] <= -(a[i,p] / a[p,p]) where i = 1 .. n, i != p
STEP6: for (my $i = 0; $i < $n; ++$i) {
if ($i == $p) { next STEP6; }
$A->[$i]->[$p] = -($A->[$i]->[$p] / $A->[$p]->[$p]);
}
# Step 7: Calculate the rest of the new elements by:
# a_new[i,j] <= a[i,j] + a[p,j] x a_new[i,p]
# where i = 1 .. n, j = 1 .. n, & i,j != p
OUTER7: for (my $i = 0; $i < $n; ++$i) {
if ($i == $p) { next OUTER7; }
INNER7: for (my $j = 0; $j < $n; ++$j) {
if ($j == $p) { next INNER7; }
# Note that in step 7 of the following algorithm a'[i, p]
# on the LHS means that the latest value of the pivot row
# is to be used in the calculations.
$A->[$i]->[$j] = $A->[$i]->[$j] + $A->[$p]->[$j] * $A->[$i]->[$p];
}
}
# Step 5: Calculate the new elements of the pivot row by:
# a_new[p,j] <= a[p,j] / a[p,p] where j = 1 .. n, j != p
STEP5: for (my $j = 0; $j < $n; ++$j) {
# next if ($j == $p);
if ($j == $p) { next STEP5; }
$A->[$p]->[$j] = $A->[$p]->[$j] / $A->[$p]->[$p];
}
# Step 8: Calculate the new value of the current pivot location:
# a_new[p,p] <= 1 / a_new[p,p]
$A->[$p]->[$p] = 1.0 / $A->[$p]->[$p];
# Step 9: If p < n go to step 2 (n the dimension of the matrix A).
}
# Step 10: Stop. If inverse exists, A contains the inverse and d is the determinant.
if ($A->[$p]->[$p] != 0.0) {
return ($A->[$p]->[$p] != 0.0, $det, $A);
}
return ($A->[$p]->[$p] != 0.0);
}
The complete code including tests is available on github, maybe useful for debugging.

Answer 3

According to the referred to paper, step #7 should be computed with the old pivot row values, so the following seems to work for me:
sub invert($)
{
my $m = shift; # matrix is an array of rows
my ($pp, $det);
my ($rp, $pe);
my $n = scalar(#$m);
for ($pp = 0, $det = 1.0; $pp < $n; ++$pp) {
$rp = $m->[$pp]; # pivot row
$pe = $rp->[$pp]; # pivot element
last if ($pe == 0); # Epsilon test?
$det *= $pe;
# calculate pivot column
for (my $i = 0; $i < $n; ++$i) {
next if ($i == $pp);
$m->[$i][$pp] /= -$pe;
}
for (my $j = 0; $j < $n; ++$j) { # row index
next if ($j == $pp);
for (my ($i, $rj) = (0, $m->[$j]); $i < $n; ++$i) {
next if ($i == $pp);
$rj->[$i] += $rp->[$i] * $m->[$j]->[$pp];
}
}
# calculate pivot row
for (my $j = 0; $j < $n; ++$j) {
next if ($j == $pp);
$rp->[$j] /= $pe;
}
$rp->[$pp] = 1.0 / $pe;
}
return ($pe != 0.0, $det);
}
Fix required to match result in Wikipedia:
--- newinvert.pl~ 2019-08-29 21:22:16.135160055 +0200
+++ newinvert.pl 2019-08-29 21:32:10.995144732 +0200
## -20,7 +20,7 ##
next if ($j == $pp);
for (my ($i, $rj) = (0, $m->[$j]); $i < $n; ++$i) {
next if ($i == $pp);
- $rj->[$i] += $rp->[$i] * $m->[$j]->[$pp];
+ $rj->[$i] += $rp->[$j] * $m->[$i]->[$pp];
}
}
# calculate pivot row
Sample session (inluding my pm()):
> perl -d printmatrix.pl
Loading DB routines from perl5db.pl version 1.51
Editor support available.
Enter h or 'h h' for help, or 'man perldebug' for more help.
main::(printmatrix.pl:20): 1;
DB<1> require "./newinvert.pl" # this is ungly, forgive!
./newinvert.pl did not return a true value at (eval 6)[/usr/lib/perl5/5.26.1/perl5db.pl:738] line 2.
DB<2> $m=[[2,5],[1,3]]
DB<4> pm($m)
2x2:
2.000 5.000
1.000 3.000
DB<5> x invert($m)
0 1
1 1
DB<6> pm($m)
2x2:
3.000 -5.000
-1.000 2.000
Result of regression tests:
# https://github.com/wollmers/matrix-inverse-Farooq/blob/master/matrix_inversion_new.pl
$ perl matrix_inversion_new.pl
[...]
(invert_hakon 01_wiki input $A) 2x2:
2.000 5.000
1.000 3.000
(invert_hakon 01_wiki result $C) 2x2:
3.000 -5.000
-1.000 2.000
ok 10 - 01_wiki invert_hakon Ainv
ok 11 - 01_wiki invert_hakon det: 1
(invert_hakon 02_wiki input $A) 2x2:
2.000 3.000
1.000 2.000
(invert_hakon 02_wiki result $C) 2x2:
2.000 -3.000
-1.000 2.000
ok 12 - 02_wiki invert_hakon Ainv
ok 13 - 02_wiki invert_hakon det: 1
(invert_hakon 03_author_1 input $A) 3x3:
1.000 1.000 3.000
1.000 3.000 -3.000
-2.000 -4.000 -4.000
(invert_hakon 03_author_1 result $C) 3x3:
3.000 1.000 1.500
-1.250 -0.250 -0.750
-0.250 -0.250 -0.250
ok 14 - 03_author_1 invert_hakon Ainv
ok 15 - 03_author_1 invert_hakon det: -8
[...]

Answer 4

One of the problems when implementing a mathematical formula like (actually from Step 5)
in a loop is: When will the "new" a' become the "old" a?
Before the next step, before the next assignment, or before the next loop iteration?
In a mathematical sense a' and a are different variables all the time, but in procedural programming languages the memory address for a is reused at some time.
So the assignments from Step 5 need to be delayed after Step 7 (), it seems.
As a computer scientist I had always felt that mathematical algorithms are described in a somewhat imprecise way. Maybe that's exactly the reason why programming languages were invented ;-)