Today’s Programming Praxis problem is about the Playfair Cipher, a way of encrypting messages that was used in the first and second World Wars. Our target is 44 lines, so let’s get cracking.
We’re going to need a bunch of imports on this one:
import Data.Char import Data.List import Data.List.HT import Data.List.Split import qualified Data.Map as M
And for convenience, we make a type definition for Keys.
type Key = M.Map (Int, Int) Char
In order for the algorithm to work, we’re going to have to filter all the input so that all we get is capital letters without a J.
process :: String -> String process = replace "J" "I" . map toUpper . filter isLetter
Instead of working with a block, we turn the key into a map of of x-y coordinates to letters. This makes the rest of the algorithm simpler.
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 encodes or decodes two letters at a time according to the three given rules.
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)
Encoding consists of inserting Xs in the correct places and then encoding all the bigrams.
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
Decoding is simpler, since there are no special cases there.
decode' :: Key -> String -> String decode' k = concatMap (\[x,y] -> bigram k (-1) x y) . chunk 2
And finally, two convenience functions so we can work with strings directly.
encode :: String -> String -> String encode k = encode' (key k) . process decode :: String -> String -> String decode k = decode' (key k) . process
All that remains is to test if everything works correctly:
main :: IO () main = do print $ encode "PLAYFAIR" "PROGRAMMING PRAXIS" print $ decode "PLAYFAIR" "LIVOBLKZEDOELIYWCN"
And we’re done. 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.
Anyway, the solution is 24 lines, just over half the size of the Scheme version. That will do nicely.