In today’s Programming Praxis problem we have to implement the straddling checkerboard cipher. Let’s get started.
We’ll need two imports:
import Data.Char import Data.List
Our alphabet for the checkerboard consists of letters and a space.
alphabet :: String alphabet = ['A'..'Z'] ++ " "
The algorithm cannot deal with anything other than letters, numbers or spaces.
clean :: String -> String clean = filter (`elem` alphabet ++ ['0'..'9']) . map toUpper
To create the checkerboard (without indices, since we need to the lookups both ways), we need to put the three extra spaces in the correct place and the numbers in the correct positions.
board :: String -> [Int] -> String board key = spaces (replace =<< nub (clean key ++ alphabet)) where spaces = foldl (\a x -> take x a ++ "_" ++ drop x a) replace c = c : (maybe "" id . lookup c $ zip alphabet (map show [1..9] ++ "0" : repeat ""))
As you can see below, encrypting and decrypting are really the same thing in this algorithm, only one adds and subtracts. So we factor out all of the work into one function. The reason for not making all the sub-functions into top-level functions is that it saves us from having to pass the five cipher parameters all over the place.
run :: (Int -> Int -> Int) -> String -> [Int] -> Int -> String -> String run op text ss add key = f $ show =<< zipWith (\a b -> mod (op (read [a]) b) 10) (toIndex =<< clean text) (cycle . map digitToInt $ show add) where f  =  f (a:xs) = if elem (digitToInt a) ss then fromIndex ([a], take 1 xs) ++ f (tail xs) else fromIndex ("" , [a] ) ++ f xs fromIndex = maybe "" return . look id toIndex = maybe "" (uncurry (++)) . look flip look dir k = lookup k . dir zip indices $ board key ss indices = [(y, show x) | y <- "" : map show ss, x <- [0..9]]
With that out of the way, encrypting and decrypting is trivial:
encipher :: String -> Int -> Int -> Int -> Int -> String -> String encipher xs s1 s2 s3 = run (+) xs [s1, s2, s3] decipher :: String -> Int -> Int -> Int -> Int -> String -> String decipher xs s1 s2 s3 = run (-) xs [s1, s2, s3]
Let’s see if our encryption works correctly:
main :: IO () main = do print $ go encipher "bonsai code" print $ go decipher "2B1ABA71OB1H2LBB" where go f text = f text 2 5 9 2641 "pablo picasso"
Yup. And at about a third of the Scheme solution size, I’d say that wraps things up nicely.