Introduction

I attended Wolfram High School Summer Camp (then called, Mathematica Summer Camp) after my high school junior year, and learned the Wolfram Language as my first programming language. As I began my second semester in college, I decided that I want to pick up writing code in Mathematica again as it uses quite a fascinating language and allows users to create sophisticated projects with relatively succint code. Out of the Wolfram Mentorships Program sample open projects, I found "Implement Historical Cryptosystems" the most intriguing as I knew very little about cryptography and wished to learn more about it. For this project, I implemented some simple cryptosystems, such as the Caesar Cipher and the Jefferson Cipher. Generally, I implemented each cipher as one function, consisting of the encryption and the decryption parts. The arguments typically are a message, a key, and a method("Encrypt" or "Decrypt"), and the output is typically the encrypted or decrypted message.

Caesar Cipher

CaesarCipher[message_String,key_Integer,method_]:=
With[{res=iCaesarCipher[message,key,method]},res/;res=!=$Failed]

iCaesarCipher[message_,key_,method_]:=Which[
method==="Encrypt",
CaesarCipherEncrypt[message,key] ,
method==="Decrypt",
CaesarCipherDecrypt[message,key],
True,Message[CaesarCipher::wrongMethodInput,method];$Failed]

CaesarCipher::wrongMethodInput = 
"The argument `1` is not a valid method input, please use 'Encrypt' or 'Decrypt'.";e here

The Caesar Cipher cryptosystem encryption works by shifting each letter in a message by a certain number, which is the key, and the decryption shifts each letter in the encoded message in the opposite direction by the same number. I implemented the Caesar Cipher so that when encrypting, the letters in the message shift to the right, and vice versa for "Decrypt". This way, there is only one key, the number of shifts, as opposed to two keys including the direction of shifts, so that it is as straightforward as possible. Thus, both the encryption and decryption use the same shiftCharacters function (shown below), the only differences being that CaesarCipherEncrypt passes the original message and a positive key to shiftCharacters, whereas CaesarCipherDecrypt passes the encrypted message and the same key with a negative sign.

