Skip to content

Instantly share code, notes, and snippets.

@tscheepers
Last active January 27, 2021 14:10
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save tscheepers/9702486 to your computer and use it in GitHub Desktop.
Save tscheepers/9702486 to your computer and use it in GitHub Desktop.
Simple cryptography problem in Haskell. It is an English text, encrypted by using N Caesar ciphers, each with its own key. The 1st, (N+1)th, (2*N+1)th, and so on letters are all encrypted using the first Caesar cipher; the 2nd, (N+2)th, (2*N+2)th, and so on with the second cipher, and so on. N is a small positive integer. Spaces and punctuation …
import Prelude
import Data.List
import Data.Ord
-- It is an English text, encrypted by using N Caesar ciphers, each with its own key.
-- The 1st, (N+1)th, (2*N+1)th, and so on letters are all encrypted using the first Caesar cipher; the 2nd, (N+2)th, (2*N+2)th, and so on with the second cipher, and so on. N is a small positive integer. Spaces and punctuation have been removed before encryption.
ceaser = decrypt "xsjztliyjvphmamicnwlriemsotjpsgcdtensyyllyydjwlxicnidtjonjqjvpsxnfidfvnntsjvdgedjhzsxsjppyxpwwzkevjchtvonxtxednqaqiqtvxtjatpjfpamemjxthwfgwenxfymzsxsjztliyjvphmamicmedgipsvpnrgjrejhxfrjymxjwemixjxsthhfwzwmrnrlqpjiidhvtgiogcrnsgfrmfxtxxlgiwfwznrsnwqnjejiykmqycemvpjfztowfgtkvliiwxmrlmzaeygeenweffpqedtlzbigjvemidhlprihfwwfxpwqtxeeyvtgyejhetfwfmdjhpamrjrpwitsxsjrtsiejiyylnjrezvjfronwytahnhpqcvsshsedylpamrjrpwinntsjvemmdhmamicnwhjpwprzbrmjglzwpbltqitymdjeddxzzrojvdyeyieyimxuppriyymetjejrlutpfvdysmjktsrpwwetfpzrmwilpemqiemmdjecsionxemiojwnwmaymzspphltkjcjmyiinmmqkvlgppkvpsgskscylpzrmwilpemqinntsjvntrdjufjreqcxfrjuizuppmegjxcnioystrtwjqpsxzgjfxglymzsscjrnwcaymzswnmixjwemeefvpjwdjrenewqcgnkpsicjgtulpwwzspjyssfzpylprfctopsxsjwewiylxsgisnroylpamrjrpwinntsjvwnopfpwuswdewullgiengnntsjvdnwtywlgmwnxjysdycxniqwibziyhclsewdwtxjcjufjrndeyfpjxmdnwemiawenymnjsqiinwcaymylexjwdfkpgcntyyymylxsjjcjufjrndsqhmamicyiiyppyxpwwlshpvylymylmeysemiwjxejvqwibziyhczkrzwqlqxpcxqtvtswefrnjmqusnhycwiorsdymyfgtulpwxpcxhmsdjtwfmyyiiymdnrpskwnwstrphsfqhdzwajgeyllytntvcjwatrojhetimjglzwpjmdylprsdyjcjufjreqcfxioqieyicnrpskwnwszwtskemignkpsicjgtulpwinfrmjiyhmamicjhlxeydsqxigjvlqppyxpwwtsxsjewullgiefxonjqjvpsxatmyywtsxsjqpxwlliemydiiqjeenrrxmxuppkvpvypsgjfrlqcdnweminwmenglqapfoyjwdnremignkpsicjgtulpwmdylpwiwfxtaiwdwstvefrowiajeejhyfxfwizkmexopdmqfgcdtefrlqcdyhtxgzaicxxsjopdwwjrrylemiyylphmamicyiiyglsfpyvpfxpiedfwpwmpxsqimqkicjrehepxechmamicxasngsnronztiylqpjfvpyvtamlqpjgvzpiyylppednwvneyijcnioreyyidywsjpaiiejvxnrpfgtulpwxpcxdpijqiylxsyltxxpcxtxjctqhnotuione"
decrypt xs = reverse $ sortBy (comparing fstOfThr) (decryptPos xs)
fstOfThr :: (Int,[Int],[Char]) -> Int
fstOfThr (x,_,_) = x
decryptPos :: [Char] -> [(Int,[Int],[Char])]
decryptPos = decryptPos' 0
decryptPos' :: Int -> [Char] -> [(Int,[Int],[Char])]
decryptPos' n xs | nt >= 2 = (nt,ks,ds) : (decryptPos' (n+1) xs)
| n > 25 = []
| otherwise = decryptPos' (n+1) xs
where
(ks,ds) = decryptWithN n xs
nt = checkForThe ds
decryptWithN :: Int -> [Char] -> ([Int],[Char])
decryptWithN n xs = (ks, concat cs)
where
(ks,cs) = unzip $ map (decryptCeaserCyper 'e') $ splitArray n xs
splitArray :: Int -> [Char] -> [[Char]]
splitArray i xs = splitArray' i xs (map (\n -> xs !! n) [0..i])
splitArray' :: Int -> [Char] -> [Char] -> [[Char]]
splitArray' _ _ [] = []
splitArray' _ _ [x] = []
splitArray' m (o:os) (x:xs) = (moduloArray m (o:os)) : (splitArray' m os xs)
moduloArray :: Int -> [Char] -> [Char]
moduloArray _ [] = []
moduloArray i s = [ s !! 0 ] ++ moduloArray i (drop i s)
decryptCeaserCyper :: Char -> [Char] -> (Int,[Char])
decryptCeaserCyper c xs = (d, map toChar $ map (\x -> (x - d) `mod` 24) $ map toNumber xs)
where
d = ceaserDifference xs c;
timesFound :: [Int] -> [(Int, Int)]
timesFound = (map (\xs -> (head xs, length xs)) . group . sort)
sortedTimesFound :: [Int] -> [(Int, Int)]
sortedTimesFound xs = reverse $ sortBy (comparing snd) (timesFound xs)
ceaserDifference :: [Char] -> Char -> Int
ceaserDifference xs c = (head $ map fst $ sortedTimesFound $ map toNumber xs) - toNumber c
checkForThe :: [Char] -> Int
checkForThe (x:y:z:xs) | x == 't' && y == 'h' && z == 'e' = 1 + (checkForThe xs)
| otherwise = checkForThe (y:z:xs)
checkForThe (x:y:z) = 0
checkForThe (x:y) = 0
checkForThe ([]) = 0
toNumber :: Char -> Int
toNumber 'a' = 0
toNumber 'b' = 1
toNumber 'c' = 2
toNumber 'd' = 3
toNumber 'e' = 4
toNumber 'f' = 5
toNumber 'g' = 6
toNumber 'h' = 7
toNumber 'i' = 8
toNumber 'j' = 9
toNumber 'k' = 10
toNumber 'l' = 11
toNumber 'm' = 12
toNumber 'n' = 13
toNumber 'o' = 14
toNumber 'p' = 15
toNumber 'q' = 16
toNumber 'r' = 17
toNumber 's' = 18
toNumber 't' = 19
toNumber 'u' = 20
toNumber 'v' = 21
toNumber 'w' = 22
toNumber 'x' = 23
toNumber 'y' = 24
toNumber 'z' = 25
toChar :: Int -> Char
toChar 0 = 'a'
toChar 1 = 'b'
toChar 2 = 'c'
toChar 3 = 'd'
toChar 4 = 'e'
toChar 5 = 'f'
toChar 6 = 'g'
toChar 7 = 'h'
toChar 8 = 'i'
toChar 9 = 'j'
toChar 10 = 'k'
toChar 11 = 'l'
toChar 12 = 'm'
toChar 13 = 'n'
toChar 14 = 'o'
toChar 15 = 'p'
toChar 16 = 'q'
toChar 17 = 'r'
toChar 18 = 's'
toChar 19 = 't'
toChar 20 = 'u'
toChar 21 = 'v'
toChar 22 = 'w'
toChar 23 = 'x'
toChar 24 = 'y'
toChar 25 = 'z'
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment