« Tiranía de la mayoría Perl Weekly Challenge 163. »

Perl Weekly Challenge 162.

My solutions (task 1 and task 2 ) to the The 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 wikipedia for more information.

Example
ISBN-13 check digit for '978-0-306-40615-7' is 7.

The ISBN-13 check digit is such that the remainder of the sum of all 13 digits multiplied alternatively by 1 or 3 has 0 as the least significant digit. Thus, (d₀+3d₁+d₂+…+d₁₂)%10=0, which may be solved for the check digit /d₁₂=(-d₀+3d₁+d₂+…+3d₁₁)%10. I checked that Perl knows how to handle modular arithmetic with negative numbers, so the program is a quite straightforward oneliner:

perl -MList::Util=sum -E '@f=(1,3)x6;foreach(@ARGV){@d=grep{/\d/}split "", $_;
    say "ISBN-13 check digit for $_ is ",(-(sum map {$f[$_]*$d[$_]} 0..11)%10)}
    ' 978-0-306-40615 978-0-306-40615-7 978-0-156-02760-1  978-0-156-71686-4 978-0-262-53848-0

Results:

ISBN-13 check digit for 978-0-306-40615 is 7
ISBN-13 check digit for 978-0-306-40615-7 is 7
ISBN-13 check digit for 978-0-156-02760-1 is 1
ISBN-13 check digit for 978-0-156-71686-4 is 4
ISBN-13 check digit for 978-0-262-53848-0 is 0

The program gets rid of non-digits and uses only the first 12, irrespective of the presence of the thirteenth.

A full version follows.

# Perl weekly challenge 162
# Task 1: ISBN-13
#
# See https://wlmb.github.io/2022/04/25/PWC162/#task-1-isbn-13
use v5.12;
use warnings;
use List::Util qw(sum);
die "Usage: ./ch-1.pl ISBN1 [ISBN2] ...\n",
    "to calculate the check digit of the ISBN-13 codes ISBNi\n",
    "The first 12 digits should be provided. Extra digits and punctuation are discarded"
    unless @ARGV;
my @factors=(1,3)x6;
foreach(@ARGV){
    my @digits=grep{/\d/}split "", $_; # remove non-digits
    say "ISBN-13 check digit for $_ is ",
        (-(sum map {$factors[$_]*$digits[$_]} 0..11)%10)
}

Example:

./ch-1.pl 978-0-306-40615 978-0-306-40615-7 978-0-156-02760-1  978-0-156-71686-4 978-0-262-53848-0

Results:

ISBN-13 check digit for 978-0-306-40615 is 7
ISBN-13 check digit for 978-0-306-40615-7 is 7
ISBN-13 check digit for 978-0-156-02760-1 is 1
ISBN-13 check digit for 978-0-156-71686-4 is 4
ISBN-13 check digit for 978-0-262-53848-0 is 0

Task 2: Wheatstone-Playfair

Submitted by: Roger Bell_West
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 Wheatstone Playfair cipher is simple enough to allow manual encryption and decryption, but much harder to (manually) decrypt. Instead of mapping one input letter to one output letter, it maps one pair of letters to another. That makes it more difficult to break manually, as there are much more pairs of letters than individual letters. According to the entry Playfair cipher in the Wikipedia, it is based on key, whose letters are arranged sequentially, left to right and top to bottom, in a 5×5 square array after eliminating repetitions and adding missing letters from the alphabet. As 5×5=25 is less than the total number of letters, I and J are identified (anyway, J sounds similar to I in some languages). All letters except J appear exactly once in this square. Any pair of letters define a subrectangle within this square. Thus, the rules for applying the cipher are

Break the message into a sequence of pairs of letters. Avoid pairs of repeated letters by inserting an X between them and regrouping. Add a trailing X if necessary to complete the last pair.
For each pair consider the rectangle they form:
1. If it has two or more rows and columns, output the letters at the opposite corners along the same rows as the original letters.
2. If the rectangle has only one row, shift it to the right one place wrapping around the edge and return the letters at its new edges.
3. If the rectangle has only one column, shift it downwards wrapping around the bottom.
4. If the rectangle is of size 1×1, the letters must be X, so output XX (I made up this rule for simplicity, as the wikipedia doesn’t say what to do in this case, but as X is not frequent, it shouldn’t be too bad).

To decrypt, we follow the same rules but applying the shifts in the opposite direction.

Encrypting and decrypting a message reproduces it except for the punctuation that would disappear, the J’s that would become I’s, and for some ocassional extra X’s, but it should be close enough for a human reader to understand the meaning of the decrypted message.

The code is:

