- Added solutions by Flavio Poletti.

6 files changed, 126 insertions, 0 deletions

diff --git a/challenge-162/polettix/blog.txt b/challenge-162/polettix/blog.txt
new file mode 100644
index 0000000000..386fd7d5b9
--- /dev/null
+++ b/challenge-162/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2022/04/26/pwc162-isbn-13/
diff --git a/challenge-162/polettix/blog1.txt b/challenge-162/polettix/blog1.txt
new file mode 100644
index 0000000000..8c6476eb94
--- /dev/null
+++ b/challenge-162/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2022/04/27/pwc162-wheatstone-playfair/
diff --git a/challenge-162/polettix/perl/ch-1.pl b/challenge-162/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..edd3efb32a
--- /dev/null
+++ b/challenge-162/polettix/perl/ch-1.pl
@@ -0,0 +1,16 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+use List::Util qw< pairmap sum >;
+
+my $input = shift // '978-0-306-40615-7';
+say "ISBN-13 check digit for '$input' is @{[isbn_13($input)]}.";
+
+sub isbn_13 ($input) {
+   sum(
+      pairmap { -$a - 3* $b }
+      ($input =~ m{(\d)}gmxs)[0 .. 11]
+   ) % 10;
+}
diff --git a/challenge-162/polettix/perl/ch-2.pl b/challenge-162/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..0313de531a
--- /dev/null
+++ b/challenge-162/polettix/perl/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+say encrypt('playfair example', 'hide the gold in the tree stump');
+say decrypt('perl and raku', 'siderwrdulfipaarkcrw');
+
+sub encrypt ($key, $message) { wheatstone_playfair($key, $message, 1) }
+sub decrypt ($key, $message) { wheatstone_playfair($key, $message, 5 - 1) }
+The main workhorse is then the following function, I hope the comments are sufficient!
+
+sub wheatstone_playfair ($key, $message, $off) {
+
+   # pre-massage the input, go uppercase and remove all j:s
+   $_ = lc($_) =~ s{j}{i}rgmxs for $key, $message;
+
+   # we don't need no stinkin' matrix, a bijection in two arrays is OK
+   my %flag;
+   my @letter_at = grep { $flag{$_}++ == 0 }
+     split(m{[^a-z]?}imxs, $key), 'a' .. 'i', 'k' .. 'z', 'j';
+
+   # the "go back" might be a hash but we are C nostalgic
+   my $oA = ord('a');          # used to turn lc letters into array indexes
+   my @pos_of = map { $_->[0] }   # get indexes
+     sort { $a->[1] cmp $b->[1] } # sorted by letter position
+     map { [$_, $letter_at[$_]] } 0 .. $#letter_at;
+
+   # take only letters into consideration, split on everything else
+   my @message = split m{[^a-z]?}imxs, $message;
+   my @output;
+   while (@message) {
+
+      # first letter is whatever, second letter might be an X
+      my $A = shift @message;
+      my $B = @message && $message[0] ne $A ? shift @message : 'x';
+
+      # get positions, $A and $B are spoiled on the way but it's OK
+      my ($Ax, $Ay, $Bx, $By) = map {
+         my $v = $pos_of[ord($_) - $oA];
+         ($v % 5, int($v / 5))
+      } ($A, $B);
+
+      # apply Wheatstone-Playfair mapping
+      ($Ax, $Ay, $Bx, $By) =
+          $Ax == $Bx ? ($Ax, ($Ay + $off) % 5, $Bx, ($By + $off) % 5)
+        : $Ay == $By ? (($Ax + $off) % 5, $Ay, ($Bx + $off) % 5, $By)
+        :              ($Bx, $Ay, $Ax, $By);
+
+      push @output, @letter_at[$Ax + 5 * $Ay, $Bx + 5 * $By];
+   } ## end while (@message)
+   return join '', @output;
+} ## end sub wheatstone_playfair
diff --git a/challenge-162/polettix/raku/ch-1.raku b/challenge-162/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..3da9a8f806
--- /dev/null
+++ b/challenge-162/polettix/raku/ch-1.raku
@@ -0,0 +1,11 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN (Str:D $input = '978-0-306-40615-7') {
+   put "ISBN-13 check digit for '$input' is {isbn_13($input)}.";
+}
+
+sub isbn_13 ($input) {
+   $input.comb(/\d/)[0..11]    # focus on first 12 digits
+      .map({-$^a - 3 * $^b})   # apply equivalent weights
+      .sum % 10;               # sum and take remainder
+}
diff --git a/challenge-162/polettix/raku/ch-2.raku b/challenge-162/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..eff3949277
--- /dev/null
+++ b/challenge-162/polettix/raku/ch-2.raku
@@ -0,0 +1,43 @@
+#!/usr/bin/env raku
+use v6;
+
+put encrypt('playfair example', 'hide the gold in the tree stump');
+put decrypt('perl and raku', 'siderwrdulfipaarkcrw');
+
+sub encrypt ($key, $message) { wheatstone-playfair($key, $message, 1) }
+sub decrypt ($key, $message) { wheatstone-playfair($key, $message, 5 - 1) }
+
+sub wheatstone-playfair ($key is copy, $message is copy, $off) {
+   for $key, $message { $_ = $_.lc; s:g/j/i/ }
+
+   # we don't need no stinkin' matrix, a bijection in two arrays is OK
+   my %flag;
+   my @letter-at = ($key.comb(/<[a .. z]>/), 'a' .. 'i', 'k' .. 'z', 'j')
+      .flat.grep({ %flag{$_}++ == 0 });
+
+   # in Raku we're not C nostalgic any more
+   my %pos-of = (0..25).map({ @letter-at[$_] => $_ });
+
+   # take only letters into consideration, split on everything else
+   my @message = $message.comb(/<[ a ..z ]>/);
+   my @output;
+   while @message {
+
+      # first letter is whatever, second letter might be an X
+      my $A = shift @message;
+      my $B = @message && @message[0] ne $A ?? @message.shift !! 'x';
+
+      # get positions, $A and $B are spoiled on the way but it's OK
+      my ($Ax, $Ay, $Bx, $By) =
+         ($A, $B).map({ my $v = %pos-of{$_}; ($v % 5, ($v / 5).Int) }).flat;
+
+      # apply Wheatstone-Playfair mapping
+      ($Ax, $Ay, $Bx, $By) =
+           $Ax == $Bx ?? ($Ax, ($Ay + $off) % 5, $Bx, ($By + $off) % 5)
+        !! $Ay == $By ?? (($Ax + $off) % 5, $Ay, ($Bx + $off) % 5, $By)
+        !!               ($Bx, $Ay, $Ax, $By);
+
+      @output.push: @letter-at[$Ax + 5 * $Ay, $Bx + 5 * $By].Slip;
+   } ## end while (@message)
+   return join '', @output;
+}