In the fourth session (“Classical Ciphers”) of “Daily Study Group: Introduction to Cryptography“ (https://www.bigmarker.com/series/daily-study-group-intro-to-cryptography/series_details ), the following Caesar (shift) cipher was given as a quiz/assignment
YHQL YLGL YLFL
Julius Caesar
I posted some thoughts about this in the Study Group’s Community thread ( https://community.wolfram.com/groups/-/m/t/2464878 ). Since it might be of some interest for others as well, I’ll create a proper post as well. I also added a simple brute force approach (in “Addendum” below).
YHQL YLGL YLFL
Julius Caesar
I posted some thoughts about this in the Study Group’s Community thread ( https://community.wolfram.com/groups/-/m/t/2464878 ). Since it might be of some interest for others as well, I’ll create a proper post as well. I also added a simple brute force approach (in “Addendum” below).
First thought
First thought
It helped to notice that it was three words of four characters that start with the same character (and a lot of “L”) . It cannot be “alea iacta est” or “aut Caesar aut nihil” for that reason .
Though I did a brute force to confirm it.
Though I did a brute force to confirm it.
First analysis
First analysis
Here is my (first) more "formal" analysis of this, assuming that the first word should be in Mathematica' s Latin wordlist . This mean that we don’t have to manually seek for the correct solution.
In[]:=
text="yhql ylgl ylfl";alpha=Alphabet[];latinWords=WordList["KnownWords",Language->"Latin"];candidates={StringReplace[text,Thread[Rule[alpha,RotateLeft[alpha,#]]]]}&/@Range[26]MemberQ[latinWords,StringSplit[#][[1,1]]]&/@candidatesPick[candidates,%]
Out[]=
{{zirm zmhm zmgm},{ajsn anin anhn},{bkto bojo boio},{clup cpkp cpjp},{dmvq dqlq dqkq},{enwr ermr erlr},{foxs fsns fsms},{gpyt gtot gtnt},{hqzu hupu huou},{irav ivqv ivpv},{jsbw jwrw jwqw},{ktcx kxsx kxrx},{ludy lyty lysy},{mvez mzuz mztz},{nwfa nava naua},{oxgb obwb obvb},{pyhc pcxc pcwc},{qzid qdyd qdxd},{raje reze reye},{sbkf sfaf sfzf},{tclg tgbg tgag},{udmh uhch uhbh},{veni vidi vici},{wfoj wjej wjdj},{xgpk xkfk xkek},{yhql ylgl ylfl}}
Out[]=
{False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,True,False,False,False}
Out[]=
{{veni vidi vici}}
Second analysis
Second analysis
Here is another take on this, though it might be overkill for this problem. But let' s say that - for some reason - we don' t want to test all the possible Caesar shifts, for example if they are too costly
Then we can use the observation that the letter "l" is more frequent than the other.
Then we can use the observation that the letter "l" is more frequent than the other.
In[]:=
text="yhql ylgl ylfl";CharacterCounts[text]
Out[]=
l5,y3, 2,f1,g1,q1,h1
What will be the first substitute to test, i . e . what is the commonest character in Latin?
Unfortunately, there is no letter frequency for Latin in WL.
Unfortunately, there is no letter frequency for Latin in WL.
In[]:=
LanguageData["Latin","LetterFrequency"]
Out[]=
Missing[NotAvailable]
So we have to roll our own, which shows that the character “i” is the most common character in Latin.
In[]:=
latinWords=WordList["KnownWords",Language->"Latin"];CharacterCounts[StringJoin[latinWords]]
Out[]=
i6307,e6008,s5359,a5324,u5276,o5189,r5013,t4035,n3395,c3240,l2763,m2490,p2220,d1609,b1004,g946,f896,v869,h469,x409,q363,y97,æ94,j51,C38,A34,H19,M16,z13,I12,T11,P11,B10,S9,R8,L8,V6,G6,*5,O4,F4,N3,E3,D3,k3,Æ3,Z2,-2,U1,-1,Q1
Let' s now use this knowledge to first test the shift that replaces an "i" with "l" :
In[]:=
alpha=Alphabet[];shift=LetterNumber["i"]-LetterNumber["l"]keytable=Thread[Rule[alpha,RotateLeft[alpha,shift]]]StringReplace["yhql ylgl ylfl",keytable]
Out[]=
-3
Out[]=
{ax,by,cz,da,eb,fc,gd,he,if,jg,kh,li,mj,nk,ol,pm,qn,ro,sp,tq,ur,vs,wt,xu,yv,zw}
Out[]=
veni vidi vici
Which happens to be the correct shift and solves the problem.
Note : The shift found is - 3 which is the same as shift 23 (26 + -3 = 23) .
Note : The shift found is - 3 which is the same as shift 23 (26 + -3 = 23) .
Addendum
Addendum
Just to be a little more complete about this, here’s a brute force variant.
In[]:=
text="yhql ylgl ylfl";alpha=Alphabet[];Table[{shift,StringReplace[text,Thread[Rule[alpha,RotateLeft[alpha,shift]]]]},{shift,0,25}]//TableForm
Out[]//TableForm=
0 | yhql ylgl ylfl |
1 | zirm zmhm zmgm |
2 | ajsn anin anhn |
3 | bkto bojo boio |
4 | clup cpkp cpjp |
5 | dmvq dqlq dqkq |
6 | enwr ermr erlr |
7 | foxs fsns fsms |
8 | gpyt gtot gtnt |
9 | hqzu hupu huou |
10 | irav ivqv ivpv |
11 | jsbw jwrw jwqw |
12 | ktcx kxsx kxrx |
13 | ludy lyty lysy |
14 | mvez mzuz mztz |
15 | nwfa nava naua |
16 | oxgb obwb obvb |
17 | pyhc pcxc pcwc |
18 | qzid qdyd qdxd |
19 | raje reze reye |
20 | sbkf sfaf sfzf |
21 | tclg tgbg tgag |
22 | udmh uhch uhbh |
23 | veni vidi vici |
24 | wfoj wjej wjdj |
25 | xgpk xkfk xkek |