I have a subscription for Brilliant. And recently received a Caesar Cypher exercise to solve in Python. You can find this problem at Brilliant exercise.
I'm learning Wolfram Language now and so I wanted to try to solve this problem in it.
Executable solution on Wolfram Cloud:
Caesar Cypher Problem
Here is a mysterious message:
J MPWF QZUIPO
Can you decode it? What does it say?
Let's normalize the message
In[360]:= encryptedMessage = ToLowerCase["J MPWF QZUIPO"]
Out[360]= j mpwf qzuipo
Let's define a functions that is going to perform movement of letters at an offset.
In[362]:= numberdLetters = Transpose[{Table[x, {x, Length[Alphabet[]]}], Alphabet[]}]
Out[362]= {{1,a},{2,b},{3,c},{4,d},{5,e},{6,f},{7,g},{8,h},{9,i},{10,j},{11,k},{12,l},{13,m},{14,n},{15,o},{16,p},{17,q},{18,r},{19,s},{20,t},{21,u},{22,v},{23,w},{24,x},{25,y},{26,z}}
In[364]:= moveLetter[letter_, offset_] :=numberdLetters[[
If[# == 0, 1, #]& @ Mod[
If[First[Select[numberdLetters, #[[2]] == letter&]][[1]]+offset == 0, 1, First[Select[numberdLetters, #[[2]] == letter&]][[1]]+offset],
Length[Alphabet[]]]]];
Let's test that our function is working as expected
In[367]:= VerificationTest[moveLetter["a",3], {4, "d"}]
Out[367]= TestResultObject[Outcome: Success
Test ID: None
]
In[368]:= VerificationTest[moveLetter["z", 1], {1, "a"}]
Out[368]= TestResultObject[Outcome: Success
Test ID: None
]
Let's try moving all the letters of a string.
In[369]:= Map[If[LetterQ[#],moveLeft[#, 3], #]&, Characters["j mpwf qzuipo"]]
Out[369]= {{13,m}, ,{16,p},{19,s},{1,a},{9,i}, ,{20,t},{3,c},{24,x},{12,l},{19,s},{18,r}}
Now, let's move the letters in our string for all the possible offsets. We select second element because we no longer need the offset stored right next to the letter.
In[375]:= possiblMessagesRaw = Table[Map[If[LetterQ[#],moveLetter[#, offset][[2]], #]&, Characters["j mpwf qzuipo"]], {offset, Length[Alphabet[]]}]
Out[375]= {{k, ,n,q,x,g, ,r,a,v,j,q,p},{l, ,o,r,y,h, ,s,b,w,k,r,q},{m, ,p,s,a,i, ,t,c,x,l,s,r},{n, ,q,t,a,j, ,u,d,y,m,t,s},{o, ,r,u,b,k, ,v,e,a,n,u,t},{p, ,s,v,c,l, ,w,f,a,o,v,u},{q, ,t,w,d,m, ,x,g,b,p,w,v},{r, ,u,x,e,n, ,y,h,c,q,x,w},{s, ,v,y,f,o, ,a,i,d,r,y,x},{t, ,w,a,g,p, ,a,j,e,s,a,y},{u, ,x,a,h,q, ,b,k,f,t,a,a},{v, ,y,b,i,r, ,c,l,g,u,b,a},{w, ,a,c,j,s, ,d,m,h,v,c,b},{x, ,a,d,k,t, ,e,n,i,w,d,c},{y, ,b,e,l,u, ,f,o,j,x,e,d},{a, ,c,f,m,v, ,g,p,k,y,f,e},{a, ,d,g,n,w, ,h,q,l,a,g,f},{b, ,e,h,o,x, ,i,r,m,a,h,g},{c, ,f,i,p,y, ,j,s,n,b,i,h},{d, ,g,j,q,a, ,k,t,o,c,j,i},{e, ,h,k,r,a, ,l,u,p,d,k,j},{f, ,i,l,s,b, ,m,v,q,e,l,k},{g, ,j,m,t,c, ,n,w,r,f,m,l},{h, ,k,n,u,d, ,o,x,s,g,n,m},{i, ,l,o,v,e, ,p,y,t,h,o,n},{j, ,m,p,w,f, ,q,a,u,i,p,o}}
Let's clean the output.
In[374]:= possiblMessagesClean = Map[StringJoin[#]&, possiblMessagesRaw]
Out[374]= {k nqxg ravjqp,l oryh sbwkrq,m psai tcxlsr,n qtaj udymts,o rubk veanut,p svcl wfaovu,q twdm xgbpwv,r uxen yhcqxw,s vyfo aidryx,t wagp ajesay,u xahq bkftaa,v ybir clguba,w acjs dmhvcb,x adkt eniwdc,y belu fojxed,a cfmv gpkyfe,a dgnw hqlagf,b ehox irmahg,c fipy jsnbih,d gjqa ktocji,e hkra lupdkj,f ilsb mvqelk,g jmtc nwrfml,h knud oxsgnm,i love python,j mpwf qauipo}
Now, we can already spot the most likely message, but for fun lets find it programmatically.
Let's check if all the words in the string exist in English Language dictionary.
In[377]:= decrypted = Map[{AllTrue[Map[DictionaryWordQ[#,Language->"English"]&, TextWords[#]], TrueQ], #}&, possiblMessagesClean]
Out[377]= {{False,k nqxg ravjqp},{False,l oryh sbwkrq},{False,m psai tcxlsr},{False,n qtaj udymts},{False,o rubk veanut},{False,p svcl wfaovu},{False,q twdm xgbpwv},{False,r uxen yhcqxw},{False,s vyfo aidryx},{False,t wagp ajesay},{False,u xahq bkftaa},{False,v ybir clguba},{False,w acjs dmhvcb},{False,x adkt eniwdc},{False,y belu fojxed},{False,a cfmv gpkyfe},{False,a dgnw hqlagf},{False,b ehox irmahg},{False,c fipy jsnbih},{False,d gjqa ktocji},{False,e hkra lupdkj},{False,f ilsb mvqelk},{False,g jmtc nwrfml},{False,h knud oxsgnm},{True,i love python},{False,j mpwf qauipo}}
Let's select all decrypted messages whose words are valid English dictionary words.
In[378]:= Select[decrypted, First[#]&]
Out[378]= {{True,i love python}}
Top comments (0)