# The Enigma Machine

GROUPS:
 Ali Hashmi 9 Votes Below is an implementation of the German Enigma Machine which the German forces used to communicate encrypted messages during WWII. The machine was an ingenious design. It used a series of rotors and an elaborate electromechanical coupling to encrypt messages in German.About the mechanism, the first rotor moved with each click of the keyboard; the second rotor moved once the first rotor completed 26 moves or one complete turn; and the third rotor once the first moved 26*26 steps (one can easily understand where this is going).Since the rotors could move during the encryption process the key to deciphering the text was the "key" or the initial state of the rotors. The code was finally broken by a team of cryptographers at Bletchley Park led by Alan Turing. Some believe this caused the war to shorten by a few years. A movie titled "The Imitation Game" was released in 2014 highlighting this code breaking feat. ClearAll@rotateWheel; SetAttributes[rotateWheel, HoldFirst]; rotateWheel[wheel_] := Block[{}, wheel = RotateLeft[wheel]]; The immediate block of code above enables me to make in-place modification i.e. to rotate and preserve the state of the rotors. EnigmaEncryption[string_, staterot1_, staterot2_, staterot3_] := Module[{count = 0, RotorIn, leftRotor, middleRotor, rightRotor, reflector, reflectorOutput, rotateMiddleCheck, rotateRightCheck, inputToNext, reverseOutput}, RotorIn = ToLowerCase@CharacterRange["A", "Z"]; {leftRotor, middleRotor, rightRotor} = MapThread[Function[{x, y}, (z \[Function] RotateLeft[z, First@Position[z, ToLowerCase@y] - 1])@ Characters@ToLowerCase[x]], {{"BDFHJLCPRTXVZNYEIWGAKMUSQO", "AJDKSIRUXBLHWTMCQGZNPYFVOE", "EKMFLGDQVZNTOWYHXUSPAIBRCJ"}, {staterot1, staterot2, staterot3}}]; reflector = Characters@ToLowerCase@"YRUHQSLDPXNGOKMIEBFZCWVJAT"; inputToNext[rotor_, input_] := First@Cases[Thread[{RotorIn, rotor}], {input, map_} :> map ]; reverseOutput[rotor_, input_] := First@Cases[Thread[{RotorIn, rotor}], {map_, input} :> map ]; rotateMiddleCheck := If[count~Mod~26 == 0, rotateWheel@middleRotor, middleRotor]; rotateRightCheck := If[count~Mod~676 == 0, rotateWheel@rightRotor, rightRotor]; StringJoin@Table[ If[FreeQ[input, Alternatives[" ", ",", "'", "?" ]], count += 1; reflectorOutput = Fold[inputToNext[#2, #1] &, input, {rotateWheel@leftRotor, rotateMiddleCheck, rotateRightCheck, reflector}]; Fold[reverseOutput[#2, #1] &, reflectorOutput, {rightRotor, middleRotor, leftRotor}], input] , {input, Characters@ToLowerCase@string}] ] Now lets assume that the Germans encrypt a message with state "A", "A","A" for the three moving rotors: Style[text = EnigmaEncryption["this is the SS, Identify yourself, are you a German or are you Alan Turing?", "A", "A", "A"], {Bold, FontSize -> 24}] uubf jw dif oo, jctjgmbn nbtqrang, pvs vsh o orgiya lq lyw svn ssui zcxuxs?If the cryptographers at Bletchley have the incorrect key "B","A","E" they will not be able to decipher the text (it will be gibberish). Style[EnigmaEncryption[text, "B", "A", "E"], {Bold, FontSize -> 24}] pgyy yd gnu nw, etlisxnw fnkniizh, tgy wde u gqkabx ma foe alc aifb cmavmt?However, with the right key: Style[EnigmaEncryption[text, "A", "A", "A"], {Bold, FontSize -> 24}] this is the ss, identify yourself, are you a german or are you alan turing?We can make a small animation of the rotor states. For visual purposes, blue represents the forward states of the system and red the backward state.the code below can be used to generate the animation sequence: list = (Rasterize@*Grid /@ Module[{out, states, mergedstates, rotorstates, riffle, first, last, text = text, textout = StringReplace[text[[1]], Alternatives[" ", ",", "'", "?"] :> ""]}, out = Characters@textout; states = Partition[text[[2, 1]], 7]; mergedstates = Table[Join[states[[i]], {out[[i]]}], {i, Length@states}]; rotorstates = text[[2, 2]]; riffle = MapAt[Reverse, (Partition[#, 4] & /@ mergedstates), {All, 2}]; riffle = Apply[Composition[Partition[#, 2] &, Riffle], riffle, {1}]; Do[{first, last} = Flatten@Position[rotorstates[[j, i]], #] & /@ riffle[[j, i]]; rotorstates[[j, i, first]] = Style[First@rotorstates[[j, i, first]], {Blue, Bold, Background -> LightBlue}]; rotorstates[[j, i, last]] = Style[First@rotorstates[[j, i, last]], {Red, Bold, Background -> LightRed}]; , {j, Length@riffle}, {i, 4}]; rotorstates ]); 
1 year ago
6 Replies
 Henrik Schachner 2 Votes Hi Ali,very nice, thanks for sharing! But I must say that the germans never ever would have encrypted some english text ...Anyway, your nice code and the fact that you are using just 3 rotors (i.e. there are only 17576 keys) gives me the chance of testing an old idea: An incredibly simple and direct brute force attack - just try all keys and look for english text as outcome, you do not even have to care about the correct key! I guess Alan Turing could not even have dreamed of such an insane approach! encText = "uubf jw dif oo, jctjgmbn nbtqrang, pvs vsh o orgiya lq lyw svn ssui zcxuxs?"; allKeys = Tuples[CharacterRange["A", "Z"], 3]; allEncodings = ParallelMap[EnigmaEncryption[encText, Sequence @@ #] &, allKeys]; bruteForce = ParallelMap[{#, LanguageIdentify[#]} &, allEncodings]; englishText = Select[bruteForce, Last[#] == Entity["Language", "English"] &]; This should work - but it does not work! I was prepared for some false positive findings (therefore I did not use a While construct), but not for so many (>9%)! Can anybody comment why LanguageIdentify is working so badly?!Best regards -- Henrik
1 year ago
 Thanks a lot Henrik. What you are proposing is quite interesting. let me look at your code !
1 year ago
 Sander Huisman 2 Votes The problem is that LanguageIdentify, is a simple classifier that always gives an answer. It is the same as: Classify["Language"] What you can do: use the underlying classifier and ask for probabilities: Classify["Language"]["abcdefghijklmnopqrstuvwxyz", "TopProbabilities" -> 1] and then only accept if the probability is above a high percentage (e.g. 95%). Else, unidentified.