Links und Funktionen
Sprachumschaltung

Navigationspfad
You are here: Home / Teaching / Summer 2017 / Cryptography / Exercises / vigenere.hs


Inhaltsbereich

vigenere.hs

Haskell source code icon vigenere.hs — Haskell source code, 3 KB (3312 bytes)

File contents

import Data.List
import Data.Maybe
import Data.Function

probs :: [(Char, Double)]
probs = [('a', 8.2), ('b', 1.5), ('c', 2.8), ('d', 4.2), ('e', 12.7), ('f', 2.2),
         ('g', 2.0), ('h', 6.1), ('i', 7.0), ('j', 0.1), ('k', 0.8), ('l', 4.0),
         ('m', 2.4), ('n', 6.7), ('o', 7.5), ('p', 1.9), ('q', 0.1), ('r', 6.0),
         ('s', 6.3), ('t', 9.0), ('u', 2.8), ('v', 1.0), ('w', 2.4), ('x', 2.0),
         ('y', 0.1), ('z', 0.2)]
characteristic = 0.065

letter :: Int -> Char
letter i = toEnum $ fromEnum 'a' + i

index :: Char -> Int
index c = fromEnum c - fromEnum 'a'

add :: Char -> Char -> Char
add c d = letter $ (index c + index d) `mod` 26

inv :: Char -> Char
inv c = letter $ 26 - (index c)

shift msg key =
  map (uncurry add) (zip msg (let keyrep = key ++ keyrep in keyrep))

subseq msg period offset =
  zip msg [0..]
  & filter (\(a, i) -> i `mod` period == offset)
  & map fst

freq :: String -> Char -> Double
freq msg c =
  fromIntegral (length $ filter (==c) msg) / (fromIntegral $ length msg)

engfreqs :: [Double]
engfreqs = [ (fromJust $ lookup c probs) / 100.0 | c <- ['a'..'z'] ]

best :: [(a, Double)] -> a
best l =
  [ (x, abs (v - characteristic)) | (x, v) <- l]
  & sortOn snd
  & head
  & fst

sumprod ps qs =
  foldr (\(p, q) acc -> acc + p*q) 0.0 (zip ps qs)

sqsum msg =
  let freqs = map (freq msg) ['a'..'z']
  in sumprod freqs freqs

-- Computes the  key length of message [msg], where [max] is the maximum key
-- length that is tried.
keylength msg max =
  best [(i, sqsum (subseq msg i 0)) | i <- [1..max+1]]

-- Compute a single character of the key.
keychar msg =
  let valofkey k = sumprod engfreqs [freq msg (add k c) | c <- ['a'..'z']]
  in best [(k, valofkey k) | k <- ['a'..'z']]

-- Compute the whole key for the given message [msg], where [max] is the
-- maximum key length that is tried.
key msg max =
  let len = keylength msg max
  in [ keychar (subseq msg len i) | i <- [0..len-1]]

--
text = "alanmathisonturingwasanenglishcomputerscientistmathematicianlogiciancryptanalystandtheoreticalbiologisthewashighlyinfluentialinthedevelopmentoftheoreticalcomputerscienceprovidingaformalisationoftheconceptsofalgorithmandcomputationwiththeturingmachinewhichcanbeconsideredamodelofageneralpurposecomputerturingiswidelyconsideredtobethefatheroftheoreticalcomputerscienceandartificialintelligenceduringthesecondworldwarturingworkedforthegovernmentcodeandcypherschoolatbletchleyparkbritainscodebreakingcentrethatproducedultraintelligenceforatimeheledhuteightthesectionresponsibleforgermannavalcryptanalysishedevisedanumberoftechniquesforspeedingthebreakingofgermanciphersincludingimprovementstothepre-warpolishbombemethodanelectromechanicalmachinethatcouldfindsettingsfortheenigmamachineturingplayedapivotalroleincrackinginterceptedcodedmessagesthatenabledthealliestodefeatthenazisinmanycrucialengagementsincludingthebattleoftheatlanticandinsodoinghelpedwinthewarcounterfactualhistoryisdifficultwithrespecttotheeffectultraintelligencehadonthelengthofthewarbutattheupperendithasbeenestimatedthatthisworkshortenedthewarineuropebymorethantwoyearsandsavedoverfourteenmillionlives"

-- encoded text
code = shift text "jxbvu"

-- Compute the key from the code, trying keys of length up to 7.
passwd = key code 7

-- Decode to test.
decoded = shift code (map inv passwd)

Document Actions


Funktionsleiste