Message Boards Message Boards

The Enigma Machine

GROUPS:

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.

enter image description here

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
     ]);
POSTED BY: Ali Hashmi
Answer
8 months ago

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

POSTED BY: Henrik Schachner
Answer
8 months ago

Thanks a lot Henrik. What you are proposing is quite interesting. let me look at your code !

POSTED BY: Ali Hashmi
Answer
8 months ago

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.

POSTED BY: Sander Huisman
Answer
8 months ago

Hi Sander,

sounds very promising - great! I will try. Thank you very much and best regards -- Henrik

POSTED BY: Henrik Schachner
Answer
8 months ago

On the Enigma machine: Charles Stevens made the attached cdf. Its outstanding.Taken from this discussion

POSTED BY: Hans Milton
Answer
8 months ago

Thanks Hans for pointing it out. Indeed that is a lot of work put in by the author !

POSTED BY: Ali Hashmi
Answer
8 months ago

Group Abstract Group Abstract