HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Caesar and Vigenère ciphers in Haskell the simple way

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
ciphersthesimplecaesarwayvigenèrehaskelland

Problem

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 =

Solution

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:

Code Snippets

unCaesar n (caesar n xs) == xs
let xs' = unwords (words xs) in unCaesar n (caesar n xs') == xs'
unCaesar :: Int -> String -> String
unCaesar n = caesar (26 - n)
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'
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'

Context

StackExchange Code Review Q#158663, answer score: 5

Revisions (0)

No revisions yet.