A computer science problem by Rocco Dalto

Computer Science Level 3

Given the matrix $A= \begin{vmatrix}{4} && {7} && {10} \\ {3} && {19} && {1} \\ {1} && {11} && {2}\end{vmatrix} \bmod{26}$ , use a Hill cipher to decipher the enciphered text $IWIGPDIXPHSBEAMRDHGLFCZSSHZ$ using modulo 26, where $A \rightarrow 0$ , $B \rightarrow 1$ , $\ldots$ , $Z \rightarrow 25$ .

Which one of the 5 choices below is the deciphered message?

$A: WE KNOW TODAY IS A REALLY GOOD DAY$

$B: WHEN YOUR ALIVE EVERY DAY IS A GOOD DAY$

$C: IS TODAY A REALLY GREAT GREAT DAY$

$D: WE KNOW TOMORROW IS NOT A GOOD DAY$

$E: WHAT IS THE CORRECT ANSWER ABOVE$ .

Write a general program(in any language) to decipher a Hill cipher given the enciphered text and a square matrix.

The program should not contain any predefined functions or procedures. That is you must create all functions and procedures and they should appear in the program, and not called from a library you created.

Note: For the program $\gcd(\det(A),26) = 1.$

Refer to previous problem. . .

This program is a slight modification of the program I wrote in the previous problem.

D C E B A

1 solution

Rocco Dalto
Mar 21, 2017

I wrote this program in Free Pascal.

program HillCipher_todecipher; {self contained for brillant}

const maxnum = 30;

type matrix = array[1 .. maxnum,1 .. maxnum + 1] of longint;

 solution = array[1 .. maxnum,1 .. maxnum + 1] of LONGINT;

 realmatrix = array[1 .. maxnum,1 .. maxnum] of real;

var a,b,p,holdp,holdb,y,holda,newa:matrix;

v,n,l,bool,r,m:integer;

NUMLINES,NUMBLOCKS,det:INTEGER;

NUMCOLUMNS:INTEGER;

STRSUM,STRTXT:STRING;

{TOBIG:BOOLEAN;     }

X:solution;

c:realmatrix;

product:real;

NUMCHARS,BLOCKNUM:INTEGER;

PROCEDURE CONVERT_NUMTOTEXT(NUM:LONGINT; VAR LETTER:CHAR);

BEGIN

CASE NUM OF

0:LETTER:= 'A';

1:LETTER:= 'B';

2:LETTER:= 'C';

3:LETTER:= 'D';

4:LETTER:= 'E';

5:LETTER:= 'F';

6:LETTER:= 'G';

7:LETTER:= 'H';

8:LETTER:= 'I';

9:LETTER:= 'J';

10:LETTER:= 'K';

11:LETTER:= 'L';

12:LETTER:= 'M';

13:LETTER:= 'N';

14:LETTER:= 'O';

15:LETTER:= 'P';

16:LETTER:= 'Q';

17:LETTER:= 'R';

18:LETTER:= 'S';

19:LETTER:= 'T';

20:LETTER:= 'U';

21:LETTER:= 'V';

22:LETTER:= 'W';

23:LETTER:= 'X';

24:LETTER:= 'Y';

25:LETTER:= 'Z';

END;

PROCEDURE CONVERT_TEXTTONUM(LETTER:CHAR; VAR NUM:LONGINT);

BEGIN

CASE UPCASE(LETTER) OF

'A':NUM:= 0;

'B':NUM:= 1;

'C':NUM:= 2;

'D':NUM:= 3;

'E':NUM:= 4;

'F':NUM:= 5;

'G':NUM:= 6;

'H':NUM:= 7;

'I':NUM:= 8;

'J':NUM:= 9;

'K':NUM:= 10;

'L':NUM:= 11;

'M':NUM:= 12;

'N':NUM:= 13;

'O':NUM:= 14;

'P':NUM:= 15;

'Q':NUM:= 16;

'R':NUM:= 17;

'S':NUM:= 18;

'T':NUM:= 19;

'U':NUM:= 20;

'V':NUM:= 21;

'W':NUM:= 22;

'X':NUM:= 23;

'Y':NUM:= 24;

'Z':NUM:= 25;

END;

