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 xs) == xs
Indeed, only the following property holds:
let xs' = unwords (words xs) in unCaesar n (caesar 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 cycle
d 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:ys) (x:xs)
| x == ' ' = ' ' : helper (y:ys) xs
| otherwise = modify x y : helper ys xs
modify x y = chr $ base + mod (diff (toLower x) + diff (toLower y)) 26
If we rewrite unVigenere
the same way, we'll notice that it looks very similar:
unVigenere :: String -> String -> String
unVigenere k s = helper (cycle k) s
where
base = ord 'a'
diff c = ord c - base
helper _ [] = []
helper (y:ys) (x:xs)
| x == ' ' = ' ' : helper (y:ys) xs
| otherwise = modify x y : helper ys xs
modify x y = chr $ base + mod (diff (toLower x) - diff (toLower y)) 26
Note that I've used the properties of mod
again, just as in Caesar.
Everything is the same. Except for the modification. In unViginere
, we subtract the key, and in vigenere
we add it. So let us move that into another function:
withKey :: (Char -> Char -> Char) -> String -> String -> String
withKey f k s = helper (cycle k) s
where
helper _ [] = []
helper (y:ys) (x:xs)
| x == ' ' = ' ' : helper (y:ys) xs
| otherwise = f y x : helper ys xs
vigenere :: String -> String -> String
vigenere = withKey modify
where
modify k v = asciiAdvance (ord k - ord 'a') v
unVigenere :: String -> String -> String
unVigenere = withKey modify
where
modify k v = asciiAdvance (26 - (ord k - ord 'a')) v
And we're done.