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.