# Perl weekly challenge 162
# Task 2: Wheatstone-Playfair
#
# See https://wlmb.github.io/2022/04/25/PWC162/#task-2-wheatstone-playfair
use v5.12;
use warnings;
use Try::Tiny; # Use try/catch to manage errors.
use POSIX qw(floor);
my %commands=(encrypt=>\&encrypt, decrypt=>\&decrypt);
die "Usage: ch-2.pl C1 K1 S1 [C2 K2 S2]...\n",
    "to run command Ci (encrypt or decrypt) on string Si with key Ki\n"
    unless @ARGV and @ARGV%3==0;
while(1){
    my ($command, $key, $string)=splice @ARGV, 0, 3;
    last unless $command;
    my ($l_command, $l_key, $l_string)=map {lc} ($command, $key, $string); # normalize
    try {
        die "Wrong command: $command\n" unless defined $commands{$l_command};
        my $result=$commands{$l_command}->($l_key, $l_string); # encrypt or decrypt
        say "$command($key, $string)=\n\t", join " ", split /(.....)/,$result;
    }
    catch {
        say $_;
    }
}
sub encrypt {
    my ($key, $message)=@_;
    map {s/[^a-z]//g; s/j/i/g;} ($key, $message); # only letters, j=i
    my ($table_a, $table_h)=make_tables($key); # map coordinates to letters and viceversa
    my @message=split '', $message;
    my @encrypted;
    while(@message){
        my $first=shift @message;
        my $second;
        $second=@message && $message[0] ne $first # check availability, repetitions
            ?shift @message
            :'x'; # dummy x to avoid repetitions
        my ($row1, $col1)=@{$table_h->{$first}}; # get coordinates
        my ($row2, $col2)=@{$table_h->{$second}};
        push(@encrypted, $table_a->[$row1][$col2],
             $table_a->[$row2][$col1]), next # exchange corners
            if $row1!=$row2 && $col1 != $col2; # rectangle
        push(@encrypted, $table_a->[$row1][($col1+1)%5],
             $table_a->[$row2][($col2+1)%5]), next # rotate right
            if $row1==$row2 && $col1 != $col2; # single row
        push(@encrypted, $table_a->[($row1+1)%5][$col1],
             $table_a->[($row2+1)%5][$col2]), next # rotate down
            if $row1!=$row2 && $col1 == $col2; # single column
        # I can only arrive here if there are two consequtive x's. Not
        # sure what to do, so I'll just return them
        push @encrypted, 'x', 'x'; # repeated x
    }
    return join '', @encrypted;
}
sub decrypt { # similar to encrypt but with opposite rotations.
    my ($key, $message)=@_;
    map {s/[^a-z]//g; s/j/i/g;} ($key, $message); # only letters, j=i
    my ($table_a, $table_h)=make_tables($key);
    my @message=split '', $message;
    die "Encrypted string should have even length\n" if @message%2;
    my @decrypted;
    while(@message){
        my ($first, $second)=splice @message,0,2;
        my ($row1, $col1)=@{$table_h->{$first}};
        my ($row2, $col2)=@{$table_h->{$second}};
        push(@decrypted, $table_a->[$row1][$col2],
             $table_a->[$row2][$col1]), next # exchange corners
            if $row1!=$row2 && $col1 != $col2;
        push(@decrypted, $table_a->[$row1][($col1-1)%5],
             $table_a->[$row2][($col2-1)%5]), next # rotate left
            if $row1==$row2 && $col1 != $col2;
        push(@decrypted, $table_a->[($row1-1)%5][$col1],
             $table_a->[($row2-1)%5][$col2]), next # rotate up
            if $row1!=$row2 && $col1 == $col2;
        # I arrive here for the case xx
        push @decrypted, 'x'; # remove repetition
    }
    return join '', @decrypted;
}
80
sub make_tables {
    my $key=shift; # only letters a-z and without j's and
    my @letters=((split '', $key),('a'..'i', 'k'..'z')); # complete alphabet
    my (@table, %table);
    my $i=0;
    foreach(@letters){
        my ($row, $col)=(floor($i/5), $i%5);
        $table[$row][$col]=$_, $table{$_}=[$row,$col], ++$i unless defined $table{$_};
    }
    return (\@table, \%table);
}

Example:

./ch-2.pl encrypt "playfair example" "hide the gold in the tree stump" \
          decrypt "playfair example" "bmodz  bxdna  bekud  muixm  mouvi f" \
          decrypt "perl and raku" "siderwrdulfipaarkcrw"

Results:

encrypt(playfair example, hide the gold in the tree stump)=
       bmodz  bxdna  bekud  muixm  mouvi f
decrypt(playfair example, bmodz  bxdna  bekud  muixm  mouvi f)=
       hidet  hegol  dinth  etrex  estum p
decrypt(perl and raku, siderwrdulfipaarkcrw)=
       thewe  xekly  chall  engex

Written on April 25, 2022