3
\$\begingroup\$

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)
\$\endgroup\$
1
\$\begingroup\$

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?
\$\endgroup\$
  • \$\begingroup\$ 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. \$\endgroup\$ – Sh4rP EYE Mar 27 '17 at 19:45
  • \$\begingroup\$ 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? \$\endgroup\$ – Sh4rP EYE Mar 27 '17 at 21:04
  • \$\begingroup\$ @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). \$\endgroup\$ – Zeta Mar 28 '17 at 4:35
  • \$\begingroup\$ 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? \$\endgroup\$ – Sh4rP EYE Mar 28 '17 at 21:08

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.