function prime(p:integer):boolean;

var n:integer;

begin{prime}

     if p = 1 then

        prime:= false

     else

     if p = 2 then

        prime:= true

           else

             begin{else}

         prime:= true;

         n:=2;

     while (n < trunc(sqrt(p)) + 1) do

         begin{loop}

       if p mod n = 0 then

       prime:= false;

           n:= n + 1;

         end;{loop}

             end{else}

 end;{prime}

PROCEDURE GET NUMEQS NUMBLOCKS(VAR NUMEQS,NUMBLOCKS:INTEGER);

VAR K:INTEGER;

BOOL:BOOLEAN;

BEGIN

IF PRIME(NUMCHARS) THEN

BEGIN

NUMEQS:= NUMCHARS;

NUMBLOCKS:= 1;

END

ELSE

BEGIN

FOR K:= 2 TO (NUMCHARS - 1) DO

BEGIN

IF NUMCHARS MOD K = 0 THEN

NUMEQS:= NUMCHARS DIV K;

END;

BOOL:= TRUE;

K:= 1;

WHILE BOOL DO

BEGIN

K:= K + 1;

IF NUMCHARS MOD K = 0 THEN

BEGIN

NUMBLOCKS:= NUMCHARS DIV K; {FOR SMALLEST FACTOR}

BOOL:= FALSE;

END;

PROCEDURE INITDATA;

VAR HOLDSTR:STRING;

     K,J:INTEGER;

BEGIN

writeln('Enter Enciphered Message, leave no blanks');

readln(holdstr);

writeln;

NUMCHARS:= LENGTH(HOLDSTR);

GET NUMEQS NUMBLOCKS(NUMLINES,NUMBLOCKS);

FOR J:= 1 TO NUMBLOCKS DO

BEGIN

FOR K:= 1 TO NUMLINES DO

BEGIN

CONVERT_TEXTTONUM(HOLDSTR[(J - 1) * NUMLINES + K],HOLDP[K,J]);

END;

writeln('Enter moduli');

readln(m);

END;

function gcf(m,k:LONGINT):LONGINT;

var n,factor,min:longint;

begin{gcf}

if m <= k then

min:= m

else min:= k;

for n:= 1 to min do

begin{loop}

if (k mod n = 0) and (m mod n = 0) then

 factor:= n;

end;{loop}

gcf:= factor;

end;{gcf}

PROCEDURE INITDATA1A;

VAR J,K:INTEGER;

BEGIN

FOR J:= 1 TO NUMLINES DO

begin

writeln('Enter row', j,' of Matrix');

FOR K:= 1 TO NUMLINES DO

begin

read(a[j,k]);

end;

writeln;

end;

for k:= 1 to numlines do

begin

for j:= 1 to numlines do

begin

holda[k,j]:= a[k,j];

end;

procedure matrixmult(a,b:matrix; var summat:matrix);

var j,k,s:integer;

   sum:integer;

begin{matrixmult}

for j:= 1 to NUMLINES do

begin{j}

for k:= 1 to 1 do

begin{k}

     sum:= 0;

for s:= 1 to NUMLINES do

begin{s}

     sum:= sum + a[j,s] * b[s,k];

end;{s}

      summat[j,k]:= sum;

end;{k}

end;{j}

end;{matrixmult}

procedure hold(VAR C:REALMATRIX; A:MATRIX);

var k,j:integer;

begin

for k:= 1 to numlines do

begin

for j:= 1 to numlines do

begin

c[k,j]:= a[k,j];

end;

procedure switch2(var c:realmatrix; l,p,n:integer);

var m:integer;

z:real;

begin{switch}

for m:= 1 to n do

begin{m}

   z:= c[l,m];

   c[l,m]:= c[p,m];

   c[p,m]:= z;

end;{m}

end;{switch}

procedure safeguard2(var c:realmatrix; l:integer; var p:integer; n:integer; var v:integer; var product:real);

var m:integer;

begin{safeguard}

v:=0;

if (c[l,l] = 0) then

begin{then}

v:= 1;

m:= l;

while ((m + 1) <= n) and (v = 1) do

begin{loop}

if c[m + 1,l] <> 0 then

