Programming Praxis – Chaocipher

In today’s Programming Praxis we have another cipher on our hands, called chaocipher. The provided Scheme solution is 25 lines, so let’s see if we can improve that.

Some imports:

import Control.Arrow
import Data.List

One of the steps of the algorithm is taking the first n characters and moving them to the end.

seek :: Int -> [a] -> [a]
seek to = uncurry (flip (++)) . splitAt to

Another step is taking a group of characters between two indices and applying the previous function to them. The Scheme solution combines these two functions in one, but I prefer to keep them separate.

shift :: Int -> Int -> [a] -> [a]
shift from to = (\((a,b),c) -> a ++ seek 1 b ++ c) .
                first (splitAt from) . splitAt to

With those two out of the way, ciphering in either direction is a matter of finding the input character on the appropriate wheel, outputting the corresponding character from the other wheel and repeating the process after modifying the wheels.

cipher :: Eq a => Bool -> [a] -> [a] -> [a] -> [a]
cipher _ _ _ []     = []
cipher e l r (x:xs) = to !! i : cipher e (shift 1 14 $ seek i l)
                      (shift 2 14 . shift 0 26 $ seek i r) xs
    where Just i = elemIndex x from
          (from, to) = if e then (r, l) else (l, r)

Let’s add some convenience functions for encoding and decoding:

encipher, decipher :: Eq a => [a] -> [a] -> [a] -> [a]
encipher = cipher True
decipher = cipher False

Of course we need to check if everything is working correctly:

main :: IO ()
main = do let l = "HXUCZVAMDSLKPEFJRIGTWOBNYQ"
              r = "PTLNBQDEOYSFAVZKGJRIHWXUMC"
              decoded = "WELLDONEISBETTERTHANWELLSAID"
              encoded = "OAHQHCNYNXTSZJRRHJBYHQKSOUJY"
          print $ encipher l r decoded == encoded
          print $ decipher l r encoded == decoded

Everything looks to be working alright, and at 10 lines we reduced the Scheme version by 60%. Not bad.

Tags: bonsai, chaocipher, cipher, code, crypto, decode, encode, Haskell, kata, praxis, programming