Merge pull request #6033 from PerlMonk-Athanasius/branch-for-challenge-162

Perl & Raku solutions to Tasks 1 & 2 of the Weekly Challenge 162

4 files changed, 915 insertions, 0 deletions

diff --git a/challenge-162/athanasius/perl/ch-1.pl b/challenge-162/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..639648fb4d
--- /dev/null
+++ b/challenge-162/athanasius/perl/ch-1.pl
@@ -0,0 +1,139 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 162
+=========================
+
+TASK #1
+-------
+*ISBN-13*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate the check digit of given ISBN-13 code. Please refer
+[ https://en.wikipedia.org/wiki/International_Standard_Book_Number#ISBN-13_
+check_digit_calculation |wikipedia] for more information.
+
+Example
+
+  ISBN-13 check digit for '978-0-306-40615-7' is 7.
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Note
+----
+The following are accepted as input:
+
+ - A 13-digit ISBN code
+ - A 12-digit ISBN code, optionally followed by a question mark to indicate the
+   unknown check digit
+ - A 10-digit ISBN code, which will be converted to its 13-digit equivalent.
+   This must include a check digit, but it will not be checked for correctness.
+
+All forms may contain separators (spaces or hyphens). No checks are made for
+the correctness of separator placement.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Devel::Assert qw( on );
+
+const my $USAGE =>
+"Usage:
+  perl $0 <code>
+
+    <code>    10-, 12-, or 13-digit ISBN code (may contain separators)\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 162, Task #1: ISBN-13 (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $code = validate_code();
+
+    printf "Input:  %s\n", $ARGV[ 0 ];
+
+    my @digits = split '', $code =~ s/ [^\d] //rgx;
+
+    assert scalar @digits == 12;
+
+    for (my $i = 1; $i < scalar @digits; $i += 2)
+    {
+        $digits[ $i ] *= 3;
+    }
+
+    my $sum   =  0;
+       $sum  +=  $_ for @digits;
+    my $r     =  10 - ($sum % 10);
+    my $check =  $r < 10 ? $r : 0;
+       $code  =~ s/ \? $ //x;                             # Remove trailing '?'
+       $code .=  '-' unless $code =~ / \- $ /x;           # Add trailing hyphen
+
+    printf "Output: ISBN-13 check digit for '%s' is %d\n",
+            $code . $check, $check;
+}
+
+#------------------------------------------------------------------------------
+sub validate_code
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+       $args == 1
+            or  error( "Expected 1 command line argument, found $args" );
+
+    my $code =  $ARGV[ 0 ];
+       $code =~ s/ [ -] //gx;                  # Remove separators     (if any)
+       $code =~ s/ \? $ //x;                   # Remove a trailing '?' (if any)
+       $code =~ / ([^0-9]) /x                  # Look for illegal characters
+            and error( qq(Invalid input character "$1") );
+
+    my $len  =  length $code;
+       $code =  $ARGV[ 0 ];                    # Restore original separators
+
+    if    ($len == 10)
+    {
+        $code = '978-' . $code;
+        chop $code;                            # Remove trailing check digit
+    }
+    elsif ($len == 13)
+    {
+        chop $code;                            # Remove trailing check digit
+    }
+    elsif ($len != 12)                         # Missing check digit is allowed
+    {                                          # for ISBN-13 (not for ISBN-10)
+        error( 'Invalid length' );
+    }
+
+    return $code;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-162/athanasius/perl/ch-2.pl b/challenge-162/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..656bffccc3
--- /dev/null
+++ b/challenge-162/athanasius/perl/ch-2.pl
@@ -0,0 +1,320 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 162
+=========================
+
+TASK #2
+-------
+*Wheatstone-Playfair*
+
+Submitted by: Roger Bell_West
+
+Implement encryption and decryption using the [ https://en.wikipedia.org/wiki/
+Playfair_cipher |Wheatstone-Playfair cipher].
+
+Examples:
+
+  (These combine I and J, and use X as padding.)
+
+  encrypt("playfair example", "hide the gold in the tree stump") =
+  "bmodzbxdnabekudmuixmmouvif"
+
+  decrypt("perl and raku", "siderwrdulfipaarkcrw") = "thewexeklychallengex"
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Notes
+-----
+1. The algorithm presented in the Wikipedia article does not cover the case in
+   which the letter 'X' occurs twice in succession in the given plaintext. To
+   prevent an infinite regress in this situation, I have provided a second
+   padding character, 'Q'.
+
+2. Set $SPACING to 0 to get encrypted output without spaces, as in the example.
+   I have set it to 5 as per the Wikepedia article.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+
+const my $PADDING_1 => 'x';
+const my $PADDING_2 => 'q';
+const my $SPACING   =>  5;
+const my $USAGE     =>
+"Usage:
+  perl $0 [--key=<Str>] [--text=<Str>] [--decrypt]
+
+    --key=<Str>     Cipher key
+    --text=<Str>    Plaintext or ciphertext
+    --decrypt       Decrypt instead of encrypt? [default: False]\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 162, Task #2: Wheatstone-Playfair (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($key, $text, $decrypt) = parse_command_line();
+
+    if ($decrypt)
+    {
+        print "Input\n-----\n  Key:        '$key'\n"  .
+                            "  Ciphertext: '$text'\n" .
+                            "  Mode:        Decrypt\n\n";
+
+        my $plain  = decode( $key, $text );
+
+        print "Output\n------\n  Plaintext:  '$plain'\n";
+    }
+    else    # Encrypt
+    {
+        print "Input\n-----\n  Key:        '$key'\n"  .
+                            "  Plaintext:  '$text'\n" .
+                            "  Mode:        Encrypt\n\n";
+
+        my $cipher = encode( $key, $text );
+
+        print "Output\n------\n  Ciphertext: '$cipher'\n";
+    }
+}
+
+#------------------------------------------------------------------------------
+sub encode
+#------------------------------------------------------------------------------
+{
+    my ($key,   $text) = @_;
+    my ($table, $l2rc) = make_table( $key );
+
+    $text =  lc $text;
+    $text =~ s/ [^a-z] //gx;                 # Remove spaces, punctuation, etc.
+
+    my $cipher = '';
+
+    for my $digram (get_digrams( $text ))
+    {
+        $cipher .= encode_digram( $digram, $table, $l2rc );
+    }
+
+    $cipher =~ s/ (.{$SPACING}) /$1 /gx if $SPACING > 0;
+
+    return $cipher;
+}
+
+#------------------------------------------------------------------------------
+sub decode
+#------------------------------------------------------------------------------
+{
+    my ($key, $text) = @_;
+    my ($table, $l2rc) = make_table( $key );
+
+    $text =  lc $text;                       # Just in case
+    $text =~ s/ [^a-z] //gx;                 # Remove spaces, etc.
+
+    my $plain = '';
+
+    for my $digram (get_digrams( $text ))
+    {
+        $plain .= decode_digram( $digram, $table, $l2rc );
+    }
+
+    return $plain;
+}
+
+#------------------------------------------------------------------------------
+sub encode_digram
+#------------------------------------------------------------------------------
+{
+    my ($digram, $table, $l2rc)   = @_;
+    my  $code                     = '';
+    my ($first_row,  $first_col)  = @{ $l2rc->{ $digram->[ 0 ] } };
+    my ($second_row, $second_col) = @{ $l2rc->{ $digram->[ 1 ] } };
+
+    if    ($first_row == $second_row)
+    {
+        my $i = $first_col  + 1;
+           $i = 0 if $i > 4;
+
+        my $j = $second_col + 1;
+           $j = 0 if $j > 4;
+
+        $code = $table->[ $first_row  ][ $i ] .
+                $table->[ $second_row ][ $j ];
+    }
+    elsif ($first_col == $second_col)
+    {
+        my $i = $first_row  + 1;
+           $i = 0 if $i > 4;
+
+        my $j = $second_row + 1;
+           $j = 0 if $j > 4;
+
+        $code = $table->[ $i ][ $first_col  ] .
+                $table->[ $j ][ $second_col ];
+    }
+    else
+    {
+        $code = $table->[ $first_row  ][ $second_col ] .
+                $table->[ $second_row ][ $first_col  ];
+    }
+
+    return $code;
+}
+
+#------------------------------------------------------------------------------
+sub decode_digram
+#------------------------------------------------------------------------------
+{
+    my ($digram, $table, $l2rc)   = @_;
+    my  $text                     = '';
+    my ($first_row,  $first_col)  = @{ $l2rc->{ $digram->[ 0 ] } };
+    my ($second_row, $second_col) = @{ $l2rc->{ $digram->[ 1 ] } };
+
+    if    ($first_row == $second_row)
+    {
+        my $i = $first_col  - 1;
+           $i = 4 if $i < 0;
+
+        my $j = $second_col - 1;
+           $j = 4 if $j < 0;
+
+        $text = $table->[ $first_row  ][ $i ] .
+                $table->[ $second_row ][ $j ];
+    }
+    elsif ($first_col == $second_col)
+    {
+        my $i = $first_row  - 1;
+           $i = 4 if $i < 0;
+
+        my $j = $second_row - 1;
+           $j = 4 if $j < 0;
+
+        $text = $table->[ $i ][ $first_col  ] .
+                $table->[ $j ][ $second_col ];
+    }
+    else
+    {
+        $text = $table->[ $first_row  ][ $second_col ] .
+                $table->[ $second_row ][ $first_col  ];
+    }
+
+    return $text;
+}
+
+#------------------------------------------------------------------------------
+sub make_table
+#------------------------------------------------------------------------------
+{
+    my  ($key)  = @_;
+    my   @table;
+    push @table, [ (undef) x 5 ] for 0 .. 4;
+
+    $key  =  lc $key;
+    $key  =~ s/[^a-z]//g;
+    $key .=  $_ for 'a' .. 'z';
+    $key  =~ tr/j/i/;
+
+    my  %l2rc;
+    my  %alphabet   =  map { $_ => 0 } 'a' .. 'z';
+    my ($row, $col) = (0, 0);
+
+    for my $letter (split '', $key)
+    {
+        unless ($alphabet{ $letter }++)
+        {
+            $table[$row][$col] = $letter;
+            $l2rc{ $letter }   = [ $row, $col ];
+
+            if (++$col > 4)
+            {
+                $col = 0;
+                last if ++$row > 4;
+            }
+        }
+    }
+
+    $l2rc{ j } = [ @{ $l2rc{ i } } ];
+
+    return (\@table, \%l2rc);
+}
+
+#------------------------------------------------------------------------------
+sub get_digrams
+#------------------------------------------------------------------------------
+{
+    my ($text) = @_;
+    my  @digrams;
+    my  @letters = split '', $text;
+
+    while (scalar @letters)
+    {
+        my $first = shift @letters;
+        my $second;
+
+        if    (scalar @letters == 0 || $letters[ 0 ] eq $first)
+        {
+            $second = ($first eq $PADDING_1) ? $PADDING_2 : $PADDING_1;
+        }
+        else
+        {
+            $second = shift @letters;
+        }
+
+        push @digrams, [ $first, $second ];
+    }
+
+    return @digrams;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $key     = '';
+    my $text    = '';
+    my $decrypt =  0;
+
+    GetOptions(
+                  'key=s'   => \$key,
+                  'text=s'  => \$text,
+                  'decrypt' => \$decrypt,
+
+              )       or error( 'Invalid command line argument(s)' );
+
+    length $key  >  0 or error( 'Missing key' );
+    length $text >  0 or error( 'Missing text' );
+    scalar @ARGV == 0 or error( 'Found unexpected command line argument(s)' );
+
+    return ($key, $text, $decrypt);
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-162/athanasius/raku/ch-1.raku b/challenge-162/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..10342aa4a0
--- /dev/null
+++ b/challenge-162/athanasius/raku/ch-1.raku
@@ -0,0 +1,149 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 162
+=========================
+
+TASK #1
+-------
+*ISBN-13*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate the check digit of given ISBN-13 code. Please refer
+[ https://en.wikipedia.org/wiki/International_Standard_Book_Number#ISBN-13_
+check_digit_calculation |wikipedia] for more information.
+
+Example
+
+  ISBN-13 check digit for '978-0-306-40615-7' is 7.
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Note
+----
+The following are accepted as input:
+
+ - A 13-digit ISBN code
+ - A 12-digit ISBN code, optionally followed by a question mark to indicate the
+   unknown check digit
+ - A 10-digit ISBN code, which will be converted to its 13-digit equivalent.
+   This must include a check digit, but it will not be checked for correctness.
+
+All forms may contain separators (spaces or hyphens). No checks are made for
+the correctness of separator placement.
+
+=end comment
+#==============================================================================
+
+subset ISBN-char of Str where * ~~ / ^ <[ - \h 0 .. 9 ]> ** 10..17 $ /;
+
+my Bool constant $VERBOSE = False;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 162, Task #1: ISBN-13 (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    #| 10-, 12-, or 13-digit ISBN code (may contain separators)
+
+    Str:D $code where { $code ~~ / ^ <[- \h 0 .. 9 ]>+ $ / &&
+                        10 <= $code.chars <= 17 }
+)
+#==============================================================================
+{
+    my Str $code-val = validate-code( $code );
+
+    "Input:  $code".put;
+
+    my Str  $digits = S:g/ <-[\d]> // given $code-val;
+    my UInt @digits = $digits.split( '', :skip-empty ).map: { .Int };
+
+    +@digits == 12 or die "ERROR: @digits contains { +@digits } characters";
+
+    loop (my UInt $i = 1; $i < +@digits; $i += 2)
+    {
+        @digits[ $i ] *= 3;
+    }
+
+    my UInt $sum   = [+] @digits;
+    my UInt $r     = 10 - ($sum % 10);
+    my UInt $check = $r < 10 ?? $r !! 0;
+
+    $code-val ~~ s/ \? $ //;                              # Remove trailing '?'
+    $code-val ~= '-' unless $code ~~ / \- $ /;            # Add trailing hyphen
+
+    "Output: ISBN-13 check digit for '%s' is %d\n".printf:
+        $code ~ $check, $check;
+}
+
+#------------------------------------------------------------------------------
+sub validate-code( Str:D $orig-code --> Str:D )
+#------------------------------------------------------------------------------
+{
+    my Str $code = $orig-code;
+
+    $code ~~ s:g/ <[- \h ]> //;                # Remove separators     (if any)
+    $code ~~ s/ \? $ //;                       # Remove a trailing '?' (if any)
+    $code ~~ / (<-[ 0 .. 9 ]>) /               # Look for illegal characters
+            and error( qq[Invalid input character "$1"] );
+
+    my UInt $len = $code.chars;
+
+    $code = $orig-code;                        # Restore original separators
+
+    if    $len == 10
+    {
+        $code = '978-' ~ $code;
+        $code.= chop: 1;                       # Remove trailing check digit
+    }
+    elsif $len == 13
+    {
+        $code.= chop: 1;                       # Remove trailing check digit
+    }
+    elsif $len != 12                           # Missing check digit is allowed
+    {                                          # for ISBN-13 (not for ISBN-10)
+        error( 'Invalid length' );
+    }
+
+    return $code;
+}
+
+#------------------------------------------------------------------------------
+sub error( Str:D $message )
+#------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-162/athanasius/raku/ch-2.raku b/challenge-162/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..c09dbc1b5d
--- /dev/null
+++ b/challenge-162/athanasius/raku/ch-2.raku
@@ -0,0 +1,307 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 162
+=========================
+
+TASK #2
+-------
+*Wheatstone-Playfair*
+
+Submitted by: Roger Bell_West
+
+Implement encryption and decryption using the [ https://en.wikipedia.org/wiki/
+Playfair_cipher |Wheatstone-Playfair cipher].
+
+Examples:
+
+  (These combine I and J, and use X as padding.)
+
+  encrypt("playfair example", "hide the gold in the tree stump") =
+  "bmodzbxdnabekudmuixmmouvif"
+
+  decrypt("perl and raku", "siderwrdulfipaarkcrw") = "thewexeklychallengex"
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Notes
+-----
+1. The algorithm presented in the Wikipedia article does not cover the case in
+   which the letter 'X' occurs twice in succession in the given plaintext. To
+   prevent an infinite regress in this situation, I have provided a second
+   padding character, 'Q'.
+
+2. Set $SPACING to 0 to get encrypted output without spaces, as in the example.
+   I have set it to 5 as per the Wikepedia article.
+
+=end comment
+#==============================================================================
+
+my Str  constant $PADDING_1 = 'x';
+my Str  constant $PADDING_2 = 'q';
+my UInt constant $SPACING   =  5;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 162, Task #2: Wheatstone-Playfair (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Str:D  :$key,                     #= Cipher key
+    Str:D  :$text,                    #= Plaintext or ciphertext
+    Bool:D :$decrypt = False          #= Decrypt instead of encrypt?
+)
+#==============================================================================
+{
+    if $decrypt
+    {
+        ("Input\n-----\n  Key:        '$key'\n"  ~
+                       "  Ciphertext: '$text'\n" ~
+                       "  Mode:        Decrypt\n").put;
+
+        my Str $plain  = decode( $key, $text );
+
+        "Output\n------\n  Plaintext:  '$plain'".put;
+    }
+    else    # Encrypt
+    {
+        ("Input\n-----\n  Key:        '$key'\n"  ~
+                       "  Plaintext:  '$text'\n" ~
+                       "  Mode:        Encrypt\n").put;
+
+        my Str $cipher = encode( $key, $text );
+
+        "Output\n------\n  Ciphertext: '$cipher'".put;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub encode( Str:D $key, Str:D $text-orig --> Str:D )
+#------------------------------------------------------------------------------
+{
+    my Array[Array[Str]] $table;
+    my Array[UInt]       %l2rc;
+
+    ($table, %l2rc) = make-table( $key );
+
+    my Str $text = $text-orig.lc;
+           $text ~~ s:g/ <-[a .. z]> //;     # Remove spaces, punctuation, etc.
+
+    my Str $cipher = '';
+
+    for get-digrams( $text ) -> Str @digram
+    {
+        $cipher ~= encode-digram( @digram, $table, %l2rc );
+    }
+
+    $cipher ~~ s:g/ (. ** {$SPACING}) /$0 / if $SPACING > 0;
+
+    return $cipher;
+}
+
+#------------------------------------------------------------------------------
+sub decode( Str:D $key, Str:D $text-orig --> Str:D )
+#------------------------------------------------------------------------------
+{
+    my Array[Array[Str]] $table;
+    my Array[UInt]       %l2rc;
+
+    ($table, %l2rc) = make-table( $key );
+
+    my Str $text = $text-orig.lc;            # Just in case
+           $text ~~ s:g/ <-[a .. z]> //;     # Remove spaces, etc.
+
+    my Str $plain = '';
+
+    for get-digrams( $text ) -> Str @digram
+    {
+        $plain ~= decode-digram( @digram, $table, %l2rc );
+    }
+
+    return $plain;
+}
+
+#------------------------------------------------------------------------------
+sub encode-digram
+(
+    Array:D[Str:D]          $digram,
+    Array:D[Array:D[Str:D]] $table,
+    Hash:D[Array:D[UInt:D]] $l2rc
+--> Str:D
+)
+#------------------------------------------------------------------------------
+{
+    my Str   $code                     = '';
+    my UInt ($first-row,  $first-col)  = $l2rc{ $digram[ 0 ] };
+    my UInt ($second-row, $second-col) = $l2rc{ $digram[ 1 ] };
+
+    if    $first-row == $second-row
+    {
+        my UInt $i = $first-col  + 1;
+                $i = 0 if $i > 4;
+
+        my UInt $j = $second-col + 1;
+                $j = 0 if $j > 4;
+
+        $code = $table[ $first-row;  $i ] ~
+                $table[ $second-row; $j ];
+    }
+    elsif $first-col == $second-col
+    {
+        my UInt $i = $first-row  + 1;
+                $i = 0 if $i > 4;
+
+        my UInt $j = $second-row + 1;
+                $j = 0 if $j > 4;
+
+        $code = $table[ $i; $first-col  ] ~
+                $table[ $j; $second-col ];
+    }
+    else
+    {
+        $code = $table[ $first-row;  $second-col ] ~
+                $table[ $second-row; $first-col  ];
+    }
+
+    return $code;
+}
+
+#------------------------------------------------------------------------------
+sub decode-digram
+(
+    Array:D[Str:D]          $digram,
+    Array:D[Array:D[Str:D]] $table,
+    Hash:D[Array:D[UInt:D]] $l2rc
+--> Str:D
+)
+#------------------------------------------------------------------------------
+{
+    my Str   $text                     = '';
+    my UInt ($first-row,  $first-col)  = $l2rc{ $digram[ 0 ] };
+    my UInt ($second-row, $second-col) = $l2rc{ $digram[ 1 ] };
+
+    if    $first-row == $second-row
+    {
+        my Int $i = $first-col  - 1;
+               $i = 4 if $i < 0;
+
+        my Int $j = $second-col - 1;
+               $j = 4 if $j < 0;
+
+        $text = $table[ $first-row;  $i ] ~
+                $table[ $second-row; $j ];
+    }
+    elsif $first-col == $second-col
+    {
+        my Int $i = $first-row  - 1;
+               $i = 4 if $i < 0;
+
+        my Int $j = $second-row - 1;
+               $j = 4 if $j < 0;
+
+        $text = $table[ $i; $first-col  ] ~
+                $table[ $j; $second-col ];
+    }
+    else
+    {
+        $text = $table[ $first-row;  $second-col ] ~
+                $table[ $second-row; $first-col  ];
+    }
+
+    return $text;
+}
+
+#------------------------------------------------------------------------------
+sub make-table
+(
+    Str:D $key-orig
+--> List:D[ Array:D[Array:D[Str:D]], Hash:D[Array:D[UInt:D]] ]
+)
+#------------------------------------------------------------------------------
+{
+    my Array[Str] @table;
+
+    push @table, Array[Str].new: Nil xx 5 for 0 .. 4;
+
+    my Str $key =  $key-orig.lc;
+           $key ~~ s:g/ <-[a .. z]> //;
+           $key ~= $_ for 'a' .. 'z';
+           $key ~~ tr/j/i/;
+
+    my Array:D[UInt:D] %l2rc;
+    my UInt            %alphabet   = ('a' .. 'z').map: { $_ => 0 };
+    my UInt           ($row, $col) = (0, 0);
+
+    for $key.split: '', :skip-empty -> Str $letter
+    {
+        unless %alphabet{ $letter }++
+        {
+            @table[$row][$col] = $letter;
+            %l2rc{ $letter }   = Array[UInt].new: $row, $col;
+
+            if ++$col > 4
+            {
+                $col = 0;
+                last if ++$row > 4;
+            }
+        }
+    }
+
+    %l2rc{ 'j' } = %l2rc{ 'i' };
+
+    return @table, %l2rc;
+}
+
+#------------------------------------------------------------------------------
+sub get-digrams( Str:D $text --> Array:D[Array:D[Str:D]] )
+#------------------------------------------------------------------------------
+{
+    my Array[Str] @digrams;
+    my Str        @letters = $text.split: '', :skip-empty;
+
+    while +@letters
+    {
+        my Str $first = @letters.shift;
+        my Str $second;
+
+        if   +@letters == 0 || @letters[ 0 ] eq $first
+        {
+            $second = ($first eq $PADDING_1) ?? $PADDING_2 !! $PADDING_1;
+        }
+        else
+        {
+            $second = @letters.shift;
+        }
+
+        @digrams.push: Array[Str].new: $first, $second;
+    }
+
+    return @digrams;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################