# Caesar and Vigenère ciphers in Haskell the simple way

There are two ciphers, Caesar and Vigenère, both with an encoder and a decoder. Both work with spaces and can be passed any case (the output will be always lowercased, though). I'm a complete Haskell beginner and so my implementations are quite ugly and wordy. I'd welcome any help which would help me refactor the code, making it simpler, elegant and more readable.

I think it could be possible to more reuse and reduce this code. I can't think of any way to do that, though.

EDIT: Zeta's answer is great. I've refactored the following code according to his advice and added a new 'cipher' function which allows the user to create new ciphers. I raised a new question with the updated code, you can see it here.

import Data.Char (toLower, ord, chr)

caesar :: Int -> String -> String
caesar n s = unwords $map (map chr) coded where coded = map (map helper)$ words s
helper = (+) base . flip mod 26 . (+) n . flip (-) base . ord . toLower
base = ord 'a'

unCaesar :: Int -> String -> String
unCaesar n s = unwords $map (map chr) decoded where decoded = map (map helper)$ words s
helper = (-) base . flip mod 26 . (+) n . (-) base . ord . toLower
base = ord 'z'


I feel there should be a way to not handle the spaces like this, manually. Maybe zipping over a cycled key, somehow?

import Data.Char (toLower, ord, chr)

vigenere :: String -> String -> String
vigenere k s = unwords $map (map chr) coded where coded = zipWith (zipWith helper) (words s) (words$ assign s 0)
helper x y = base + mod (diff (toLower x) + diff (toLower y)) 26
base = ord 'a'
diff = flip (-) base . ord
assign str i
| null str = ""
| head str == ' ' = ' ' : assign (tail str) i
| otherwise = (k !! i) : assign (tail str) (mod (i + 1) (length k))

unVigenere :: String -> String -> String
unVigenere k s = unwords $map (map chr) decoded where decoded = zipWith (zipWith helper) (words s) (words$ assign s 0)
helper x y = base - mod (base - ord (toLower x) + diff (toLower y)) 26
base = ord 'z'
diff = flip (-) (ord 'a') . ord
assign str i
| null str = ""
| head str == ' ' = ' ' : assign (tail str) i
| otherwise = (k !! i) : assign (tail str) (mod (i + 1) (length k))

• Since you have two ciphers, you might want to split the code into two reviews. But I'm not sure about that. Alternatively you might want join both code snippets, so that you have a single "library".
– Zeta
Mar 24, 2017 at 6:53
• The way to make the code better will likely be really similar for each of those, so I grouped them. Mar 24, 2017 at 6:54

My issue with both your ciphers is that they don't preserve whitespace. Even for a lower-case only string, the following property does not hold:

unCaesar n (caesar n xs) == xs


Indeed, only the following property holds:

let xs' = unwords (words xs) in unCaesar n (caesar n xs') == xs'


But that might be your design, so let us ignore that for now. Instead, let us have a look at your first cipher.

# Caesar

The nice property about Caesar is that you can encrypt the same way you decrypt. If you move a character n characters forward, how many characters do you need to move it to get back the original one? 26 - n.

With that in mind, we can heavily reduce the size of unCaesar:

unCaesar :: Int -> String -> String
unCaesar n = caesar (26 - n)


We could also use caesar (-n) since we're using mod, but that's not important. It would fail if we used rem, though.

Now that we've reused unCaesar, let us have a look at caesar:

caesar :: Int -> String -> String
caesar n s = unwords $map (map chr) coded where coded = map (map helper)$ words s
helper = (+) base . flip mod 26 . (+) n . flip (-) base . ord . toLower
base = ord 'a'


Point-free programming isn't always best practices. It's clever, but you really don't want to fix something like that in the middle of the night. Compare your code to

caesar :: Int -> String -> String
caesar n s = unwords $map (map chr) coded where coded = map (map helper)$ words s
helper c = (ord (toLower c) - base + n) mod 26  + base
base     = ord 'a'


It is even shorter. It is easier to read than the point-free version, too. No flip. But if we want to preserve whitespace, it is still not optimal. Since we're handling a single character in helper either way, let us just keep spaces and handle all other characters:

caesar :: Int -> String -> String
caesar n = map helper
where
helper ' ' = ' '
helper c   = chr $(ord (toLower c) - base + n) mod 26 + base base = ord 'a'  We've lost all applications of unwords and words, and instead of the map (map …) we only have a single map. Being able to advance a lower-case ASCII character seems somewhat important, so let us refactor that: caesar :: Int -> String -> String caesar n = map helper where helper ' ' = ' ' helper c = asciiAdvance n c asciiAdvance :: Int -> Char -> Char asciiAdvance n c = chr$ (ord (toLower c) - base + n) mod 26  + base
where
base = ord 'a'


