program FourSquareTip;	{ JA2008 Computer Column by Cary Davids, March 2008 }
{ tip1 is even-length tip starting at pos. 1, tip2 is same starting at pos. 2 }
{	Compile with FreePascal: fpc foursquaretip }
{ Compile with GNU Pascal: gpc -o foursquaretip FourSquareTip.pas }
{ Ignore string-length warnings from GNU Pascal compilation }
{ See accompanying file SampleRunJA2008.txt }
 type
  frecord = record	{ letter frequency }
    fr1: integer;		{ frequency of 1st cipher letter in digram }
    fr2: integer;		{ frequency of 2nd cipher letter in digram }
    let: char				{ cipher letter }
   end;
 var
  str, str1, tippatstr1, tippatstr2, title, tip, n1str, n2str, tip1, tip2, alph, zero: string;
  i, j, len, nd, lt, len1, len2, lt1, lt2: integer;
  sqr, ct1, ct2: array[1..5, 1..5] of char;
	nsqr1, nsqr2: array[1..5,1..5] of real;
  Infile: text;
  freq: array[1..26] of frecord;

 function patstr (cstr: string): string;
  var
   i, j, ls: integer;
   dstr: string[255];
   tpat: array[1..50] of integer;
 begin
		dstr := '';			{ start with blank string }
		ls := length(cstr);	{ get length of string }
		for i := 1 to ls - 1 do
			for j := i + 1 to ls do
				if cstr[i] = cstr[j] then  { found a duplicate }
					begin
						tpat[i] := j - i;	  { gives integer distance }
						break;  { found one for this i, don't look further }
					end
				else
					tpat[i] := 0;	{ no duplicate found for this i }
		for i := 1 to ls - 1 do	{ ignore last position: it is 0 }
			if tpat[i] > 9 then
				dstr := concat(dstr, chr(tpat[i] + 55))		{ letter }
			else
				dstr := concat(dstr, chr(tpat[i] + 48));	{ number }
		patstr := dstr;		{ result returned by function }
 end;	{ of function patstr }

 procedure FauxEncipher(str1: string);
 
{		We will use plaintext squares as faux cipher squares to encipher the tip.  Then we will drag }
{		the faux enciphered tip through the cipher, looking for matches.  We want pattern matches }
{		between first letters of faux ciphertext digrams and real ciphertext digrams, as well as pattern }
{		matches between 2nd letters.  dig1 is a tip digram, dig2 is the cipher of that tip digram.  ctip1 is }
{		a string of the first letters of the enciphered tip digrams, ctip2 is a string of the 2nd letters }
 var
	i, j, k, kmax, r1, r2, c1, c2: integer;
	dig1, dig2: string[2];
	ctip1, ctip2: string;
	begin
		dig2 := '  ';
		ctip1 := '';
		ctip2 := '';
		kmax := length(str1) div 2;		{ number of digrams }
		for k := 1 to kmax do
			begin
				dig1 := copy(str1, 2*k - 1, 2);		{ get tip digram }
				for i := 1 to 5 do
					for j := 1 to 5 do
						begin
							if dig1[1] = sqr[i, j] then
								begin
									r1 := i;		{ row number of first letter }
									c1 := j;		{ column number of first letter }
								end;
							if dig1[2] = sqr[i, j] then
								begin
									r2 := i;		{ row number of second letter }
									c2 := j;		{ column number of second letter }
								end;
						end;	{ of ij loop }
				dig2[1] := sqr[r1, c2];	{ faux cipher digram, letter 1 }
				dig2[2] := sqr[r2, c1];	
				ctip1 := concat(ctip1, dig2[1]);	{ build first letter string }
				ctip2 := concat(ctip2, dig2[2]);
				write(dig2, ' ');
			end;	{ of k loop }
		writeln;
		tippatstr1 := patstr(ctip1);
		tippatstr2 := patstr(ctip2);
		writeln('First digram letters:  ', ctip1, ', patstr: ', tippatstr1);
		writeln('Second digram letters: ', ctip2, ', patstr: ', tippatstr2);
	end;	{ of procedure FauxEncipher }

Procedure DrawSquares(str1, str2: string);	
{ enters knowing str1 in DragTip = tip1 or tip2, str2 = ciphertext match }
 var
	i, j, k, kmax, r1, r2, c1, c2, n: integer;
	dig1, dig2: string[2];
	chisq: real;
	begin
		for i := 1 to 5 do
			for j := 1 to 5 do
				begin			{ start with empty squares }
					ct1[i, j] := '.';
					ct2[i, j] := '.';
				end;

{		Now populate ciphertext squares ct1 and ct2 }

		kmax := length(str1) div 2;		{ number of digrams }
		for k := 1 to kmax do
			begin
				dig1 := copy(str1, 2*k - 1, 2);		{ get tip digram }
				dig2 := copy(str2, 2*k - 1, 2);		{ get matching ct digram }
				for i := 1 to 5 do
					for j := 1 to 5 do
						begin
							if dig1[1] = sqr[i, j] then
								begin
									r1 := i;		{ row number of first pt letter }
									c1 := j;		{ column number of first pt letter }
								end;
							if dig1[2] = sqr[i, j] then
								begin
									r2 := i;		{ row number of second pt letter }
									c2 := j;		{ column number of second pt letter }
								end;
						end;	{ of ij loop }
				ct1[r1,c2] := dig2[1];	{ first ct letter, goes in ct1 }
				ct2[r2,c1] := dig2[2];	{ second ct letter, goes in ct2 }
			end;	{ of k loop }

	{		Now draw squares }
	
		chisq := 0;
		n :=0;
		for i := 1 to 5 do
			begin
				for j := 1 to 5 do
					write(sqr[i,j],' ');
				write(' ');
				for j := 1 to 5 do
					begin
						write(ct1[i,j],' ');
						if ct1[i,j] <> '.' then
							for k := 1 to 26 do
								if ct1[i,j] = freq[k].let then
									begin
										chisq := chisq + (freq[k].fr1-nsqr1[i,j])*(freq[k].fr1-nsqr1[i,j])/nsqr1[i,j];
										inc(n);
									end;
					end;	{ of j loop }
				for j := 1 to 5 do
					write(trunc(nsqr1[i,j]+0.5):2);
				writeln;
			end;	{ of i loop }
		writeln;
		for i := 1 to 5 do
			begin
				for j := 1 to 5 do
					begin
						write(ct2[i,j],' ');
						if ct2[i,j] <> '.' then
							for k := 1 to 26 do
								if ct2[i,j] = freq[k].let then
									begin
										chisq := chisq + (freq[k].fr2-(nsqr2[i,j]))*(freq[k].fr2-(nsqr2[i,j]))/nsqr2[i,j];
										inc(n);
									end;
					end;	{ of j loop }
				write(' ');
				for j := 1 to 5 do
					write(sqr[i,j],' ');
				for j := 1 to 5 do
					write(trunc(nsqr2[i,j]+0.5):2);
				writeln;
			end;	{ if i loop }
		writeln('Chisq/DF =',chisq/(n-1):6:3,', N = ',n-1);
	end;	{ of procedure DrawSquares }

Procedure DragTip(str1,str3:string);	{ str1 is tip1 or tip2, str3 is 'tip1' or 'tip2' }
 var
	str2, cstr1, cstr2, chk: string;
	i, ii, imax, ltip: integer;
	mflag: boolean;
	begin
		ltip := length(str1);
		imax := ltip div 2;
		chk := copy(zero,1,imax - 1);	{ get string of zeros as long as pattern string }
		mflag := true;		{ means didn't find match }
		for ii := 1 to nd - ltip + 1 do
			begin
				str2 := copy(str, 2*ii - 1, ltip);	{ grab piece of ciphertext }
				cstr1 := '';
				cstr2 := '';
				for i := 1 to imax do
					begin
						cstr1 := concat(cstr1, str2[2*i - 1]);	{ odd letters }
						cstr2 := concat(cstr2, str2[2*i]);			{ even letters }
					end;
				if not((tippatstr1=chk) and (tippatstr2=chk)) then	{ not both non-pattern }
					if (patstr(cstr1) = tippatstr1) and (patstr(cstr2) = tippatstr2) then
						begin	{ found match }
							writeln('Match found for ',str3,' at digram #', ii : 3, ': ', str2);
							DrawSquares(str1,str2);
							mflag := false;		{ found at least 1 match }
						end;
			end;	{ of ii loop }
		if mflag then
			writeln('No match found for ',str3);
	end;	{ of procedure DragTip }
	
begin			{ main program }
	title := '      FOURSQUARE TIP PLACEMENT';
	alph := 'ABCDEFGHIKLMNOPQRSTUVWXYZ';
	zero := '0000000000000000';		{ use to reject non-pattern words }
	n1str := '502508747775351251132400480420413402344753456302269635858486080043104168118';
	n2str := '362537932540509183255381718146452252366834466433247477789605119062076152104';

{		Set up plaintext square }

	for i := 1 to 5 do
		for j := 1 to 5 do
			sqr[i, j] := alph[j + 5 * (i - 1)];

{		Set up normal frequency squares taken from digram frequencies n1str and n2str, per 1 digram }

 for i := 0 to 24 do
			begin																				{ hundreds                   tens                        units }
				nsqr1[(i div 5)+1,(i mod 5)+1] := 0.01*(ord(n1str[3*i+1])-48 + 0.1*(ord(n1str[3*i+2])-48) + 0.01*(ord(n1str[3*i+3])-48));
				nsqr2[(i div 5)+1,(i mod 5)+1] := 0.01*(ord(n2str[3*i+1])-48 + 0.1*(ord(n2str[3*i+2])-48) + 0.01*(ord(n2str[3*i+3])-48));
			end;
			
{		Now get puzzle  }

	write('ENTER THE FILE NAME ("-1" to quit): ');
	readln(str1);							{ read in filename }
	if str1 = '-1' then
		halt;
	assign(Infile, str1);			{ open Infile with title str1 }
	reset(Infile);	
	readln(Infile, str);			{ read puzzle into str }
	readln(Infile, tip);			{ read in tip }
	len := length(str);
	if len mod 2 > 0 then
		begin
			writeln('Length of string not an even number');
			halt;
		end;
	nd := len div 2;					{ number of digrams in cipher }
	lt := length(tip);				{ length of tip }
	Writeln(title, '  ', str1);
	Writeln('Tip= ', tip, '   # of digrams in cipher=', nd : 3);

{		Create Expected Frequency Counts for ct1 (nsqr1) and ct2 (nsqr2) for this con }

	for i := 1 to 5 do
		for j := 1 to 5 do
			begin
				nsqr1[i,j] := nd*nsqr1[i,j];
				nsqr2[i,j] := nd*nsqr2[i,j];
			end;
			
{		Initialize frequency records and column array }

	for i := 1 to 26 do
		begin
			freq[i].let := chr(64 + i);			{ initialize ciphertext alphabet A-Z }
			freq[i].fr1 := 0;					{ intialize frequency count }
			freq[i].fr2 := 0;					{ intialize frequency count }
		end;

{		Get puzzle frequency distribution }

	for i := 1 to nd do
		begin
			j := ord(str[2 * i - 1]) - 64;		{ get index into first character of digram }
			freq[j].fr1 := freq[j].fr1 + 1;		{ increment frequency count }
			j := ord(str[2 * i]) - 64;				{ get index into 2nd character of digram }
			freq[j].fr2 := freq[j].fr2 + 1;		{ increment frequency count }
		end;

{		Display observed frequency counts }

	write('           ');
	for i := 1 to 26 do
		write(' ', freq[i].let);
	writeln;
	write('1st letter:');
	for i := 1 to 26 do
		write(freq[i].fr1 : 2);
	writeln;
	write('2nd letter:');
	for i := 1 to 26 do
		write(freq[i].fr2 : 2);
	writeln;

{		Process Tip }

	if lt mod 2 > 0 then
		begin
			writeln('Length of tip not an even number');
			tip1 := copy(tip, 1, lt - 1);		{ get even-numbered tip length starting with position 1 }
			tip2 := copy(tip, 2, lt - 1);		{ get even-numbered tip length starting with position 2 }
		end
	else
		begin
			tip1 := tip;			{ get even-numbered tip length starting with position 1 }
			tip2 := copy(tip, 2, lt - 2);		{ get even numbered tip - 2 length starting with position 2 }
		end;
	lt1 := length(tip1);
	lt2 := length(tip2);
	len1 := lt1 div 2;		{ half-length of tip1 and number of digrams }
	len2 := lt2 div 2;		{ half-length of tip2 }
	write('Tip1= ');
	for i := 1 to len1 do
		write(tip1[2 * i - 1], tip1[2 * i], ' ');	{ write out tip1 as digrams }
	writeln('  Length=', lt1 : 2);
	write('Tip2= ');
	for i := 1 to len2 do
		write(tip2[2 * i - 1], tip2[2 * i], ' ');	{ write out tip2 }
	writeln('  Length=', lt2 : 2);
	writeln;
	write('Faux encipherment of Tip1: ');
	FauxEncipher(Tip1);
	DragTip(Tip1,'Tip1');
	writeln;
	write('Faux encipherment of Tip2: ');
	FauxEncipher(Tip2);
	DragTip(Tip2,'Tip2');
	write('Press <Enter>: ');
	readln;
end.