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
|
#!/usr/bin/env perl
use strict;
use warnings;
my %rings=(red=>9,green=>5,black=>0,yellow=>7,blue=>8);
my @y= map {11- $_} @rings{qw<red green black yellow blue>};
my @m=( [1,0,0,0,0],
[1,1,0,0,0],
[0,1,1,1,0],
[0,0,0,1,1],
[0,0,0,0,1]
);
#Perform Gauss-Jordan Elimination to solve.
my $x=solve(\@m,\@y);
my @labels=qw(red/green green/black black black/yellow yellow/blue);
printf "%-15s%d\n",$labels[$_],$$x[$_] for 0..$#labels;
sub solve {
my ($c, $y)=@_;
my $j=build($c,$y);
my $s=@$c;
my $row;
for my $p (0..$s-1) {
my $v=$j->[$p][$p];
my $prow=$j->[$p];
for my $r (0..$s-1) {
$row=$j->[$r];
next if $p==$r;
my $d=$row->[$p]/$v;
for my $col (0..$s) {
$row->[$col]-=$d*$prow->[$col];
}
}
}
$row->[-1]/=$row->[-2];
$row->[-2]=1;
backsub($j);
}
sub build {
my ($c,$y)=@_;
my @j;
push @j, [@{$c->[$_]},$y->[$_]] for 0..@$c -1;
\@j;
}
sub backsub {
my ($j)=@_;
my $s=@$j;
my @x=(0) x $s;
for my $r (reverse 0..$s-1) {
my $sum=0;
my $row=$j->[$r];
$sum+=$$row[$_]*$x[$_] for (0..$s-1);
$x[$r]=$row->[$s]-$sum;
}
\@x;
}
|