begin{then}

        p:= m + 1;

        switch2(c,l,p,n);

        v:= 0;

        PRODUCT:= -1 * PRODUCT;

end;{then}

m:= m + 1;

end;{loop}

end;{then}

end;{safeguard}

procedure operation1(var a:realmatrix; l,n:integer; VAR PRODUCT:REAL);

var k,m:integer;

x:real;

s:realmatrix;

begin{operation1}

for m:= 1 to n do

begin{m}

s[l,m]:= a[l,m]/a[l,l];

end;{m}

PRODUCT:= PRODUCT * (1/A[L,L]);

for m:= 1 to n do

begin{m}

a[l,m]:= s[l,m];

end;{m}

    end;{operation1}

procedure operation2(var a:realmatrix; l,n:integer);

var k,m,q:integer;

x:real;

s:realmatrix;

begin{op2}

for q:= 1 to n do

begin{q}

if q <> l then

begin{then}

x:= -1 * a[q,l];

for m:= 1 to n do

begin{m}

s[q,m]:= x * a[l,m] + a[q,m];

end;{m}

for m:= 1 to n do

begin{m}

a[q,m]:= s[q,m];

end;{m}

end;{then}

end;{q}

end;{op2}

FUNCTION DETERMINANT(a:realmatrix; n:integer; PRODUCT:REAL):integer;

var j,m:integer;

DET,DIAGONAL:REAL;

begin{DETERMINANT}

DIAGONAL:= 1;

FOR j:= 1 TO N DO

BEGIN{LOOP}

DIAGONAL:= DIAGONAL * (a[j,j]);

END;{LOOP}

IF DIAGONAL = 1 THEN

DET:= 1/PRODUCT

ELSE

DET:= 0;

DETERMINANT:= ROUND(DET);

END;{DETERMINANT}

procedure switch(var c:matrix; l,p,n:integer);

var m:integer;

z:longint;

begin{switch}

for m:= 1 to n + 1 do

begin{m}

   z:= c[l,m];

   c[l,m]:= c[p,m];

   c[p,m]:= z;

end;{m}

end;{switch}

procedure safeguard(var c:matrix; l:integer; var p:integer; n:integer; var v:integer);

var j:integer;

begin{safeguard}

v:= 0;

if (c[l,l] mod m = 0) or (gcf(c[l,l],m) <> 1) then

begin{then}

v:= 1;

j:= l;

while ((j + 1) <= n) and (v = 1) do

begin{loop}

if (c[j + 1,l] mod m <> 0) and (gcf(c[j + 1,l],m) = 1) then

begin{then}

        p:= j + 1;

        switch(c,l,p,n);

        v:= 0;

end;{then}

j:= j + 1;

end;{loop}

end;{then}

end;{safeguard}

procedure operation11(var a:matrix; l,n:integer);

var j,k,i,inverse:longint;

s:matrix;

                  {s is each transformed matrix}

begin{op1}

for i:= 0 to m - 1 do

begin

if (a[l,l] * i) mod m = 1 then

begin

inverse:= i;

end;

for j:= 1 to n + 1 do

begin

s[l,j]:= (a[l,j] * inverse) mod m;

if s[l,j] < 0 then

s[l,j]:= m + s[l,j];

end;

for j:= 1 to n + 1 do

begin{j}

a[l,j]:= s[l,j];

end;{j}

for k:= 1 to n do

begin

for j:= 1 to n + 1 do

begin

a[k,j]:= a[k,j] mod m;

if a[k,j] < 0 then

a[k,j]:= m + a[k,j];

end;

end;{op1}

procedure operation21(var a:matrix; l,n:integer);

var q,j,k,x:longint;

s:matrix;

begin{op2}

for q:= 1 to n do

begin{q}

if q <> l then

begin{then}

x:= m - a[q,l];

for j:= 1 to n + 1 do

begin{j}

s[q,j]:= (x * a[l,j] + a[q,j]);

end;{j}

for j:= 1 to n + 1 do

begin{j}

a[q,j]:= s[q,j];

end;{j}

end;{then}

end;{q}

for k:= 1 to n do

begin

for j:= 1 to n + 1 do

begin

a[k,j]:= a[k,j] mod m;

if a[k,j] < 0 then

