Cracking Caesar Cipher

Question

I'm new to Haskell, so I wrote a program to crack Caesar Ciphered text for practice. The program calculates the frequency of each letter in the input, and then checks to see which shift minimizes the Euclidean norm of the element-wise difference between the text's frequencies and pre-measured frequencies in the English language. The program prints the shift to stdio and writes the decrypted text to {input file name}_DECRYPTED.

While this isn't actually a great (let alone mediocre) decryption method, I'd appreciate any input about how to improve my code to make it more "Haskell-like" or idiomatic. Syntax and readability suggestions are also more than welcome.

Thank you!

import System.Environment (getArgs)
import System.IO
import Data.List (elemIndex)
import Data.Char (ord, chr, isUpper, isAlpha, toLower)
import Data.Bool (bool)
import Data.Map (fromListWith, toList)


-- English letter frequencies from A to Z
frequencies :: (Fractional a) => [a]
frequencies = [0.0812,
               0.0149,
               0.0271,
               0.0432,
               0.1202,
               0.023,
               0.0203,
               0.0592,
               0.0731,
               0.001,
               0.0069,
               0.0398,
               0.0261,
               0.0695,
               0.0768,
               0.0182,
               0.0011,
               0.0602,
               0.0628,
               0.091,
               0.0288,
               0.0111,
               0.0209,
               0.0017,
               0.0211,
               0.0007]

main :: IO()
main = do  
  (filename: _) <- getArgs
  handle <- openFile filename ReadMode
  encrypted <- hGetContents handle
  let shift_size = decrypt (map toLower $ filter isAlpha encrypted) in
    do
    print shift_size
    writeFile (filename ++ "_DECRYPTED") (shift (negate shift_size) encrypted)
  hClose handle

shift :: Int -> String -> String
shift s input = map (shiftLetter s) input

shiftLetter :: Int -> Char -> Char
shiftLetter offset c
  | isAlpha c =
    let i = ord $ bool 'a' 'A' (isUpper c)
    in chr $ i + mod ((ord c - i) + offset) 26
  | otherwise = c

decrypt :: String -> Int
decrypt text = let len = fromIntegral $ length text
                   (_, freq) = unzip $ toList $ fromListWith (+) [(c, 1.0) | c <- text]
                   in minShift frequencies $ map (flip (/) len) freq

minShift :: (Fractional a) => (Ord a) => [a] -> [a] -> Int
minShift freq1 freq2 = let norms = map (\x -> norm freq1 (shiftList freq2 x)) [0..25]
                           (Just num) = elemIndex (minimum norms) norms in num

shiftList :: (Fractional a) => [a] -> Int -> [a]
shiftList freq x = iterate oneCycle freq !! x

oneCycle :: (Fractional a) => [a] -> [a]
oneCycle (x:xs) = xs ++ [x]

norm :: (Fractional a) => [a] -> [a] -> a
norm xs ys = foldl (\acc -> \(x, y) -> acc + (x - y)^2) 0 $ zip xs ys

Answer 1

Let's start with the trivial stuff...

A few minor stylistic points that are pretty much universal:

• The type IO () is always written with a space between IO and (), never IO().

• Similarly, multiple constraints are written as a comma-separated list:

  (Fractional a, Ord a) => ...
  

  rather than a chained list (Fractional a) => (Ord a) => ...

• For do-blocks, even though the syntax permits:

  do
  firstLine
  secondLine
  

  they are almost never written this way. It's either:

  do firstLine
     secondLine
  

  or else:

  do
    firstLine -- w/ your standard choice of indentation, usually 2 or 4
    secondLine
  

  It's often considered acceptable to write:

  someother expression $ do
    contentsOf
    theDoBlock
  

  so the contents can be unindented or negatively indented with respect to the do keyword in this case.

For the specific do-block in your main function, because a standalone let statement is permitted in do-notation, you don't need the nesting at all, so this would be more standard:

main = do
  ...
  let shift_size = decrypt (map toLower $ filter isAlpha encrypted)
  print shift_size
  writeFile (filename ++ "_DECRYPTED") (shift (negate shift_size) encrypted)
  hClose handle

(This is despite the fact that shift_size is only needed in the following two lines and not the last.)

I find that idiomatic Haskell tends to use where in preference to let ... in ... statements, so for example:

decrypt :: String -> Int
decrypt text = minShift frequencies $ map (flip (/) len) freq
  where len = fromIntegral $ length text
        (_, freq) = unzip $ toList $ fromListWith (+) [(c, 1.0) | c <- text]

The motivation here is that the definition of decrypt text is given immediately following the =, and if the helper functions like len and freq have sufficiently self-evident names, the reader can mostly ignore the where ... details.

More controversially, some people like to write the most general type signatures possible. In my opinion, unless you're writing a library or actually need the generality, I don't think there's much point. The polymorphic type signatures and Fractional constraints clutter up your code, and if you turned on -Wall, which you should be doing anyway, you'd see that GHC is defaulting your type to Double, a default that would be better to make explicit anyway. Personally, I'd replace most of the Fractional a => ... a ... with Doubles. (Well, except oneCycle and shiftList, which are probably clearer with unconstrained type signatures.)

Now to the less trivial stuff...

In minShift, consider the definition of norms:

norms = map (\x -> norm freq1 (shiftList freq2 x)) [0..25]

This calculates shiftList freq2 x for every x from 0 to 25, but shiftList works by generating the full list iterate oneCycle freq and then selecting element x, so you would have been better off writing:

norms = map (norm freq1) (take 26 $ iterate oneCycle freq2)

Actually, a more common way of calculating all "cycles" of a list is:

cycles :: [a] -> [[a]]
cycles xs = zipWith (++) (tails xs) (inits xs)

which many Haskellers take great pride in writing using implicit reader monad/applicative:

cycles :: [a] -> [[a]]
cycles = zipWith (++) <$> tails <*> inits

Also, finding the minimum with minimum and then getting its index with elemIndex would be frowned upon because it traverses the list twice (or, on average, one and a half times in the absence of duplicate minimums), and even though it's ridiculous to worry about performance on a 26-item list, I guess folks would be more likely to use a trick like:

minimumIndex :: (Ord a) => [a] -> Int
minimumIndex xs = snd . minimum $ zip xs [0..]

Note that I'm breaking my own rule here about not overgeneralizing functions. In this case, it just "feels" right. Anyway, the way this works is by using zip to add an index, so that the list xs = [5,4,6,1,8] becomes:

[(5,0),(4,1),(6,2),(1,3),(8,4)]

Because tuples are sorted lexicographically, finding the minimum will pick up the element (1,3), and we use snd to grab the index "3".

So, now minShift looks like this:

minShift :: [Double] -> [Double] -> Int
minShift freq1 freq2 = minimumIndex $ map (norm freq1) (cycles freq2)

with helpers minimumIndex and cycles as above.

For the top-level norm function, your foldl is really a sum, and you can use zipWith to combine the zip with the calculation of the term:

norm :: [Double] -> [Double] -> Double
norm xs ys = sum $ zipWith (\x y -> (x-y)^2) xs ys

With -Wall on, this warns you that 2 is defaulting to Integer. I'd probably write:

norm :: [Double] -> [Double] -> Double
norm xs ys = sum $ zipWith (\x y -> (x-y)*(x-y)) xs ys

just to get rid of this warning.

In decrypt, the flip can be replaced with a section:

decrypt text = minShift frequencies $ map (/ len) freq

However, there's a bug in your freq calculation. The map it builds will only have keys for the letters that actually appear in the input text, so the freq and frequencies lists won't generally line up. Anyway, I'd pull it out into a separate function:

