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.
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.