diff options
| -rw-r--r-- | challenge-043/ruben-westerberg/README | 8 | ||||
| -rwxr-xr-x | challenge-043/ruben-westerberg/raku/ch-1.p6 | 56 |
2 files changed, 61 insertions, 3 deletions
diff --git a/challenge-043/ruben-westerberg/README b/challenge-043/ruben-westerberg/README index 860958cfb7..755a56c1f6 100644 --- a/challenge-043/ruben-westerberg/README +++ b/challenge-043/ruben-westerberg/README @@ -2,12 +2,14 @@ Solution by Ruben Westerberg perl/ch-1.sh and raku/ch-1.sh =================== -Run the shell script perl one liner to display octal number from 0 to 50 +Solves the Coloured Ring problem with Gauss-Jordan Elimiation. Solves the system based on error from 11 in each ring. +Run the program to display the solution. ch-2.pl and ch-2.p6 =================== -Run the script to generate a random string of '(' and ')' and test if the resulting string has blanaced pairs. An optional argument of the max length of the string can be supplied. Otherwise a max length of 20 characters is used. - +Lists Self Describing Numbers for a given base. Pauses for 1 second when found. Diplays a list of found numbers at the end of search. + +Default base is 4. Optionally provide a single command line argument to specifiy the base to use. diff --git a/challenge-043/ruben-westerberg/raku/ch-1.p6 b/challenge-043/ruben-westerberg/raku/ch-1.p6 new file mode 100755 index 0000000000..ef3e1f0aa4 --- /dev/null +++ b/challenge-043/ruben-westerberg/raku/ch-1.p6 @@ -0,0 +1,56 @@ +#!/usr/bin/env perl6 + +my %rings=(red=>9,green=>5,black=>0,yellow=>7,blue=>8); +my @y= %rings{<red green black yellow blue>}.map(11-*); +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= <red/green green/black black black/yellow yellow/blue>; +printf "%-15s%d\n",@labels[$_],$x[$_] for 0..@labels-1; + +sub solve (@c, @y) { + my @j=build(@c,@y); + my $s=@c.elems; + my @row; + for 0..$s-1 -> $p { + my $v=@j[$p][$p]; + my $prow=@j[$p]; + for 0..$s-1 -> $r { + @row:=@j[$r]; + next if $p==$r; + my $d=@row[$p]/$v; + for 0..$s -> $col { + @row[$col]-=$d*$prow[$col]; + } + } + } + @row[*-1]/=@row[*-2]; + @row[*-2]=1; + backsub(@j); +} + +sub build (@c, @y) { + my @j; + @j.push([|@c[$_],@y[$_]]) for 0..@c-1; + @j; +} + +sub backsub (@j) { + my $s=@j; + my @x=0 xx $s; + for (0..$s-1).reverse -> $r { + my $sum=0; + my @row:=@j[$r]; + $sum+=@row[$_]*@x[$_] for (0..$s-1); + @x[$r]=@row[$s]-$sum; + } + @x; +} + |