shiftCharacters[message_List,key_Integer,alphabet_List]:=
alphabet[[#]]&/@(Mod[Flatten[Position[alphabet,#]&/@message]+key,52,1])

CaesarCipherEncrypt[message_String,key_Integer]:=
StringJoin[shiftCharacters[
Characters[message],key,Join[Alphabet[],Characters[ToUpperCase[StringJoin[Alphabet[]]]]]
]]
CaesarCipherDecrypt[message_String,key_Integer]:=
StringJoin[shiftCharacters[
Characters[message],-key,Join[Alphabet[],Characters[ToUpperCase[StringJoin[Alphabet[]]]]]
]]

For example, if the user were to encrypt the message "attackatdawn" with the key specified to 5, the output would be an encoded message, each letter of which is the corresponding letter in "attackatdawn" shifted to the right by 5.

CaesarCipher["attackatdawn",5,"Encrypt"]
"fyyfhpfyifBs"

Notice that the letter "w" gets encrypted to "B". This is because I added the uppercase alphabet to the lowercase alphabet. To decrypt, the user simply call CaesarCipher with the encrypted message, the same key, and the method "Decrypt".

CaesarCipher["fyyfhpfyifBs",5,"Decrypt"]
"attackatdawn"

Jefferson Cipher

The Jefferson Cipher uses a set of 36 disks, where each disk represents a complete alphabet. The alphabets on the disks are of random orders. I implemented the disks as lists, where each list consists of the 26 lowercase letters in a random order. Below is a random set of disks.

{{"l","g","u","y","z","e","v","a","n","d","r","f","p","j","t","x","m","o","q","k","h","i","w","b","s","c"},
{"h","x","d","i","g","j","m","y","t","c","e","w","z","u","v","f","q","r","p","k","b","n","l","a","o","s"},
{"o","n","a","c","h","m","g","w","q","x","e","u","z","d","t","k","i","p","f","l","j","v","y","b","r","s"},
{"e","o","g","j","h","w","z","t","r","a","d","c","s","l","q","v","p","b","n","i","x","m","f","k","y","u"},
{"d","e","u","z","q","a","p","y","x","w","k","j","c","h","b","m","f","v","i","g","n","o","r","s","t","l"},
{"y","k","l","o","c","j","a","q","x","r","t","n","v","h","u","f","d","e","s","g","w","b","i","p","m","z"},
{"d","t","l","j","p","m","e","s","o","g","b","c","w","k","a","y","n","q","f","r","x","i","z","v","h","u"},
{"s","k","a","v","q","p","g","m","e","j","z","u","r","i","w","l","d","n","f","x","h","b","y","o","c","t"},
{"q","p","m","g","z","o","d","n","k","t","a","r","u","v","e","c","s","i","l","b","y","w","f","j","x","h"},
{"s","i","n","k","d","y","o","u","z","q","x","j","t","f","m","c","h","b","r","p","v","g","w","a","l","e"},
{"w","p","s","q","i","j","z","t","g","r","x","f","d","b","u","k","n","c","y","o","h","e","l","a","m","v"},
{"a","j","h","r","f","l","p","b","y","k","s","w","o","x","z","e","g","c","n","t","m","u","d","i","v","q"},
{"w","y","b","q","i","e","n","l","j","k","g","s","p","f","d","o","a","u","m","z","r","x","c","h","t","v"},
{"y","i","z","g","n","o","h","b","v","a","t","j","m","p","r","x","d","f","q","w","e","u","k","l","s","c"},
{"l","f","n","r","b","z","c","t","g","j","p","w","a","m","y","e","x","v","i","o","d","h","k","s","q","u"},
{"t","d","h","x","l","k","n","i","w","v","s","o","r","q","u","m","j","b","a","e","z","y","g","c","p","f"},
{"j","q","l","x","i","n","c","k","r","f","h","s","m","e","o","g","t","z","b","y","p","w","d","u","v","a"},
{"q","z","s","w","d","x","b","l","n","u","v","g","h","m","t","j","r","c","y","e","p","f","i","a","o","k"},
{"i","b","o","f","r","s","u","n","z","h","c","x","w","g","q","j","m","l","d","a","k","p","v","t","y","e"},
{"g","n","d","c","l","y","o","w","k","u","m","r","f","s","e","x","j","h","i","a","v","t","b","p","z","q"},
{"c","l","d","q","p","z","m","e","j","x","r","f","w","a","i","h","o","v","s","t","n","g","y","b","u","k"},
{"w","c","y","x","h","o","p","q","d","z","k","b","m","r","n","e","v","l","u","t","g","s","i","a","f","j"},
{"m","i","t","c","o","b","j","r","y","x","h","e","w","u","q","p","v","f","d","s","n","l","a","z","g","k"},
{"z","m","q","c","f","i","x","s","d","e","v","a","y","o","j","l","h","n","b","g","p","t","r","k","w","u"},
{"d","o","x","n","l","r","s","g","b","e","c","m","w","f","i","z","h","k","t","y","u","q","v","j","p","a"},
{"f","k","e","d","v","j","b","q","w","a","g","r","u","m","z","h","s","l","x","i","t","p","n","c","y","o"},
{"m","t","z","y","w","k","c","d","r","n","u","j","f","s","e","a","p","x","g","o","q","b","i","h","l","v"},
{"z","s","m","d","p","h","n","g","k","i","e","j","t","q","f","o","a","v","l","y","u","w","b","c","x","r"},
{"t","g","l","z","i","e","k","r","q","p","x","d","s","u","y","m","c","a","b","j","o","h","n","w","f","v"},
{"t","g","x","q","f","v","n","h","k","l","z","e","w","b","a","o","m","d","u","j","y","p","i","c","r","s"},
{"f","a","r","i","z","d","e","j","b","x","p","v","s","n","g","k","w","h","u","t","q","o","c","m","y","l"},
{"u","k","q","n","v","z","g","y","p","s","f","l","x","m","r","t","i","o","e","w","c","j","d","b","a","h"},
{"p","u","d","x","n","h","k","g","r","o","e","b","t","f","s","m","i","v","j","q","y","z","a","w","c","l"},
{"r","w","z","f","a","i","c","p","e","m","t","b","j","x","y","o","v","g","s","l","h","u","k","n","d","q"},
{"t","h","s","l","a","k","p","u","n","j","e","d","q","m","o","b","x","c","g","i","z","f","v","w","r","y"},
{"h","q","k","n","f","m","x","w","g","d","b","v","i","r","t","j","z","o","p","l","a","s","u","c","y","e"}}

The key of this cipher in this case is a list of used disks in a user-defined order. Notice that using the set of disks above, column 3 at row 19, 20, and 21 happens to be the word "odd". If a secret message says "odd", the user must find the 3 disks where "o", "d", and "d" align, and roll the 3 disks until a message that makes sense appears. Since I couldn't find a good way to write code that tells if a word makes sense to decrypt a message, my mentor and I have come up with idea to simply shift the letters in a message to the right on the corresponding disks by one letter when encrypting, and vice versa when decrypting.

JeffersonCipher["odd",{19,20,21},"Encrypt"]
"fcq"
JeffersonCipher["fcq",{1,2,3},"Decrypt"]
"odd"

The encryption and decryption functions of Jefferson Cipher both finds the indices of the letters in the input message first using the FindIndex function, then shift to the right or left to find the indeces of letters that comprise the encrypted or decrypted word.

FindIndex[message_String,orderKey_List]:=
Flatten[Table[Position[
JeffersonDisks[[orderKey[[i]]]],Characters[message][[i]]],{i,1,StringLength[message]}],2]

EncryptFindIndex[message_String,orderKey_List]:=
If[#==0,26,#]&/@(Mod[#,26]&/@(Plus[#,1]&/@FindIndex[message,orderKey]))

DecryptFindIndex[message_String,orderKey_List]:=
If[#==0,26,#]&/@(Mod[#,26]&/@(Subtract[#,1]&/@FindIndex[message,orderKey]))

Finally, the encryption and decryption functions find the letters at the index found and return the encrypted or decrypted message.

FindElement[A_List,a_Integer]:=A[[a]]

JeffersonEncrypt[message_String,orderKey_List]:=
StringJoin[MapThread[FindElement,{JeffersonDisks[[orderKey]],EncryptFindIndex[message,orderKey]}]]

JeffersonDecrypt[message_String,orderKey_List]:=
StringJoin[MapThread[FindElement,{JeffersonDisks[[orderKey]],DecryptFindIndex[message,orderKey]}]]

JeffersonCipher[message_,orderKey_,method_]:=
Which[method=="Encrypt",
JeffersonEncrypt[message,orderKey],
method=="Decrypt",
JeffersonDecrypt[message,orderKey],
method!= "Encrypt"&&method!= "Decrypt",
Message[JeffersonCipher::wrongMethodInput,method]]

JeffersonCipher::wrongMethodInput=
"The argument `1` is not a valid method input, please use 'Encrypt' or 'Decrypt'"

Vigenère Cipher

vigenereCipher[message_String,keyword_String,method_String]:=
Which[method=="Encrypt",vigenereEncrypt[message,keyword],
method=="Decrypt",vigenereDecrypt[message,keyword],
method!="Encrypt"&&method!="Decrypt",
Message[vigenereCipher::wrongMethodInput,method]]

vigenereCipher::wrongMethodInput=
"argument `1` is not a valid method input, please use 'Encrypt' or 'Decrypt'"

The key in Vigenère cipher is a word. The key repeats itself until it has the same length as the message. For example, when a user inputs the message "attackatdawn" and the keyword "lemon", "lemon" becomes "lemonlemonle" to match the length of the message.

generateKey[keyword_String,length_Integer]:=
Characters[keyword][[#]]&/@Mod[Table[i,{i,length}],StringLength[keyword],1]

This way, each letter in the message has a corresponding letter in the key, and the order of the letter in the key in the alphabet determines the offset of encrypted string.

findOffset[letter_String]:=
Extract[Table[i,{i,26}],
Flatten[
Position[Alphabet[],letter],1]]-Extract[Table[i,{i,26}],Flatten[Position[Alphabet[],"a"],1]]

findIndex[letter_String]:=Extract[Table[i,{i,26}],Flatten[Position[Alphabet[],letter],1]]

findEncryptedLetter[letter1_String,letter2_String]:=
Alphabet[][[Mod[findIndex[letter1]+findOffset[letter2],26,1]]]

vigenereEncrypt[message_String,keyword_String]:=
StringJoin[MapThread[
findEncryptedLetter,{Characters[message],generateKey[keyword,StringLength[message]]}]]

Similarly, the decryption function works backwards to find the original message.

findDecryptedLetter[letter1_String,letter2_String]:=
Alphabet[][[Mod[findIndex[letter1]-findOffset[letter2],26,1]]]

vigenereDecrypt[message_String,keyword_String]:=
StringJoin[MapThread[
findDecryptedLetter,{Characters[message],generateKey[keyword,StringLength[message]]}]]

Take the message "attackatdawn" and the keyword "lemon" for example,

vigenereCipher["attackatdawn","lemon","Encrypt"]
"lxfopvefrnhr"

"l" is the 12th letter in the alphabet, and thus the first letter of the encrypted message is "a" with an offset of 12, which is "l"; "e" is the 5th letter in the alphabet, and thus the second letter of the encrypted message is "t" shifted to the right by 5, which is "x", so on and so forth. The decryption works backwards.

vigenereCipher["lxfopvefrnhr","lemon","Decrypt"]
"attackatdawn"

Atbash Cipher

The key in Atbash Cipher doesn't have to be specified by the user, because the rule is that the 1st letter in the alphabet translates to the last letter in the alphabet, the 2nd translates to the 2nd to last, and so on and so forth. Therefore, Atbash encryption and decryption work the same way, and encrypting and decrypting a string would return the same results.

findCorrespondingLetter[letter_String]:=
Alphabet[][[#]]&/@MapThread[
Subtract,{{26},MapThread[Subtract,{Flatten[Position[Alphabet[],letter]],{1}}]}]

atbash[message_String]:=StringJoin[Flatten[Map[findCorrespondingLetter,Characters[message]]]]

atbashCipher[message_String,method_String]:=
If[method=="Encrypt"||method=="Decrypt",atbash[message],
Message[atbashCipher::wrongMethodInput,method]]

atbashCipher::wrongMethodInput=
"argument `1` is not a valid method input, please use 'Encrypt' or 'Decrypt'"

There are words where their encryption is their reverse, such as the word "wizard".

atbashCipher["wizard","Encrypt"]
"draziw"
atbashCipher["wizard","Decrypt"]
"draziw"

Challenges I faced

The program was most challenging at the beginning since I had almost forgotten how to write code in Mathematica, and I have always been a slow programming learner on my own. After I familiarized myself with the language, the biggest challenge I faced was with the Jefferson Cipher, where I wished to implement the cipher as how it should be, roll the disks until a word or message that makes sense appears. Although in the end, I chose to go with changing the rules up a little bit, I still wish I could find some ways to implement Jefferson Cipher according to its own rules. However, my programming skills have improved during the course of the mentorships program and I'd definitely continue working on coding in Mathematica.

Conclusion

For the project "Implement Historical Cryptosystems", I implemented 4 ciphers, the Caesar Cipher, the Jefferson Cipher, the Vigenère Cipher, and the Atbash Cipher. I spent a lot of time at first picking up the language, but more cryptosystems could be implemented in the future, such as LFSR, R30, and the Enigma, which are all very sophisticated and may require animation or cellular automation to demonstrate. I'd like to thank my mentors, Alison Kimball and Todd Rowland, for giving me the chance to participate in the program and assisting me through the process. I have enjoyed improving my Wolfram Language coding skills and learning about cryptography.