a[k,j]:= m + a[k,j];

end;

end;{op2}

procedure onesol(var a:matrix; n,r:integer);

var j,K:integer;

strnum,STRBKK:string;

begin

strsum:= '';

for j:= 1 to n do

begin

X[J,J]:= A[J,N + 1] MOD M;

Y[J,R]:= X[J,J];

IF X[J,J] < 0 THEN

BEGIN

X[J,J]:= M + X[J,J];

Y[J,R]:= X[J,J];

END;

end;

FOR K:= 1 TO N DO

BEGIN

STR(X[K,K],STRBkk);

STRSUM:= STRSUM + STRBkk + ' ';

END;

end;

PROCEDURE DECIPHER;

VAR J,K,T,N:INTEGER;

LETTER:CHAR;

STRTEXT:STRING;

BEGIN

WRITELN(' DECIPHERED BLOCKS');

WRITELN(' -----------------');

FOR J:= 1 TO NUMBLOCKS DO

BEGIN

FOR K:= 1 TO NUMLINES DO

BEGIN

A[K,NUMLINES + 1]:= HOLDP[K,J];

END;

for l:= 1 to numlines do

begin{l}

safeguard(a,l,r,numlines,v);

if v = 0 then

begin{then}

operation11(a,l,numlines);

operation21(a,l,numlines);

end;{then}

end;{l}

ONESOL(A,NUMLINES,J);

WRITELN(' ',STRSUM);

FOR T:= 1 TO NUMLINES DO

BEGIN

FOR N:= 1 TO NUMLINES DO

BEGIN

A[T,N]:= HOLDA[T,N];

END;

STRTEXT:= '';

FOR J:= 1 TO NUMBLOCKS DO

BEGIN

FOR K:= 1 TO NUMLINES DO

BEGIN

CONVERT_NUMTOTEXT(Y[K,J],LETTER);

STRTEXT:= STRTEXT + LETTER;

END;

WRITELN(' DECIPHERED TEXT IS:');

WRITELN(' ',STRTEXT);

END;

begin

INITDATA;

INITDATA1A;

hold(C,A); {testing to see if (m,det(a)) = 1}

PRODUCT:= 1;

for l:= 1 to numlines do

begin{l}

safeguard2(c,l,r,numlines,v,PRODUCT);

if v = 0 then

begin{then}

operation1(c,l,numlines,PRODUCT);

operation2(c,l,numlines);

end;{then}

end;{l}

DET:= DETERMINANT(c,numlines,PRODUCT);

WHILE (gcf(m,abs(det)) <> 1) or (det mod m = 0) DO

BEGIN

writeln(' GCF(M,DET(A)) <> 1.REENTER MATRIX ');

INITDATA1A;

hold(C,A); {testing to see if (m,det(a)) = 1}

PRODUCT:= 1;

for l:= 1 to numlines do

begin{l}

safeguard2(c,l,r,numlines,v,PRODUCT);

if v = 0 then

begin{then}

operation1(c,l,numlines,PRODUCT);

operation2(c,l,numlines);

end;{then}

end;{l}

DET:= DETERMINANT(c,numlines,PRODUCT);

END;

DECIPHER;

readln;

end.

Running the program we obtain:

Deciphered Blocks:

$22 \: 4 \: 10$

$13\: 14\: 22$

$19\: 14\: 12$

$14\: 17\: 17$

$14\: 22\: 8$

$18\: 13\: 14$

$19\: 0\: 6$

$14\: 14\: 3$

$3\: 0\: 24$

Deciphered Text:

$\boxed{WEKNOWTOMORROWISNOTAGOODDAY}$

@Rocco Dalto Thank you for these problems - very enjoyable. I see you also have interesting ones in other categories I look forward to trying as time permits. One observation on this problem: just before doing it I had solved the related problem which uses the same encryption matrix, and I recognized the enciphered text string $IXPHSBEAMRDHGLFCZSSHZ$ here from that solution, especially the $BEAM$ part, so I knew what this problem's answer should be. I went ahead and solved it out though, but it saved me a check step :).

Wesley Zumino - 3 years, 10 months ago

A computer science problem by Rocco Dalto

1 solution

0 pending reports