Done and Blogged

3 files changed, 164 insertions, 0 deletions

diff --git a/challenge-162/dave-jacoby/blog.txt b/challenge-162/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..6d9cddbe8c
--- /dev/null
+++ b/challenge-162/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2022/04/26/play-fair-and-by-the-book-weekly-challenge-162.html
diff --git a/challenge-162/dave-jacoby/perl/ch-1.pl b/challenge-162/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..3c1b975c5b
--- /dev/null
+++ b/challenge-162/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use List::Util qw{ sum0 };
+
+my @samples;
+push @samples, '978-0-306-40615-7';    # error-correction coding
+                                       # for digital communication
+push @samples, '978-0596001735';       # perl best practices
+push @samples, '978-0596003135';       # perl cookbook
+push @samples, '978-0596004927';       # programming perl
+push @samples, '978-1492094951';       # learning perl
+push @samples, '978-1680500882';       # modern perl
+
+for my $sample (@samples) {
+    my $check = find_check_digit($sample);
+    say <<"END";
+    ISBN-13: $sample
+    Check:   $check
+END
+}
+
+sub find_check_digit( $isbn13) {
+    my @digits = $isbn13 =~ /(\d)/gmix;
+    pop @digits;
+    push @digits, 0;
+    my @x = map { $_ % 2 == 1 ? 3 * $digits[$_] : $digits[$_] } 0 .. 12;
+    return 10 - ( ( sum0 @x ) % 10 );
+}
diff --git a/challenge-162/dave-jacoby/perl/ch-2.pl b/challenge-162/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..f229c6b940
--- /dev/null
+++ b/challenge-162/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,131 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use JSON;
+my $json = JSON->new->canonical;
+
+my @tests;
+push @tests,
+    [
+    'playfair example',
+    'hide the gold in the tree stump',
+    'bmodzbxdnabekudmuixmmouvif'
+    ];
+push @tests,
+    [ 'perl and raku', 'the weekly challenge', 'siderwrdulfipaarkcrw' ];
+
+for my $test (@tests) {
+    my ( $key, $plain, $cypher ) = $test->@*;
+    my @square = make_playfair_square($key);
+    my $c1     = encrypt( $key, $plain );
+    my $p1     = decrypt( $key, $cypher );
+    say join "\n\t", $key, $plain, $c1, $cypher, $p1,
+        $cypher eq $c1 ? 'true' : 'false';
+    say '';
+}
+exit;
+
+sub encrypt ( $key, $plaintext ) {
+    my @square = make_playfair_square($key);
+    my @input  = make_digrams($plaintext);
+    my @output;
+    for my $digram (@input) {
+        my ( $m,  $n )  = split //, $digram;
+        my ( $mx, $my ) = find_position( $m, @square );
+        my ( $nx, $ny ) = find_position( $n, @square );
+        if    (0) { 'NO-OP' }
+        elsif ( $mx == $nx ) {
+            my $mm = $square[$mx][ ( $my + 1 ) % 5 ];
+            my $nn = $square[$nx][ ( $ny + 1 ) % 5 ];
+            push @output, $mm . $nn;
+        }
+        elsif ( $my == $ny ) {
+            my $mm = $square[ ( $mx + 1 ) % 5 ][$my];
+            my $nn = $square[ ( $nx + 1 ) % 5 ][$ny];
+            push @output, $mm . $nn;
+        }
+        else {
+            my $mm = $square[$mx][$ny];
+            my $nn = $square[$nx][$my];
+            push @output, $mm . $nn;
+        }
+    }
+    my $zed = '';
+    return lc join '', @output;
+}
+
+sub decrypt ( $key, $cyphertext ) {
+    my @square = make_playfair_square($key);
+    my @input  = make_digrams($cyphertext);
+    my @output;
+    for my $digram (@input) {
+        my ( $m,  $n )  = split //, $digram;
+        my ( $mx, $my ) = find_position( $m, @square );
+        my ( $nx, $ny ) = find_position( $n, @square );
+        if    (0) { 'NO-OP' }
+        elsif ( $mx == $nx ) {
+            my $mm = $square[$mx][ ( $my + 4 ) % 5 ];
+            my $nn = $square[$nx][ ( $ny + 4 ) % 5 ];
+            push @output, $mm . $nn;
+        }
+        elsif ( $my == $ny ) {
+            my $mm = $square[ ( $mx + 4 ) % 5 ][$my];
+            my $nn = $square[ ( $nx + 4 ) % 5 ][$ny];
+            push @output, $mm . $nn;
+        }
+        else {
+            my $mm = $square[$mx][$ny];
+            my $nn = $square[$nx][$my];
+            push @output, $mm . $nn;
+        }
+    }
+    my $zed = '';
+    return lc join '', @output;
+}
+
+sub make_playfair_square( $key ) {
+    my %h;
+    my @array = grep { !$h{$_}++ } grep { /\w/ } ( split //, lc $key ),
+        'a' .. 'i', 'k' .. 'z';
+    @array = @array[ 0 .. 24 ];
+    my @square;
+    for my $i ( 0 .. 24 ) {
+        my $x = $i % 5;
+        my $y = int $i / 5;
+        $square[$y][$x] = uc $array[$i];
+    }
+    return @square;
+}
+
+sub make_digrams ( $text ) {
+    my @digrams;
+    my $pt = $text;
+    $pt =~ s/[jJ]/i/gmix;
+    $pt =~ s/[^A-Za-z]+//gmix;
+    while ($pt) {
+        my $digram = substr( $pt, 0, 2 );
+        if ( substr( $digram, 0, 1 ) eq substr( $digram, 1, 1, ) ) {
+            $digram = substr( $pt, 0, 1 ) . 'X';
+            substr( $pt, 0, 1 ) = '';
+        }
+        else { substr( $pt, 0, 2 ) = ''; }
+        $digram .= 'X' unless length $digram == 2;
+        push @digrams, uc $digram;
+    }
+    return @digrams;
+}
+
+sub find_position ( $letter, @square ) {
+    exit unless $letter =~ /[A-Z]/mix;
+    $letter = uc $letter;
+    for my $x ( 0 .. 4 ) {
+        for my $y ( 0 .. 4 ) {
+            my $s = $square[$x][$y] || '-';
+            return ( $x, $y ) if $letter eq $s;
+        }
+    }
+    return ( -1, -1 );
+}