{-# LANGUAGE TupleSections #-}
import qualified Data.Map.Strict as Map

freq :: String -> [Int]
freq inp
  = Map.elems $ Map.unionWith (+) initMap . Map.fromListWith (+) . map (,1) $ inp
    where initMap = Map.fromList . map (,0) $ ['a'..'z']

This uses Map.unionWith and an all-zeros map initMap to ensure the keys 'a' through 'z' will be in the map. It also uses Map.elems in place of let (_, freq) = unzip $ Map.toList $ ....

Finally, note that I've used Data.Map.Strict. This is good practice for "counting" maps, so that large inputs don't cause a memory leak.

My decrypt now looks like:

decrypt :: String -> Int
decrypt text = minShift frequencies $ map (/ len) $ map fromIntegral $ freq text
  where len = fromIntegral $ length text

Also, shiftLetter would probably be clearer to write with separate cases and a helper in place of bool.

shiftLetter :: Int -> Char -> Char
shiftLetter offset c
  | isAsciiLower c = go 'a'
  | isAsciiUpper c = go 'A'
  | otherwise      = c
  where go a = chr $ (ord c - ord a + offset) `mod` 26 + ord a

Note that the isAscii... versions are safer than isLower and isUpper because these allow unicode letters.

For shift, some typical simplifications are possible. So:

shift s input = map (shiftLetter s) input

can be rewritten (using "eta reduction") as:

shift s = map (shiftLetter s)

Some people might go farther and write:

shift = map . shiftLetter

though this isn't particularlyclear. Maybe this would be a nice compromise:

shift :: Int -> String -> String
shift offset = map shift1
  where
    shift1 c
      | isAsciiLower c = go 'a' c
      | isAsciiUpper c = go 'A' c
      | otherwise      = c
    go a c = chr $ (ord c - ord a + offset) `mod` 26 + ord a

allowing us to eliminate shiftLetter completely.

In main, for quick-and-dirty argument parsing, you can write:

[filename] <- getArgs

This has the advantage over filename:_ <- getArgs of raising an exception if more than one argument is supplied.

The openFile / hClose pairs is more properly written using a withFile clause. But, if you're opening a file just to read its contents, it's better to use readFile anyway.

encrypted <- readFile filename

so my final main looks like:

main :: IO ()
main = do
  [filename] <- getArgs
  encrypted <- readFile filename
  let shift_size = decrypt (map toLower $ filter isAlpha encrypted)
  print shift_size
  writeFile (filename ++ "_DECRYPTED") (shift (negate shift_size) encrypted)

The final thing that bothers me is that freq has to pass through the String once to calculate the counts, and then decrypt passes through it again to count the full text length. I'd like to do it in one pass, so I'd rewrite freq to calculate the full text length, too, and return the fractional frequencies directly. This also allows us to pull the filtering into freq which is safer, since the above version of freq will break if it gets fed input that isn't restricted to the characters from 'a' to 'z'.

freq :: String -> [Double]
freq str = let (tot', mp') = foldl' step (0::Int, initMap) . getLower $ str
           in  divlist (Map.elems mp') tot'
  where
    -- get ASCII letters, converted to lowercase
    getLower = filter isAsciiLower . map toLower
    -- initial map of all-zero counts for 'a' to 'z'
    initMap = Map.fromList . map (,0::Int) $ ['a'..'z']
    -- for each `c`, add one to `tot` and count a `c`
    step (tot, mp) c = (tot+1, Map.insertWith (+) c 1 mp)
    -- divide each element of xs by n
    divlist xs n = map (/ fromIntegral n) (map fromIntegral xs)

This works with the following versions of main and decrypt:

main :: IO ()
main = do
  [filename] <- getArgs
  encrypted <- readFile filename
  let shift_size = decrypt encrypted
  print shift_size
  writeFile (filename ++ "_DECRYPTED") (shift (-shift_size) encrypted)

decrypt :: String -> Int
decrypt text = minShift frequencies (freq text)
  where len = fromIntegral $ length text

Note that negate can be written - as long as you stick in some parentheses. Some people hate this because this - is Haskell's only unary operator and looks weird, so they might stick with negate anyway.

Finally, I think I'd rearrange minShift a bit to make things easier to test. Also, Data.Char and some others (Data.List and Data.Foldable) are commonly imported in full without explicit import lists, and Data.Map.Strict is commonly imported qualified without an explicit import list, so I'd probably write my imports as:

import System.Environment (getArgs)
import Data.List
import Data.Char
import qualified Data.Map.Strict as Map

This gives the final program:

{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}

import System.Environment (getArgs)
import Data.List
import Data.Char
import qualified Data.Map.Strict as Map

main :: IO ()
main = do
  [filename] <- getArgs
  encrypted <- readFile filename
  let shift_size = decrypt encrypted
  print shift_size
  writeFile (filename ++ "_DECRYPTED") (shift (-shift_size) encrypted)

decrypt :: String -> Int
decrypt text = minimumIndex $ norms english (freq text)

-- English letter frequencies from A to Z
english :: [Double]
english = [0.0812, 0.0149, 0.0271, 0.0432, 0.1202, 0.023, 0.0203, 0.0592, 0.0731, 0.001,
           0.0069, 0.0398, 0.0261, 0.0695, 0.0768, 0.0182, 0.0011, 0.0602, 0.0628, 0.091,
           0.0288, 0.0111, 0.0209, 0.0017, 0.0211, 0.0007]

norms :: [Double] -> [Double] -> [Double]
norms freq1 freq2 =  map (norm freq1) (cycles freq2)

norm :: (Fractional a) => [a] -> [a] -> a
norm xs ys = sum $ zipWith (\x y -> (x-y)*(x-y)) xs ys

freq :: String -> [Double]
freq str = let (tot', mp') = foldl' step (0::Int, initMap) . getLower $ str
           in  divlist (Map.elems mp') tot'
  where
    -- get ASCII letters, converted to lowercase
    getLower = filter isAsciiLower . map toLower
    -- initial map of all-zero counts for 'a' to 'z'
    initMap = Map.fromList . map (,0::Int) $ ['a'..'z']
    -- for each `c`, add one to `tot` and count a `c`
    step (tot, mp) c = (tot+1, Map.insertWith (+) c 1 mp)
    -- divide each element of xs by n
    divlist xs n = map (/ fromIntegral n) (map fromIntegral xs)

shift :: Int -> String -> String
shift offset = map shift1
  where
    shift1 c
      | isAsciiLower c = go 'a' c
      | isAsciiUpper c = go 'A' c
      | otherwise      = c
    go a c = chr $ (ord c - ord a + offset) `mod` 26 + ord a

minimumIndex :: (Ord a) => [a] -> Int
minimumIndex xs = snd . minimum $ zip xs [0..]

cycles :: [a] -> [[a]]
cycles = zipWith (++) <$> tails <*> inits

If I run hlint on this, I get one suggestion:

Caesar2.hs:43:20: Suggestion: Use map once
Found:
  map (/ fromIntegral n) (map fromIntegral xs)
Perhaps:
  map ((/ fromIntegral n) . fromIntegral) xs

In this case, I think the way I have it is clearer.

In this form, it's pretty easy to test:

> freq "It's pretty easy to test"
[5.263157894736842e-2,0.0,0.0,0.0,...]
> norms english (freq "It's pretty easy to test")
[8.694623493074792e-2,0.14473570861495846,0.17156728756232686,...]
> minimumIndex $ norms english (freq "It's pretty easy to test")
0
> decrypt "huk hjabhssf dvyrz xbpal dlss lclu vu zovya aleaz."
7
> shift (-7) "huk hjabhssf dvyrz xbpal dlss lclu vu zovya aleaz."
"and actually works quite well even on short texts."