TL;DR

On with TASK #2 from The Weekly Challenge #162. Enjoy!

# The challenge

Implement encryption and decryption using the 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"


# The questions

If the example is to be taken into account, I guess that letters I and J should be coalesced, and X used as a padding. Right?

# The solution

Before delving into the solution, we can see that encryption and decryption are almost the same, except for the direction of getting letters in the same row or column, This can be easily arranged with an offset parameter to tell how much displacement we want to account for depending on the operation.

#!/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 {$_-> }   # get indexes
sort { $a-> cmp$b-> } # 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 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  I opted for a C accent this time, making things unnecessarily complicated by using an array where the natural choice would be a hash. Call it like playing NetHack with some self-imposed discipline. Fun fact: I don’t really play NetHack, but I’d love to. Anyway, this crazyness stops here and in Raku we’re on to proper hashes: #!/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 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;
}


So there we go! Stay safe!

Comments? Octodon, , GitHub, Reddit, or drop me a line!