We will revisit Caesar later.

# Vigenère

First of all, let us apply the point-free to non-pointfree conversion and use pattern-matching in assign:

vigenere :: String -> String -> String
vigenere k s = unwords $map (map chr) coded where coded = zipWith (zipWith helper) (words s) (words$ assign s 0)
helper x y = base + mod (diff (toLower x) + diff (toLower y)) 26
base       = ord 'a'
diff c     = ord c - base

assign ""     _ = ""
assign (x:xs) i
| x == ' '  = ' '      : assign xs i
| otherwise = (k !! i) : assign xs (mod (i + 1) (length k))


Hm. assign just cycles through k and skips spaces. We can implement it without length and !! if we hand it two lists: our secret, and our cycled key:

vigenere k s = unwords $map (map chr) coded where coded = zipWith (zipWith helper) (words s) (words$ assign s (cylce k))
…
assign ""     _      = ""
assign (x:xs) (y:ys)
| x == ' '  = ' ' : assign xs (y:ys)
| otherwise = y   : assign xs ys


But for a second, let us again say that you want to keep the whitespace. How would that look like?

vigenere :: String -> String -> String
vigenere k s = map chr coded
where
coded          = zipWith helper s (assign s (cycle k)
base           = ord 'a'
diff c         = ord c - base

helper ' ' ' ' = ' '
helper x   y   = base + mod (diff (toLower x) + diff (toLower y)) 26

assign ""     _ = ""
assign (x:xs) i
| x == ' '  = ' '      : assign xs i
| otherwise = (k !! i) : assign xs (mod (i + 1) (length k))


Hm. zipWith helper and assign have the same type. Maybe we can fuse them?

vigenere :: String -> String -> String
vigenere k s = map chr $helper (cycle k) s where base = ord 'a' diff c = ord c - base helper _ [] = [] helper (y:ys) (x:xs) | x == ' ' = ' ' : helper xs (y:ys) | otherwise = modify x y : helper xs ys modify x y = base + mod (diff (toLower x) + diff (toLower y)) 26  In order to share code between vigenere and unVigenere, we need one last step. Let us change modify's type to Char -> Char -> Char: vigenere :: String -> String -> String vigenere k s = helper (cycle k) s where base = ord 'a' diff c = ord c - base helper _ [] = [] helper (y:ys) (x:xs) | x == ' ' = ' ' : helper (y:ys) xs | otherwise = modify x y : helper ys xs modify x y = chr$ base + mod (diff (toLower x) + diff (toLower y)) 26


If we rewrite unVigenere the same way, we'll notice that it looks very similar:

unVigenere :: String -> String -> String
unVigenere k s = helper (cycle k) s
where
base   = ord 'a'
diff c = ord c - base

helper _      []     = []
helper (y:ys) (x:xs)
| x == ' '  = ' '          : helper (y:ys) xs
| otherwise = modify x y   : helper ys     xs

modify x y = chr \$ base + mod (diff (toLower x) - diff (toLower y)) 26


Note that I've used the properties of mod again, just as in Caesar.

Everything is the same. Except for the modification. In unViginere, we subtract the key, and in vigenere we add it. So let us move that into another function:

withKey :: (Char -> Char -> Char) -> String -> String -> String
withKey f k s = helper (cycle k) s
where
helper _      []     = []
helper (y:ys) (x:xs)
| x == ' '  = ' '   : helper (y:ys) xs
| otherwise = f y x : helper ys     xs

vigenere :: String -> String -> String
vigenere = withKey modify
where
modify k v = asciiAdvance (ord k - ord 'a') v

unVigenere :: String -> String -> String
unVigenere = withKey modify
where
modify k v = asciiAdvance (26 - (ord k - ord 'a')) v


And we're done.

• This is an exceptional answer, thank you. Mar 25, 2017 at 7:01
• @Sh4rPEYE thank you. To be honest, I wanted to end with ciper :: (k -> a -> (k,a)) - > k -> [a] -> [a] for a generic framework, but that would have been out of scope. Feel free to ask for a follow-up review after you've modified your functions in a way you're comfortable with. Or try to implement cipher yourself, it's an interesting exercise.
– Zeta
Mar 25, 2017 at 9:12
• That sounds interesting, I'll try it. I can't think of any more things I could generalize or abstract-out, though... Maybe just that Ceasar's cipher is just a special case of Vigenère's? What was your idea roughly about? Mar 26, 2017 at 14:27
• I tried to do something, but I couldn't figure out what you meant by (k,a). I did it my way, you can see how on this link. Be sure to check it out :-) Mar 27, 2017 at 16:04