Programming Praxis - Straddling Checkerboard

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.

About these ads

Tags: bonsai, checkerboard, cipher, code, encryption, Haskell, kata, praxis, programming, straddling