FLOLAC 2018 Week 4 (2018-5-21 19:17) -- Caesar Cipher & Decipher

caesarCipher.hs

--  FLOLAC 2018 Week 4 -- Caesar Cipher & Decipher

module CaesarCipher (encode, decode) where

import Data.List

letStart = 'A'
letFinal = 'Z'
letSeque = [letStart .. letFinal]
letQty = length letSeque

-- postShift i char
--    shift upper case character by i position and leave other characters unchanged
posShift i char = 
    case elemIndex char letSeque of
      Just m  -> letSeque !! mod (m + i) letQty
      Nothing -> char

-- encode i str
--   encrypt str by shifting i postion of upper case characters in str
encode :: Int -> String -> String
encode i = map (posShift i) 

-- decode str
--    try to decrypt str by matching the char distribution
decode :: String -> (String, Int)
decode str = (map (posShift bestInd ) str, letQty - bestInd)
   where
     bestInd = fst $ maximumBy (\x y -> compare(snd x) (snd y)) 
                       [(i, simScore i msqFreq letFreq) | i <- [1 .. letQty]]
     simScore i list1 list2 = foldl1 (+) (zipWith (*) ((replicate i 0) ++ list1) (cycle list2))
     msqFreq  = [ fromIntegral . length $ filter (== c) str  |  c <- letSeque ]

letFreq :: [Double]
letFreq =
    [ 0.08167   -- 'A'
    , 0.01492   -- 'B'
    , 0.02782   -- 'C'
    , 0.04253   -- 'D'
    , 0.12702   -- 'E'
    , 0.02228   -- 'F'
    , 0.02015   -- 'G'
    , 0.06094   -- 'H'
    , 0.06966   -- 'I'
    , 0.00153   -- 'J'
    , 0.00772   -- 'K'
    , 0.04025   -- 'L'
    , 0.02406   -- 'M'
    , 0.06749   -- 'N'
    , 0.07507   -- 'O'
    , 0.01929   -- 'P'
    , 0.00095   -- 'Q'
    , 0.05987   -- 'R'
    , 0.06327   -- 'S'
    , 0.09056   -- 'T'
    , 0.02758   -- 'U'
    , 0.00978   -- 'V'
    , 0.02360   -- 'W'
    , 0.00150   -- 'X'
    , 0.01974   -- 'Y'
    , 0.00074   -- 'Z'
    ]

{-  Testing via GHCi --

*CaesarCipher> encode 23 "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG"
"QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD"
*CaesarCipher> decode  "QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD"
("THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG",23)

*CaesarCipher> encode 13 "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG"
"GUR DHVPX OEBJA SBK WHZCF BIRE GUR YNML QBT"
*CaesarCipher> decode  "GUR DHVPX OEBJA SBK WHZCF BIRE GUR YNML QBT"
("THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG",13)

*CaesarCipher> encode 3 "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG"
"WKH TXLFN EURZQ IRA MXPSV RYHU WKH ODCB GRJ"
*CaesarCipher> decode "WKH TXLFN EURZQ IRA MXPSV RYHU WKH ODCB GRJ"
("THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG",3)
	
-}