Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

How can Caesar cipher be implemented? I want to use StringReplace but I don't know how to write the replacement rule to replace the characters with, say, the character two positions down in the alphabet.

share|improve this question

3 Answers 3

up vote 5 down vote accepted
rule[n_] := With[{a = CharacterRange["a", "z"]}, Thread[a -> RotateLeft[a,n]]]

res = StringJoin[StringSplit["hello", ""] /. rule[2]]

"jgnnq"

StringJoin[StringSplit[res, ""] /. Reverse /@ rule[2]]

"hello"

Or to follow the example in the Wikipedia page:

StringJoin[StringSplit[CharacterRange["a", "z"], ""] /. rule[-3]]

"xyzabcdefghijklmnopqrstuvw"

share|improve this answer
    
Rule @@@ Thread[{a, RotateLeft[a, n]}] is simpler as Thread[a -> RotateLeft[a,n]] –  Szabolcs Jul 19 at 16:18
    
@Szabolcs Indeed thank you :) –  Öskå Jul 19 at 16:20

This answer is just a complement to Öskå's, showing off the new operator forms introduced in v10. For compatibility with earlier versions, see his answer.

az = CharacterRange["a", "z"];

Notice the use of ReplaceAll with a single argument to construct a replacing operator:

encode = ReplaceAll@Dispatch@Thread[az -> RotateLeft[az, 13]];

StringJoin@encode@Characters["secret message"]
(* "frperg zrffntr" *)

StringJoin@encode@Characters[%]
(* "secret message" *)
share|improve this answer
    
Alas it doesn't work for me on v8 :( –  Öskå Jul 19 at 16:16
    
@Öskå yes, it needs v10. –  Szabolcs Jul 19 at 16:17
1  
Nice use of new operator form of ReplaceAll +1 –  Murta Jul 19 at 16:21
1  
Better still, encode = ReplaceAll@AssociationThread[az, RotateLeft[az, 13]] –  RunnyKine Jul 20 at 5:56

The simplest way to express the transformation rules for StringReplace would be to write them explicitly (here using the traditional Caesar Cipher three-character shift):

StringReplace["THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG"
, { "A"->"X","B"->"Y","C"->"Z","D"->"A","E"->"B"
  , "F"->"C","G"->"D","H"->"E","I"->"F","J"->"G"
  , "K"->"H","L"->"I","M"->"J","N"->"K","O"->"L"
  , "P"->"M","Q"->"N","R"->"O","S"->"P","T"->"Q"
  , "U"->"R","V"->"S","W"->"T","X"->"U","Y"->"V"
  , "Z"->"W"
  }
]

(* QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD *)

To avoid the tedium of writing such rules, we could create them programatically from paired substitutions:

$encipher =
  Rule ~MapThread~ Characters @ {"ABCDEFGHIJKLMNOPQRSTUVWXYZ", "XYZABCDEFGHIJKLMNOPQRSTUVW"}

(* 
{A->X,B->Y,C->Z,D->A,E->B,F->C,G->D,H->E,I->F,J->G,K->H,L->I,M->J,
 N->K,O->L,P->M,Q->N,R->O,S->P,T->Q,U->R,V->S,W->T,X->U,Y->V,Z->W}
*)

StringReplace["THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG", $encipher]

(* QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD *)

The reverse transformation is then easily computed:

$decipher = Reverse /@ $encipher;

StringReplace["QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD", $decipher]

(* THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG *)

This scheme is simple, and supports arbitrary substitutions beyond simple shifts. But since a Caesar Cipher is a simple shift, we could define the transformation algorithmically instead:

StringReplace["THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG"
, c_ /; OrderedQ[{"A", c, "Z"}] :>
    FromCharacterCode[Mod[ToCharacterCode@c - 65 - 3, 26] + 65]
]

(* QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD *)

This subtracts three from the character code of each letter, wrapping around A back to Z. The condition /; OrderedQ[...] ensures that only the letters are affected. Spaces are unchanged, as are all other characters that are not Latin letters (we can quibble about whether Caesar knew about J or U on another StackExchange site :).

We could express the shift in a helper function, adding support for both encryption and decryption along the way:

$a = ToCharacterCode @ "A";

shift[n_, c_] /; OrderedQ[{"A", c, "Z"}] :=
  FromCharacterCode[Mod[ToCharacterCode@c - $a + n, 26] + $a]

shift[_, c_] := c

Again, only the letters from A to Z are changed and other characters are left untouched:

shift[-3, "A"]
(* X *)

shift[3, "X"]
(* A *)

shift[3, "!"]
(* ! *)

The StringReplace expression becomes very simple when using shift:

StringReplace["HI GLENN STOP GOT GOOD STUFF FOR YOU STOP SIGNED ED", c_ :> shift[-3, c]]

(* EF DIBKK PQLM DLQ DLLA PQRCC CLO VLR PQLM PFDKBA BA *)

The function supports deciphering by specifying an opposite shift:

StringReplace["EF DIBKK PQLM DLQ DLLA PQRCC CLO VLR PQLM PFDKBA BA", c_ :> shift[3, c]]

(* HI GLENN STOP GOT GOOD STUFF FOR YOU STOP SIGNED ED *)
share|improve this answer
    
Nice to see that you respect the UPPERCASE and the 3 - +1 despite the J, U and W :) –  eldo Jul 19 at 22:31

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.