Arne Sommer

8 files changed, 371 insertions, 0 deletions

diff --git a/challenge-162/arne-sommer/blog.txt b/challenge-162/arne-sommer/blog.txt
new file mode 100644
index 0000000000..c8de0a6f47
--- /dev/null
+++ b/challenge-162/arne-sommer/blog.txt
@@ -0,0 +1 @@
+https://raku-musings.com/thirteen-wheatstones.html
diff --git a/challenge-162/arne-sommer/raku/ch-1.raku b/challenge-162/arne-sommer/raku/ch-1.raku
new file mode 100755
index 0000000000..4e32ac9203
--- /dev/null
+++ b/challenge-162/arne-sommer/raku/ch-1.raku
@@ -0,0 +1,16 @@
+#! /usr/bin/env raku
+
+subset ISBN where /^ <[0..9]>**3 "-" <[0..9]> "-" <[0..9]>**3 "-" <[0..9]>**5 "-" <[0..9]> $ /;
+
+unit sub MAIN (ISBN $isbn13, :v(:$verbose));
+
+my $digits = S:g/\-// given $isbn13;
+my @digits = $digits.comb;
+my $check  = @digits.pop;
+my $r      = (10 - ( @digits[0, 2 ... *].sum * 2 + @digits.sum)) % 10;
+
+say ": Source: $isbn13\n: Digits: $digits\n: Base:   { @digits.join }" if $verbose;
+
+say ($r == $check)
+  ?? "The Check Digit is correct"
+  !! "The Check Digit is wrong (should have been $r)";
diff --git a/challenge-162/arne-sommer/raku/ch-2.raku b/challenge-162/arne-sommer/raku/ch-2.raku
new file mode 100755
index 0000000000..321a492d79
--- /dev/null
+++ b/challenge-162/arne-sommer/raku/ch-2.raku
@@ -0,0 +1,95 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (Str :k(:$key), Str :s(:$string), :d(:$decode), :v(:$verbose));
+
+my %todo    = ('A' .. 'I', 'K' .. 'Z').Set;
+my @key;
+my $padding = 'X';
+my $one     = $decode ?? -1 !! 1;
+
+for $key.uc.comb -> $char
+{
+  next if $char eq " ";
+  next unless %todo{$char};
+  %todo{$char} :delete;
+  @key.push: $char;
+}
+
+for sort keys %todo -> $todo
+{
+  @key.push: $todo;
+}
+
+if $verbose
+{
+  say ": Key: @key[ $_ * 5 ..  $_ * 5 + 4]" for ^5;
+}
+
+my %rev; for ^@key.elems -> $index { %rev{@key[$index]} = $index }
+
+my @x = $string.uc.words>>.comb.flat.map: { $_ eq "J" ?? "I" !! $_ };
+
+say ": String: { @x.join }" if $verbose;
+
+my @pairs;
+
+my $first = @x.shift;
+
+while (@x)
+{
+  if @x[0] eq $first
+  {
+    @pairs.push: $first ~ $padding;
+  }
+  else
+  {
+    @pairs.push: $first ~ @x.shift;
+  }
+  $first = @x.elems ?? @x.shift !! Any;
+}
+
+@pairs.push: $first ~ $padding if $first;
+
+say ": Pairs: { @pairs.join(" ") }" if $verbose;
+
+my @result;
+
+for @pairs -> $pair
+{
+  @result.push: wheatstone-playfair($pair);
+}
+
+say @result>>.lc.join;
+
+sub wheatstone-playfair ($pair)
+{
+  my ($a, $b)         = $pair.comb;
+  my ($a-row, $a-col) = (%rev{$a} div 5, %rev{$a} % 5);
+  my ($b-row, $b-col) = (%rev{$b} div 5, %rev{$b} % 5);
+
+  my $trans = "";
+  my $rule  = "";
+
+  if $a-row == $b-row
+  {
+    $trans = @key[$a-row * 5 + ( ($a-col + $one) % 5 ) ] ~
+             @key[$b-row * 5 + ( ($b-col + $one) % 5 ) ];
+    $rule = 'row';	     
+  }
+  elsif $a-col == $b-col
+  {
+    $trans = @key[( ($a-row + $one) % 5) * 5 + $a-col ] ~
+             @key[( ($b-row + $one) % 5) * 5 + $b-col ];
+    $rule = 'col';
+  }
+  else # $a-row != $b-row && $a-col != $b-col
+  {
+    $trans = @key[$a-row * 5 + $b-col] ~
+             @key[$b-row * 5 + $a-col];
+    $rule = 'rect';	     
+  }
+
+  say ": $pair -> $a-row $a-col + $b-row $b-col -> $trans [$rule]" if $verbose;
+  
+  return $trans;
+}
diff --git a/challenge-162/arne-sommer/raku/isbn13 b/challenge-162/arne-sommer/raku/isbn13
new file mode 100755
index 0000000000..47c53d968a
--- /dev/null
+++ b/challenge-162/arne-sommer/raku/isbn13
@@ -0,0 +1,19 @@
+#! /usr/bin/env raku
+
+subset ISBN where /^ <[0..9]>**3 "-" <[0..9]> "-" <[0..9]>**3 "-" <[0..9]>**5 "-" <[0..9]> $ /;
+
+unit sub MAIN (ISBN $isbn13, :v(:$verbose));
+
+my $digits = S:g/\-// given $isbn13;
+my @digits = $digits.comb;
+my $check  = @digits.pop;
+my @odd    = @digits[0, 2 ... *];
+my @even   = @digits[1, 3 ... *];
+my $sum    = @odd.sum * 3 + @even.sum;
+my $r      = (10 - $sum) % 10;
+
+say ": Source: $isbn13\n: Digits: $digits\n: Base:   { @digits.join }" if $verbose;
+
+say ($r == $check)
+  ?? "The Check Digit is correct"
+  !! "The Check Digit is wrong (should have been $r)";
diff --git a/challenge-162/arne-sommer/raku/isbn13-shorter b/challenge-162/arne-sommer/raku/isbn13-shorter
new file mode 100755
index 0000000000..4e32ac9203
--- /dev/null
+++ b/challenge-162/arne-sommer/raku/isbn13-shorter
@@ -0,0 +1,16 @@
+#! /usr/bin/env raku
+
+subset ISBN where /^ <[0..9]>**3 "-" <[0..9]> "-" <[0..9]>**3 "-" <[0..9]>**5 "-" <[0..9]> $ /;
+
+unit sub MAIN (ISBN $isbn13, :v(:$verbose));
+
+my $digits = S:g/\-// given $isbn13;
+my @digits = $digits.comb;
+my $check  = @digits.pop;
+my $r      = (10 - ( @digits[0, 2 ... *].sum * 2 + @digits.sum)) % 10;
+
+say ": Source: $isbn13\n: Digits: $digits\n: Base:   { @digits.join }" if $verbose;
+
+say ($r == $check)
+  ?? "The Check Digit is correct"
+  !! "The Check Digit is wrong (should have been $r)";
diff --git a/challenge-162/arne-sommer/raku/isbn13-stupid b/challenge-162/arne-sommer/raku/isbn13-stupid
new file mode 100755
index 0000000000..38106c9041
--- /dev/null
+++ b/challenge-162/arne-sommer/raku/isbn13-stupid
@@ -0,0 +1,7 @@
+#! /usr/bin/env raku
+
+subset ISBN where /^ <[0..9]>**3 "-" <[0..9]> "-" <[0..9]>**3 "-" <[0..9]>**5 "-" <[0..9]> $ /;
+
+unit sub MAIN (ISBN $isbn13);
+
+say $isbn13.substr(16);
diff --git a/challenge-162/arne-sommer/raku/wheatstone-playfair b/challenge-162/arne-sommer/raku/wheatstone-playfair
new file mode 100755
index 0000000000..45d1685b0c
--- /dev/null
+++ b/challenge-162/arne-sommer/raku/wheatstone-playfair
@@ -0,0 +1,122 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (Str :k(:$key), Str :s(:$string), :d(:$decode), :v(:$verbose));
+
+my %todo    = ('A' .. 'I', 'K' .. 'Z').Set;
+my @key;
+my $padding = 'X';
+my $one     = $decode ?? -1 !! 1;
+
+for $key.uc.comb -> $char
+{
+  next if $char eq " ";
+  next unless %todo{$char};
+  %todo{$char} :delete;
+  @key.push: $char;
+}
+
+for sort keys %todo -> $todo
+{
+  @key.push: $todo;
+}
+
+if $verbose
+{
+  say ": Key: @key[ 0 ..  4]";
+  say ": Key: @key[ 5 ..  9]";
+  say ": Key: @key[10 .. 14]";
+  say ": Key: @key[15 .. 19]";
+  say ": Key: @key[20 .. 24]";
+}
+
+my %index-trans =
+(
+   0 => "0.0",  1 => "0.1",  2 => "0.2",  3 => "0.3",  4 => "0.4",
+   5 => "1.0",  6 => "1.1",  7 => "1.2",  8 => "1.3",  9 => "1.4",
+  10 => "2.0", 11 => "2.1", 12 => "2.2", 13 => "2.3", 14 => "2.4",
+  15 => "3.0", 16 => "3.1", 17 => "3.2", 18 => "3.3", 19 => "3.4",
+  20 => "4.0", 21 => "4.1", 22 => "4.2", 23 => "4.3", 24 => "4.4",
+);
+
+my %rev;
+
+for sort keys %index-trans -> $key
+{
+  %rev{%index-trans{$key}} = $key;
+}
+
+my @x = $string.uc.words>>.comb.flat.map: { $_ eq "J" ?? "I" !! $_ };
+
+say ": String: { @x.join }" if $verbose;
+
+my @pairs;
+
+my $first = @x.shift;
+
+while (@x)
+{
+  if @x[0] eq $first
+  {
+    @pairs.push: $first ~ $padding;
+  }
+  else
+  {
+    @pairs.push: $first ~ @x.shift;
+  }
+  $first = @x.elems ?? @x.shift !! Any;
+}
+
+@pairs.push: $first ~ $padding if $first;
+
+say ": Pairs: { @pairs.join(" ") }" if $verbose;
+
+my @result;
+
+for @pairs -> $pair
+{
+  @result.push: wheatstone-playfair($pair);
+}
+
+say @result>>.lc.join;
+
+sub get-index ($letter)
+{
+  for ^@key.chars -> $index
+  {
+    return %index-trans{$index} if @key[$index] eq $letter;
+  }
+  die "Not found";
+}
+
+sub wheatstone-playfair ($pair)
+{
+  my ($a, $b)         = $pair.comb;
+  my ($a-row, $a-col) = get-index($a).split(".");
+  my ($b-row, $b-col) = get-index($b).split(".");
+
+  my $trans = "";
+  my $rule  = "";
+  
+  if $a-row != $b-row && $a-col != $b-col
+  {
+    $trans = @key[%rev{$a-row ~ "." ~ $b-col}] ~
+             @key[%rev{$b-row ~ "." ~ $a-col}];
+    $rule = 'rect';	     
+  }
+  elsif $a-row == $b-row
+  {
+    $trans = @key[%rev{$a-row ~ "." ~ ( ($a-col + $one) % 5 ) }] ~
+             @key[%rev{$b-row ~ "." ~ ( ($b-col + $one) % 5 ) }];
+    $rule = 'row';	     
+  }
+  elsif $a-col == $b-col
+  {
+    $trans = @key[%rev{ ( ($a-row + $one) % 5) ~ "." ~ $a-col }] ~
+             @key[%rev{ ( ($b-row + $one) % 5) ~ "." ~ $b-col }];
+    $rule = 'col';
+  }
+
+  say ": $pair -> $a-row $a-col + $b-row $b-col -> $trans [$rule]" if $verbose;
+
+  return $trans;
+}
diff --git a/challenge-162/arne-sommer/raku/wheatstone-playfair2 b/challenge-162/arne-sommer/raku/wheatstone-playfair2
new file mode 100755
index 0000000000..321a492d79
--- /dev/null
+++ b/challenge-162/arne-sommer/raku/wheatstone-playfair2
@@ -0,0 +1,95 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (Str :k(:$key), Str :s(:$string), :d(:$decode), :v(:$verbose));
+
+my %todo    = ('A' .. 'I', 'K' .. 'Z').Set;
+my @key;
+my $padding = 'X';
+my $one     = $decode ?? -1 !! 1;
+
+for $key.uc.comb -> $char
+{
+  next if $char eq " ";
+  next unless %todo{$char};
+  %todo{$char} :delete;
+  @key.push: $char;
+}
+
+for sort keys %todo -> $todo
+{
+  @key.push: $todo;
+}
+
+if $verbose
+{
+  say ": Key: @key[ $_ * 5 ..  $_ * 5 + 4]" for ^5;
+}
+
+my %rev; for ^@key.elems -> $index { %rev{@key[$index]} = $index }
+
+my @x = $string.uc.words>>.comb.flat.map: { $_ eq "J" ?? "I" !! $_ };
+
+say ": String: { @x.join }" if $verbose;
+
+my @pairs;
+
+my $first = @x.shift;
+
+while (@x)
+{
+  if @x[0] eq $first
+  {
+    @pairs.push: $first ~ $padding;
+  }
+  else
+  {
+    @pairs.push: $first ~ @x.shift;
+  }
+  $first = @x.elems ?? @x.shift !! Any;
+}
+
+@pairs.push: $first ~ $padding if $first;
+
+say ": Pairs: { @pairs.join(" ") }" if $verbose;
+
+my @result;
+
+for @pairs -> $pair
+{
+  @result.push: wheatstone-playfair($pair);
+}
+
+say @result>>.lc.join;
+
+sub wheatstone-playfair ($pair)
+{
+  my ($a, $b)         = $pair.comb;
+  my ($a-row, $a-col) = (%rev{$a} div 5, %rev{$a} % 5);
+  my ($b-row, $b-col) = (%rev{$b} div 5, %rev{$b} % 5);
+
+  my $trans = "";
+  my $rule  = "";
+
+  if $a-row == $b-row
+  {
+    $trans = @key[$a-row * 5 + ( ($a-col + $one) % 5 ) ] ~
+             @key[$b-row * 5 + ( ($b-col + $one) % 5 ) ];
+    $rule = 'row';	     
+  }
+  elsif $a-col == $b-col
+  {
+    $trans = @key[( ($a-row + $one) % 5) * 5 + $a-col ] ~
+             @key[( ($b-row + $one) % 5) * 5 + $b-col ];
+    $rule = 'col';
+  }
+  else # $a-row != $b-row && $a-col != $b-col
+  {
+    $trans = @key[$a-row * 5 + $b-col] ~
+             @key[$b-row * 5 + $a-col];
+    $rule = 'rect';	     
+  }
+
+  say ": $pair -> $a-row $a-col + $b-row $b-col -> $trans [$rule]" if $verbose;
+  
+  return $trans;
+}