Interestingly, if you try to decode the 1943 message, you’ll notice two errors in the result: it says Blackess instead of Blackett and coce instead of cove. I wonder if the errors were made by the original sender or by the first person to type it on a computer.

Both errors are in the original. You can confirm that because Kahn includes in his book, in the chapter “The Inscrutable Orientals,” a picture of the original hand-written decipherment by Arthur Evans at 9:30am on the morning of August 2, 1943 (it’s on page 592 of my copy of the 1996 edition). His key ROYAL NEW ZEALAND NAVY forms the following Polybius square:

R O Y A L
N E W Z D
V B C F G
H I K M P
Q S T U X

In the original message, BLACKETT STRAIT is enciphered as GOYFI WTTTU OLKS. The three Ts all in a row is a violation of the Playfair rules. Evans decoded the message as:

GO YF IW TT TU OL KS
BL AC KE TT ST RA IT

When Evans reached the TT digram, he deciphered it as TT; that was easy, because he was sitting on his jungle hilltop looking at Blackett Strait. But though it is easy to adjust by hand, the program does the wrong thing, as you noted.

The COVE/COCE error is undoubtedly a transcription error either by the original sender or by Evans. The corresponding cipher-text is BYBW. A correct encipherment of COVE is BYBN, and somewhere the N was transcribed as a W; easy enough to do if the pencil slips just at the beginning of the N, forming a small serif that causes N to be mistaken as W. Again, Evans had no trouble fixing the error; since he lived there, he knew the message said MERESU COVE rather than MERESU COCE.

It is worth reading Kahn’s book to learn the entire cryptographic history of the incident. There is much more to it than just a few errors in a Playfair cipher.

import Data.Char
import Data.List
import Data.List.HT
import Data.List.Split
import qualified Data.Map as M

type Key = M.Map (Int, Int) Char

process :: String -> String
process = replace "J" "I" . map toUpper . filter isLetter

key :: String -> Key
key = M.fromList . concat .
      zipWith (\y -> zipWith (\x c -> ((x, y), c)) [0..]) [0..] .
      chunk 5 . (`union` delete 'J' ['A'..'Z']) . nub . process

bigram :: Key -> Int -> Char -> Char -> String
bigram k dir c1 c2
    | y1 == y2  = get (x1 + dir, y1) : [get (x2 + dir, y2)]
    | x1 == x2  = get (x1, y1 + dir) : [get (x2, y2 + dir)]
    | otherwise = get (x2, y1)       : [get (x1, y2)]
    where (x1, y1) = head . M.keys $ M.filter (== c1) k
          (x2, y2) = head . M.keys $ M.filter (== c2) k
          get (x,y) = k M.! (mod x 5, mod y 5)

encode' :: Key -> String -> String
encode' _ []       = []
encode' k [x]      = encode' k (x : "X")
encode' k (x:y:xs) | x == y    = encode' k [x] ++ encode' k (y:xs)
                   | otherwise = bigram k 1 x y ++ encode' k xs

decode' :: Key -> String -> String
decode' k = concatMap (\[x,y] -> bigram k (-1) x y) . chunk 2

encode :: String -> String -> String
encode k = encode' (key k) . process

decode :: String -> String -> String
decode k = decode' (key k) . process

main :: IO ()
main = do print $ encode "PLAYFAIR" "PROGRAMMING PRAXIS"
          print $ decode "PLAYFAIR" "LIVOBLKZEDOELIYWCN"