Perl Weekly Challenge: Week 162
Challenge 1:
ISBN-13
Write a script to generate the check digit of given ISBN-13 code. Please refer wikipedia for more information.
Example 1:
ISBN-13 check digit for '978-0-306-40615-7' is 7.
One feature I like a lot about Raku is you can do complex validation of parameters dirrectly in the function parameters. I used this in my solution to make sure it is passed a valid ISBN.
sub MAIN (
Str $isbn where { /(\d ** 3) \- (\d) \- (\d ** 3) \- (\d ** 5) \- (\d) /} #= An ISBN in the format nnn-n-nnn-nnnnn-n
) {
Actually in some real books I looked at the ISBN did not contain hyphens. So to make this script robust I should have made them optional.
Then I took the captured parts from the ISBN, combined them into a string and then split that string ending up with an array of digits.
my @digits = $/.list.join(q{}).comb;
Some digits in the ISBN have to be multiplied by 1 and some by 3. Rather than hard code each operation I made a table of multipliers which will be used in the next line.
my @multipliers = (1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3);
We can ignore the 13th digit for now so we take a slice of the first 12 digits of the @digits array and multiply them with
consecutive values from the @multipliers array using the Z* operator. This produces an array of results which are totalled
together using the [+] operator. We take the modulus 10 of that total and subtract it from 10. That produces the check digit.
my $checkdigit = 10 - ([+] (@digits[0 .. 11] Z* @multipliers)) % 10;
We print the expected check digit and compare it with the actual check digit (the 13th digit of the ISBN.) If the two are equal, this ia a valid ISBN otherwise it is invalid. This status is also printed.
say $checkdigit, ($checkdigit == @digits[12] ?? ' (valid)' !! ' (invalid)');
}
As is often the case, most of the work in producing the Perl solution consisted of replacing features from Raku that Perl lacks. And
as is happily also the case, that just means cutting and pasting code I already wrote for previous challenges. This time I dusted
off the sum() and Zmultiply() functions to replace [+] and Z* respectively. The result was this:
my $isbn = shift // usage();
if ( $isbn !~ /(\d{3}) \- (\d) \- (\d{3}) \- (\d{5}) \- (\d) /msx ) {
usage();
}
my @digits = split //, (join q{}, @{^CAPTURE});
my @multipliers = (1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3);
my $checkdigit = 10 - sum([Zmultiply([@digits[0 .. 11]], \@multipliers)]) % 10;
say $checkdigit, ($checkdigit == $digits[12] ? ' (valid)' : ' (invalid)');
Challenge 2:
Wheatstone-Playfair
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"
Unfortunately, as I write this, I have run out of time to solve this challenge though I hope to do it soon.
Update 2024/02/16 "Soon" was rather longer than I expected but I have completed this challenge now.
Raku has multiple dispatch meaning it allows multiple functions or methods with the same name as long as they take
different sets of parameters. Raku will call the right version depending on which set of parameters is passed. This
applies even to the entry-point to a script, MAIN() Another useful feature in Raku is that parameters to MAIN automatically
get converted from command-line arguments. (As a bonus you get a nice usage function too.)
If the script is called with the -d switch, this function is called:
multi sub MAIN (
Bool :$d!, #= decrypt a message
Str :$k!,
Str :$m!
) {
my %table = makeTable($k);
say decrypt(%table, %table.antipairs.Hash, $m);
}
As well, the -k switch provides the decryption key and the -m switch provides the message.
If on the other hand the -e switch is given (along with -k and -m,) this version of MAIN() will be called.
multi sub MAIN (
Bool :$e!, #= encrypt a message
Str :$k!, #= key for encryption/decryption
Str :$m! #= message to encrypt/decrypt
) {
my %table = makeTable($k);
say encrypt(%table, %table.antipairs.Hash, $m);
}
In both versions, first we create the five by five table required by the cipher with the makeTable() function. Although a two-dimensional array would be the natural structure for this, I actually use a hash. A reverse of the hash will also be needed. This is created by using the .antipairs() method on the table hash (which return a sequence) and then converting that back into a hash with .Hash(). The table, its reverse and makeTable() will be described more fully below.
The table, the reversed table, and the message (in $m) are passed to encrypt() or decrypt() functions as neeeded and the
result is printed with say().
makeTable() takes the key as its only argument.
sub makeTable(Str $k) {
According to the wikipedia, the first entries in the table must be the unique letters in the key.
my @table = $k
First the key is converted to all lower case if necessary with .lc().
.lc
The letter j is everywhere replaced with i with .subst().
.subst('j', 'i', :g)
The key is split into a list of individual characters with .comb().
.comb
Only the characters which are lower-case letters are kept by filtering them out with .grep().
.grep({ /<[a..z]>/ })
Of these, only the unique ones are kept with .unique().
.unique;
Now we have to add the rest of the letters. While the first group are in the order they appear in the key, this second group have to be in alphabetical order. We do this by comparing the lower case letters of the alphabet (in two ranges to omit j) with @table using the set difference operator ∖. This gives all the elements of the first set which are not in the second set as a Raku Set object. .keys() gives the elements of that set and .sort() puts them in alphabetical order. They are then appended to @table using .push() (remembering to "flatten" the incoming elements with the | operator.)
@table.push(| (('a' .. 'i', 'k' ..'z') ∖ @table).keys.sort);
I mentioned previously that instead of a two-dimensional array, makeTable() returns a hash. We take all the elements of @table with .values() and pair them with their indices in @table using the Z=> operator. This forms a Hash which
is returned.
return @table.values Z=> @table.keys;
}
With this hash, if we have a letter as a key, we can easily find its' location within the table as its' value will be a number from 0 (upper-left corner) to 24 (lower-right corner.) Sometimes we may have a location and need to know which letter is at it. This is the point of the reverse table.
Let's look at the encrypt() function. It takes four parameters, the hash created by makeTable(), the reverse of
that hash, and the message to encrypt.
sub encrypt(%table, %rtable, $m) {
The message is processed by...
my @message = $m
...converting it to lower-case with .lc().
.lc
If the message contains two of the same letter in a row, an x is inserted between them using .subst() and regular expressions.
.subst(/ (.)$0 /, { "$0x$0" }, :g)
Then the message is split into a list of characters with .comb().
.comb
and only the lower-case letters are kept (filtering out spaces etc.) using .grep().
.grep({ /<[a .. z]>/ });
Because the cipher works on pairs of characters, if the message had an odd length, it is evened up by appending an extra x at the end.
if @message.elems % 2 {
@message.push('x');
}
Now the message exists as a list of characters.
return @message
We take them in groups of two using .batch(2).
.batch(2)
These pairs of elements are converted into digraphs (two-character strings) by running the transformDigraph()
function on each one via .map().
.map({ transformDigraph(%table, %rtable, @$_[0], @$_[1], 1) })
These digraphs are joined back up into one string with .join(). This string is returned by the function.
.join;
}
transformDigraphs() takes five parameters altogether: the table, the reverse table, two consecutive letters from
the message, and a "direction" which will either be the numbers 1 or -1.
sub transformDigraph(%table, %rtable, $a, $b, $dir) {
If %table actually was a 5 x 5 two-dimensional array, we could find out which row the first letter was in, by taking
it as a key in %table and dividing its' corresponding value by 5. We use the integer division operator div so we don't
have to deal with fractions.
my $aRow = %table{$a} div 5;
Similarly, the letters' column within the row can be found by taking its' value modulo 5.
my $aCol = %table{$a} % 5;
The same procedure is followed for the second letter.
my $bRow = %table{$b} div 5;
my $bCol = %table{$b} % 5;
If both the letters are in the same row, we shift them over one column to the right (i.e $dir = 1) of the table. The code is a little more complicated than this because we have to allow wrap-around if one or both letters goes over the
right edge.
if $aRow == $bRow {
return %rtable{$aRow * 5 + (($aCol + $dir) % 5)} ~ %rtable{$bRow * 5 + (($bCol + $dir) % 5)};
If both the letters are in the same column, we shift them over one row to the bottom (i.e $dir = 1 again) of the table. And
again we have to account for wrap-around if a letter goes over the bottom edge.
} elsif $aCol == $bCol {
return %rtable{(($aRow + $dir) % 5) * 5 + $aCol} ~ %rtable{(($bRow + $dir) % 5) * 5 + $bCol};
The wikipedia article mentioned in the spec makes the third alternative sound more complicated than it actually is. We have to imagin the location of the two letters as being opposite corners of a rectangle within the table. All we have to do is replace these locations with the locations of the other two corners.
} else {
return %rtable{$aRow * 5 + $bCol} ~ %rtable{$bRow * 5 + $aCol};
}
In all three cases, the letters that correspond to the new locations are joined together as a digraph and returned.
}
The decrypt() function works the same way except the message doesn't need as much work on it and the direction of transformDigraph() is -1 because locations will be shifted towards the left or the top.
sub decrypt(%table, %rtable, $m) {
my @message = $m.lc.comb.grep({ /<[a .. z]>/ });
if @message.elems % 2 {
@message.push('x');
}
return @message
.batch(2)
.map({ transformDigraph(%table, %rtable, @$_[0], @$_[1], -1) })
.join;
}
For Perl we have to make a lot of changes to deal with the Raku functionality which is missing from it. For instance we
don't have multiple dispatch or automatic command-line switch handling. For the latter, I used the Getopt::Std that comes with Perl. for the former I just used if/else statements. usage() is another nice
Raku bonus we have to provide ourselves.
my %opts;
getopts('dek:m:', \%opts);
my $message = $opts{m} // usage();
my $key = $opts{k} // usage();
my %table = makeTable($key);
my %rtable = reverseTable(\%table);
if (defined $opts{'d'}) {
say decrypt(\%table, \%rtable, $message);
} elsif (defined $opts{'e'}) {
say encrypt(\%table, \%rtable, $message);
} else {
usage();
}
makeTable() works the same as in Raku with a couple of exceptions.
sub makeTable {
my ($key) = @_;
my @table = ();
for my $letter ( grep { /[a-z]/ } (split //, lc $key)) {
if ($letter eq 'j') {
$letter = 'i';
}
if (! grep { $_ eq $letter} @table) {
push @table, $letter;
}
}
Because we don't have set operations, we have to search through the alphabet (except j) with grep() to find letters
which aren't already in @table.
for my $letter ('a' .. 'i', 'k' .. 'z') {
if (! grep { $_ eq $letter} @table) {
push @table, $letter;
}
}
also we don't have Z=>. I thought I could do something similar with each() but was unable to get it to work.
So I just went through @table and made each element a hash key and a consecutive number starting from 0 its' value.
my $n = 0;
return map { $_ => $n++ } @table;
}
There is nothing quite as elegant as .antipairs.Hash for creating the reverse table but it is still pretty simple
to do.
sub reverseTable {
my ($table) = @_;
return map { $table->{$_} => $_ } keys %{$table};
}
encrypt() also works the same way as in Raku.
sub encrypt {
my ($table, $rtable, $m) = @_;
$m =~ s/(.)\1/$1x$1/g;
my @message = grep { /[a-ik-z]/ } (split //, lc $m);
if (scalar @message % 2) {
push @message, 'x';
}
my $encrypted;
for (my $i = 0; $i < scalar @message; $i += 2) {
$encrypted .= transformDigraph($table, $rtable, $message[$i], $message[$i + 1], 1);
}
return $encrypted;
}
As does decrypt().
sub decrypt {
my ($table, $rtable, $m) = @_;
my @message = grep { /[a-ik-z]/ } (split //, lc $m);
if (scalar @message % 2) {
push @message, 'x';
}
my $decrypted;
for (my $i = 0; $i < scalar @message; $i += 2) {
$decrypted .= transformDigraph($table, $rtable, $message[$i], $message[$i + 1], -1);
}
return $decrypted;
}
transformDigraph() looks forbidding but it also follows the same algorithm as its' Raku equivalent. I wish
Perl had a div operator. Instead we have to use int() and / to get the same effect.
sub transformDigraph {
my ($table, $rtable, $a, $b, $dir) = @_;
my $aRow = int ($table->{$a} / 5);
my $aCol = $table->{$a} % 5;
my $bRow = int ($table->{$b} / 5);
my $bCol = $table->{$b} % 5;
if ($aRow == $bRow) {
return $rtable->{$aRow * 5 + (($aCol + $dir) % 5)} . $rtable->{$bRow * 5 + (($bCol + $dir) % 5)};
} elsif ($aCol == $bCol) {
return $rtable->{(($aRow + $dir) % 5) * 5 + $aCol} . $rtable->{(($bRow + $dir) % 5) * 5 + $bCol};
} else {
return $rtable->{$aRow * 5 + $bCol} . $rtable->{$bRow * 5 + $aCol};
}
}