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

Question

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
advanceBy n b c = chr $ (ord c - base + n) `mod` 26 + base
  where
    base = ord b

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

uncaesar n = caesar (26 - n)

Vigenère's cipher

I noticed the helper of vigenere is almost the same as that of caesar. I could somehow extract that one out, but it wouldn't really help the readability very much and also I'd need to hack a little in the definition of caesar. Also, unVigenere can be defined in terms of vigenere (similarly to how unCaesar is defined), but it isn't really nice nor elegant, so I do it traditionally instead.

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

unVigenere = cipher helper ' '
  where
    helper k x =
        let base = if isUpper x then 'A' else 'a'
        in advanceBy (26 - (ord k - ord base)) base x

Some other weird cipher

Here I want to showcase a cipher that encodes a list of integers using two keys. Because I don't know any legit ciphers apart from Caesar's and Vigenère's (I'd like to, though - be sure to link some if you know them), I had to create a new throwaway cipher.

(By the way, is this right? I don't like the fromIntegral and floor parts. It doesn't matter much here, but it'd be nice to know how to write this properly.)

fancypher, unfancypher :: Int -> String -> [Int] -> [Int]
fancypher n = cipher helper 0
  where
    helper k x = n * x * ord k

unfancypher n = cipher helper 0
  where
    helper k x = floor $ fromIntegral x / fromIntegral (n * ord k)

Answer 1

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'
        in advanceBy n base x

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'
             in advanceBy k base x

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?