{ Author: Douglas Jones Purpose: Crack and print Caesar cyphered English text } PROGRAM mp4( input, output ); TYPE upper = 'A' .. 'Z'; lower = 'a' .. 'z'; VAR rotation: integer; { inferred rotation needed to crack the cypher } { ******************** } { * utility routines * } { ******************** } FUNCTION rotate( ch: upper; d: integer ): upper; { compute a Caesar cypher of an upper case letter } BEGIN rotate := chr( ((ord(ch) - ord('A')) + d) mod 26 + ord('A') ); END; FUNCTION isupper(ch: char): boolean; { test a letter to see if it is upper case } BEGIN isupper := (ch >= 'A') and (ch <= 'Z'); END; { isupper } FUNCTION islower(ch: char): boolean; { test a letter to see if it is lower case } BEGIN islower := (ch >= 'a') and (ch <= 'z'); END; { isupper } FUNCTION toupper(ch: lower): upper; { convert lower case letters to upper case } BEGIN toupper := chr( ord(ch) - ord('a') + ord('A') ); END; { toupper } FUNCTION tolower(ch: upper): lower; { convert upper case letters to lower case } BEGIN tolower := chr( ord(ch) - ord('A') + ord('a') ); END; { tolower } { ************************** } { * part 1: crack the code * } { ************************** } FUNCTION crackcode: integer; { crack the Caesar cypher used to encrypt the data in the input text } TYPE freq = ARRAY [upper] OF real; VAR given: freq; { given letter frequencies for English text } found: freq; { measured letter frequencies in cyphertext } PROCEDURE readgiven; { read the standard letter frequency data into the global array given } VAR f: text; c: upper; { a loop index } c1,c2: char; { characters read from start of each line } BEGIN reset( f, 'freq'); FOR c := 'A' TO 'Z' DO BEGIN read( f, c1, c2 ); { this ought to get c1 = c, c2 = ':' } IF (c1 <> c) or (c2 <> ':') THEN writeln( 'error in freq file, slot ', c ); readln( f, given[c] ); END; END; { readgiven } PROCEDURE figurefound; { measure the letter frequencies in the input text and put that data in the global array found } VAR ch: char; { a character from the file } count: ARRAY [upper] OF integer; total: integer; BEGIN { step 1, initialize } FOR ch := 'A' TO 'Z' DO count[ch] := 0; { step 2, count the characters } WHILE not eof DO BEGIN WHILE not eoln DO BEGIN read( ch ); IF isupper(ch) THEN count[ch] := count[ch] + 1 ELSE IF islower(ch) THEN BEGIN ch := toupper(ch); count[ch] := count[ch] + 1; END; END; readln; END; { step 3, get the grand total count } total := 0; FOR ch := 'A' TO 'Z' DO total := total + count[ch]; { step 4, convert to frequencies } FOR ch := 'A' TO 'Z' DO found[ch] := count[ch] / total; END; { figurefound } PROCEDURE findbestrotate; { find the best rotation to match the global found and given arrays; return this in the global crackcode; uses a least squares scheme to define the notion of a best match } VAR trial: integer; { the trial degree of rotation } diff: real; { the sum of the differences found for this trial } best: integer; { the trial that gave the minimum rotation, so far } min: real; { the smallest sum of differences found so far } ch: upper; { loop index into arrays being rotated } BEGIN { note that the maximum possible difference is 1, and that there are 26 differences summed, so the maximum possible sum of the squares of the differences is 26.0 } min := 27.0; FOR trial := 0 to 25 DO BEGIN diff := 0.0; FOR ch := 'A' to 'Z' DO diff := diff + sqr( given[rotate( ch, trial )] - found[ch] ); IF diff < min THEN BEGIN min := diff; best := trial; END; END; crackcode := best; END; { findbestrotate } BEGIN { crackcode } readgiven; figurefound; findbestrotate; END { crackcode }; { ************************************** } { * part 2: decrypt the encrypted data * } { ************************************** } PROCEDURE decrypt( r: integer ); { copy standard input to standard output with a rotate r Caesar cypher; this code is derived from MP2 } VAR ch: char; PROCEDURE rot(VAR c: char); { perform a rotate r Caesar cypher on the letter c } BEGIN IF isupper(c) THEN c := rotate( c, r ) ELSE IF islower(c) THEN c := tolower( rotate( toupper( c ), r ) ); END; { rot } BEGIN { decrypt } WHILE not(eof) DO BEGIN WHILE not(eoln) DO BEGIN read(ch); rot(ch); write(ch); END; readln; writeln; END; END; { decrypt } { **************** } { * main program * } { **************** } BEGIN { mp4 } rotation := crackcode; reset( input ); writeln( '***ROT', rotation:1, '***' ); decrypt( rotation ); END. { mp4 }