# Caesar and Vigenère ciphers in Haskell, Take 2 (not so simple this time)

I've posted my simple ciphers on Code Review several days ago (link: here). I refactored my code and tried to define a more general "cipher" function, according to Zeta's excellent advice. I've split the code to make it more readable.

## General cipher

This function takes an encoding function, "zero", list of keys and list of things to encode. The "zero" here is the character that shouldn't be encoded - e.g. a whitespace.

import Data.Char (toLower, ord, chr, isUpper)

cipher :: (Eq a) => (k -> a -> a) -> a -> [k] -> [a] -> [a]
cipher f z k = helper (cycle k)
where
helper _ [] = []
helper (k:ks) (x:xs)
| x == z = z : helper (k : ks) xs
| otherwise = f k x : helper ks xs

## Caesar's cipher

Notice the support for uppercase letters. I'm not sure it is right to include it, but it was a fun exercise nonetheless.

advanceBy :: Int -> Char -> Char -> Char

# Bases

Vigenère has a "bug". That is due to your alphabet management. Strictly speaking, both Caesar and Vigenère advance characters in their respective alphabet. Therefore, your alphabet should be something like

ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz

and caesar 1 "Z" could lead to "a" without losing the original Caesar's meaning. It's just shifting in the alphabet.

You, on the other hand, have two alphabets:

ABCDEFGHIJKLMNOPQRSTUVWXYZ
abcdefghijklmnopqrstuvwxyz

You stay in the respective alphabet while shifting and therefore not lose the case. Up to that point, everything seems fine, right?

Now we come to the mentioned bug:

> vigenere ['A'..'Z'] $['a'..'z'] "uwyacegikmoqsuwyacegikmoqs" > vigenere ['A'..'Z']$ ['A'..'Z']
"ACEGIKMOQSUWYACEGIKMOQSUWY"

You check the case of the secret, but not of the key. Theoretically, you should check that too:

vigenere, unVigenere :: String -> String -> String
vigenere = cipher helper ' '
where
helper k x =
let base  = if isUpper x then 'A' else 'a'
kbase = if isUpper k then 'A' else 'a'
in advanceBy (ord k - ord kbase) base x

Since you use that function so often, a baseOf might be handy:

baseOf :: Char -> Char
baseOf x = if isUpper x then 'A' else 'a'

Note that you don't notice the bug in checks, since you do the same in unVigenere

# Caesar knows its key

In caesar, you can just ignore the key, since you already know it:

caesar n = cipher helper ' ' [n]
where
helper _ x =
let base = if isUpper x then 'A' else 'a'

More on that later.

# Type signatures

While it is possible to write multiple type signatures in a single line, it's usually not done. If I have a look at unVigenere, I will only see its definition if I miss vigenere line:

unVigenere = cipher helper ' '
where
…

Now I have to guess it's type. I have to check cipher, helper's type, and so on. Compare that to

unVigenere :: String -> String -> String
unVigenere = cipher helper ' '
where
…

which immediately tells you what type unVigenere has. I don't need to scan the rest of the code anymore.

# Remove unused imports

You import toLower, but you don't use it.

# Even more general cipher

While your cipher is now rather general, there are still some small things off. First of all, your cipher's only work for ASCII letters, yet the only ignored character is a single space.

We can fix this if we use a predicate instead:

cipher :: (k -> a -> a) -> (a -> Bool) -> [k] -> [a] -> [a]
cipher f p k = helper (cycle k)
where
helper _ [] = []
helper (k:ks) (x:xs)
| not (p x) = x : helper (k : ks) xs
| otherwise = f k x : helper ks xs

Together

isAsciiLetter x = isAscii x && isLetter x -- both from Data.Char

we can now say which characters we want to change. But we can make cipher even more generic. At the moment, we need a list of keys before we can actually call cipher. But that prevents certain kinds of ciphers, namely those that work with the value of the previous character. We need some kind of state for that.

Here's where that hint from my last comment comes in:

cipher :: (k -> a -> (k, a)) -> (a -> Bool) -> k -> [a] -> [a]
cipher f p = go
where
go _ []     = []
go k (x:xs) =
| not (p x) = x : go k  xs
| otherwise = y : go k' xs
where
(k',y) = f k x

What does f now do? Well, given a key and something to encrypt, it gives us the encrypted version and a new key. Here is how you would use it in caesar:

caesar :: Int -> String -> String
caesar n = cipher helper isAsciiLetter n
where
helper k x =
let base = if isUpper x then 'A' else 'a'
in (k, advanceBy k base x)

Here's a variant that shifts the first character by n, the next by n + 1 and so on:

caesar' :: Int -> String -> String
caesar' n = cipher helper isAsciiLetter n
where
helper k x =
let base = if isUpper x then 'A' else 'a'
in (k + 1, advanceBy k base x)

We can even do something silly like only cipher every second character:

caesar'' :: Int -> String -> String
caesar'' n = cipher helper isAsciiLetter 0
where
helper k x =
| even k = (k + 1, x)
| otherwise = let base = if isUpper x then 'A' else 'a'
in (k + 1, advanceBy n base x)

However, since our stateful function is now so powerful, we don't actually need isAsciiLetter anymore. If we want to ignore a character, we can just do so in our f:

cipher :: (k -> a -> (k, b)) -> k -> [a] -> [b]
cipher f = go
where
go _ []     = []
go k (x:xs) = y : go k' xs
where
(k',y) = f k x

Here's caesar again with the new function:

caesar n = cipher (onlyAscii go) n
where
go k x = let base = if isUpper x then 'A' else 'a'

The new function onlyAscii is a modifier of f. In this case, it will apply f only on ASCII letters and keep the key and the character otherwise:

onlyAscii :: (k -> a -> (k, a)) -> (k -> a -> (k, a))
onlyAscii f k x
| isAsciiLetter x = f k x
| otherwise       = (k, x)

But that's just a demonstration of what you could do with that function. Back to your code. How would we capture vigenere?

vigenere k = cipher (onlyAscii go) (cycle k)
where
go (k:ks) x = (ks, advanceBy (ord k - ord (baseOf k)) (baseOf x) x)

where baseOf is left for an exercise. Let us check that it does the same as your previous version:

• the key is the cycled String, so it stayed the same
• due to onlyAscii, we don't change any non-ASCII letter
• if we evaluate go, we have an ASCII letter
• we use the first element from the key to cipher the current x, and return the rest from the key for the next application.

Therefore, this vigenere behaves just as yours.

# Atbash

This variant of cipher can be used to implement map. Don't believe me? Well, there's a cipher called Atbash. It doesn't need a key, and we could simply implement it like this:

atbashSingle :: Char -> Char
atbashSingle k = chr \$ 26 - ord k + 2 * ord (baseOf k)

atbash :: String -> String
atbash = map atbashSingle

But of course, we can use cipher again:

atbash = cipher (ignoreKey atbashSingle) ()

ignoreKey :: (a -> b) -> (k -> a -> (k, b))
ignoreKey f k x = (k, f x)

Which shows that map f == cipher (ignoreKey f) ().

# Exercises

1. That cipher is now harder to use than before. Add some convenience functions like onlyAscii and ignoreKey to make it easier to work with it.
2. Create a type synonym to make (k -> a -> (k, b)) more user friendly.
3. There's a Monad that captures this kind of computation. Which is it? Can you write cipher with the help of that Monad?
• You cannot imagine how grateful I am for this answer. There are so many sexy things in this; and how it all fits so nicely together! Pure magic. Also thank you very much for these exercises. As I'm really only beginning to learn Haskell, I don't yet know what Monads are. I'm just slowly reading through the Haskell book and Monads are in the very next chapter. Mar 27, 2017 at 19:45
• How could I make it so that the ciphers use only one alphabet of 52 characters? Would I need to make some kind of dictionary manually? Also, how does the type signature for ignoreKey and onlyAscii work? As it is put now, shouldn't it denote that onlyAscii takes a function and returns one? How come in also accepts k and x as arguments? Mar 27, 2017 at 21:04
• @Sh4rPEYE to answer your last question: a -> (b -> c) is the same as a -> b -> c, since (->) is right-associative. So (k -> a -> (k,a)) ->(k -> a -> (k,a)) is (k -> a -> (k,a)) -> k -> (a -> (k, a)) is (k -> a -> (k,a)) -> k -> a -> (k, a). For the dictionary: one way that comes to mind is to provide Char -> Maybe Int instead of baseOf (to get the correct Int if the character is valid) and Int -> Maybe Char to get the correct character (if the Int was valid).
– Zeta
Mar 28, 2017 at 4:35
• I see. I did something similar, only without Maybe. I can rewrite it, but I would need to handle Nothing in every function now (I call the alphaPos and alphaChar directly from the functions). I'd rather make sure those function are alway passed only valid values to keep my code cleaner. What do you think? Mar 28, 2017 at 21:08