RogerBW's Blog

I’ve been doing the Weekly Challenges. The latest involved ISBN check digits and the Wheatstone-Playfair cipher. (Note that this is open until 1 May 2022.)

Task 1: ISBN-13

Write a script to generate the check digit of given ISBN-13 code.

Back to things I can readily test. I ended up writing four tests:

• generate a check digit from an incomplete ISBN (12 digits)
• generate a check digit from a complete ISBN (13 digits)
• validate a correct ISBN
• don't validate an incorrect ISBN

Sometimes I used regular expressions, sometimes I didn't. The Kotlin does:

fun generate(in0: String): Int {

Strip down the input to just digits, and make sure we have enough.

    val re = "[^0-9]+".toRegex()
    var in1 = re.replace(in0,"")
    if (in1.length < 12) {
        return 99
    }

Iterate through the first 12 digits, alternating multipliers.

    in1 = in1.substring(0..11)
    var s = 0
    var m = 1
    for (i in in1.toCharArray().toList()) {
        s += m * i.digitToInt()
        m = 4 - m
    }

Calculate what the final digit should be.

    return (10-(s % 10)) % 10
}

Then to validate, strip the string as before.

fun validate(in0: String): Boolean {
    val re = "[^0-9]+".toRegex()
    var in1 = re.replace(in0,"")
    if (in1.length != 13) {
        return false
    }

Compare the generated digit with the actual final digit and return that boolean.

    return generate(in1) == in1.get(12).digitToInt()
}

Task 2: Wheatstone-Playfair

Implement encryption and decryption using the Wheatstone-Playfair cipher.

Yes, another proposal of mine - which I wrote in Perl first before sending it in. Which means the Perl is the ugliest code here… as I wrote it repeatedly in different languages things gradually improved, and the Rust and Python versions that I wrote last are much more attractive.

The algorithm is very nearly symmetric, so we wrap it with encrypt and decrypt utility functions.

sub encrypt {
  my ($kw,$plaintext)=@_;
  return playfair(1,$kw,$plaintext);
}

sub decrypt {
  my ($kw,$ciphertext)=@_;
  return playfair(-1,$kw,$ciphertext);
}

sub playfair {
  my ($dir,$kwi,$input)=@_;

Set up a 25-character key string, starting with each unique letter in the key, and then filling in with the rest of the alphabet. (For serious use… well, don't use this seriously. But setting up a full permutation of the alphabet would be a very good idea, perhaps via a pangram.)

  my $kw='';
  {
    my %k;
    foreach my $char (split '',lc($kwi).join('','a'..'z')) {
      if ($char eq 'j') {
        $char='i';
      }
      if ($char =~ /[a-z]/) {
        unless (exists $k{$char}) {
          $k{$char}=1;
          $kw.=$char;
        }
      }
    }
  }

Build forward (coordinates to letter) and backward (letter to coordinates) lookup tables.

  my @grid;
  my %gc;
  {
    my $index=0;
    foreach my $row (0..4) {
      my @r;
      foreach my $column (0..4) {
        push @r,substr($kw,$index,1);
        $gc{substr($kw,$index,1)}=[$row,$column];
        $index++;
      }
      push @grid, \@r;
    }
  }

Clean up the input text.

  my $ii=lc($input);
  $ii =~ s/[^a-z]//g;
  $ii =~ s/j/i/g;
  my @ichars=split '',$ii;
  my $out = '';
  my $index=0;

Loop through it, in pairs of characters.

  while ($index < scalar @ichars) {
    my $ca=$ichars[$index];
    my $cb=$ichars[$index+1] || 'x';
    $index+=2;

If there's a double character, step back and replace it with "x". (The standard doesn't define what to do if you have a double "x".)

    if ($ca eq $cb) {
      $cb='x';
      $index--;
    }

Utility variables for the A and B character coordinates.

    my ($car,$cac)=@{$gc{$ca}};
    my ($cbr,$cbc)=@{$gc{$cb}};
    my ($oar,$oac,$obr,$obc)=($car,$cac,$cbr,$cbc);

If we're on the same row, move right one column. (Left to decrypt.)

    if ($car == $cbr) {
      $oac=posmod($cac+$dir,5);
      $obc=posmod($cbc+$dir,5);

If we're in the same column, move down one row. (Up to decrypt.)

    } elsif ($cac == $cbc) {
      $oar=posmod($car+$dir,5);
      $obr=posmod($cbr+$dir,5);

Otherwise, swap the column indices.

    } else {
      $oac=$cbc;
      $obc=$cac;
    }

And build up the output string.

    $out .= $grid[$oar][$oac] . $grid[$obr][$obc];
  }
  return $out;
}

A positive, or at least non-negative, modulus utility function (since real modulus can go negative).

sub posmod {
  my ($a,$b)=@_;
  my $m=$a % $b;
  while ($m < 0) {
    $m += $b;
  }
  return $m;
}

Full code on github.