patternMinor
Caesar and Vigenère ciphers in Haskell the simple way
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.
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 =
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:
Indeed, only the following property holds:
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
With that in mind, we can heavily reduce the size of
We could also use
Now that we've reused
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
It is even shorter. It is easier to read than the point-free version, too. No
We've lost all applications of
Being able to advance a lower-case ASCII character seems somewhat important, so let us refactor that:
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
Hm.
But for a second, let us again say that you want to keep the whitespace. How would that look like?
Hm.
In order to share code between
```
vigenere :: String -> String -> String
vigenere k s = helper (cycle k) s
where
base = ord 'a'
diff c = ord c - base
helper _ [] = []
helper (y:
unCaesar n (caesar n xs) == xsIndeed, 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 ysBut 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)) 26In 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) == xslet 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.