# Perl Weekly Challenge 162.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 162.

``````Submitted by: Mohammad S Anwar
Write a script to generate the check digit of given ISBN-13

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, (d0+3d1+d2+…+d12)%10=0, which may be solved for the check digit /d12=(-d0+3d1+d2+…+3d11)%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.

`````` 1  # Perl weekly challenge 162
3  #
5  use v5.12;
6  use warnings;
7  use List::Util qw(sum);
8  die "Usage: ./ch-1.pl ISBN1 [ISBN2] ...\n",
9      "to calculate the check digit of the ISBN-13 codes ISBNi\n",
10      "The first 12 digits should be provided. Extra digits and punctuation are discarded"
11      unless @ARGV;
12  my @factors=(1,3)x6;
13  foreach(@ARGV){
14      my @digits=grep{/\d/}split "", \$_; # remove non-digits
15      say "ISBN-13 check digit for \$_ is ",
16          (-(sum map {\$factors[\$_]*\$digits[\$_]} 0..11)%10)
17  }
``````

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
``````

``````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

1. 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.
2. 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:

`````` 1  # Perl weekly challenge 162
3  #
5  use v5.12;
6  use warnings;
7  use Try::Tiny; # Use try/catch to manage errors.
8  use POSIX qw(floor);
9  my %commands=(encrypt=>\&encrypt, decrypt=>\&decrypt);
10  die "Usage: ch-2.pl C1 K1 S1 [C2 K2 S2]...\n",
11      "to run command Ci (encrypt or decrypt) on string Si with key Ki\n"
12      unless @ARGV and @ARGV%3==0;
13  while(1){
14      my (\$command, \$key, \$string)=splice @ARGV, 0, 3;
15      last unless \$command;
16      my (\$l_command, \$l_key, \$l_string)=map {lc} (\$command, \$key, \$string); # normalize
17      try {
18          die "Wrong command: \$command\n" unless defined \$commands{\$l_command};
19          my \$result=\$commands{\$l_command}->(\$l_key, \$l_string); # encrypt or decrypt
20          say "\$command(\$key, \$string)=\n\t", join " ", split /(.....)/,\$result;
21      }
22      catch {
23          say \$_;
24      }
25  }
26  sub encrypt {
27      my (\$key, \$message)=@_;
28      map {s/[^a-z]//g; s/j/i/g;} (\$key, \$message); # only letters, j=i
29      my (\$table_a, \$table_h)=make_tables(\$key); # map coordinates to letters and viceversa
30      my @message=split '', \$message;
31      my @encrypted;
32      while(@message){
33          my \$first=shift @message;
34          my \$second;
35          \$second=@message && \$message[0] ne \$first # check availability, repetitions
36              ?shift @message
37              :'x'; # dummy x to avoid repetitions
38          my (\$row1, \$col1)=@{\$table_h->{\$first}}; # get coordinates
39          my (\$row2, \$col2)=@{\$table_h->{\$second}};
40          push(@encrypted, \$table_a->[\$row1][\$col2],
41               \$table_a->[\$row2][\$col1]), next # exchange corners
42              if \$row1!=\$row2 && \$col1 != \$col2; # rectangle
43          push(@encrypted, \$table_a->[\$row1][(\$col1+1)%5],
44               \$table_a->[\$row2][(\$col2+1)%5]), next # rotate right
45              if \$row1==\$row2 && \$col1 != \$col2; # single row
46          push(@encrypted, \$table_a->[(\$row1+1)%5][\$col1],
47               \$table_a->[(\$row2+1)%5][\$col2]), next # rotate down
48              if \$row1!=\$row2 && \$col1 == \$col2; # single column
49          # I can only arrive here if there are two consequtive x's. Not
50          # sure what to do, so I'll just return them
51          push @encrypted, 'x', 'x'; # repeated x
52      }
53      return join '', @encrypted;
54  }
55  sub decrypt { # similar to encrypt but with opposite rotations.
56      my (\$key, \$message)=@_;
57      map {s/[^a-z]//g; s/j/i/g;} (\$key, \$message); # only letters, j=i
58      my (\$table_a, \$table_h)=make_tables(\$key);
59      my @message=split '', \$message;
60      die "Encrypted string should have even length\n" if @message%2;
61      my @decrypted;
62      while(@message){
63          my (\$first, \$second)=splice @message,0,2;
64          my (\$row1, \$col1)=@{\$table_h->{\$first}};
65          my (\$row2, \$col2)=@{\$table_h->{\$second}};
66          push(@decrypted, \$table_a->[\$row1][\$col2],
67               \$table_a->[\$row2][\$col1]), next # exchange corners
68              if \$row1!=\$row2 && \$col1 != \$col2;
69          push(@decrypted, \$table_a->[\$row1][(\$col1-1)%5],
70               \$table_a->[\$row2][(\$col2-1)%5]), next # rotate left
71              if \$row1==\$row2 && \$col1 != \$col2;
72          push(@decrypted, \$table_a->[(\$row1-1)%5][\$col1],
73               \$table_a->[(\$row2-1)%5][\$col2]), next # rotate up
74              if \$row1!=\$row2 && \$col1 == \$col2;
75          # I arrive here for the case xx
76          push @decrypted, 'x'; # remove repetition
77      }
78      return join '', @decrypted;
79  }
80
81  sub make_tables {
82      my \$key=shift; # only letters a-z and without j's and
83      my @letters=((split '', \$key),('a'..'i', 'k'..'z')); # complete alphabet
84      my (@table, %table);
85      my \$i=0;
86      foreach(@letters){
87          my (\$row, \$col)=(floor(\$i/5), \$i%5);
88          \$table[\$row][\$col]=\$_, \$table{\$_}=[\$row,\$col], ++\$i unless defined \$table{\$_};
89      }
90      return (\@table, \%table);
91  }
``````

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