program Swagman;	{		Displays the cipher, divided into blocks and written out in columns.  }
{	It then calculates permutations and extracts plaintext with high trigram scores. }
{ Program tested on Mac with GNU Pascal and FreePascal (www.freepascal.org) compilers 3/12/08. }
{ Also tested on Windows with FreePascal compiler. }

 const
  nbuf = 25;	{ number of candidates displayed. You can set it yourself }
 type
  vec = array[1..10] of integer;
  ind = array[1..10] of integer;
 type
  scorerec = record
    score: integer;		{ score part }
    vec: string[20];  { string giving vector values }
    sol: string[255];	{ sol part }
   end;

 var
  str, str1, sol, title: string[255];
  i, j, jj, k, len, nb, nfac, ncol, score, ncl: integer;
  a: array[1..26, 1..26, 1..26] of 0..99;
  col: array[1..20] of integer;
  buff: array[1..100] of scorerec;
  temp: scorerec;
  block: array[1..10, 1..50] of char;		{ array of ciphertext written out by column changed 3/12/08 }
  Infile, datafile: text;
  x: vec;
  sig, inc: ind;
  C: char;
  firstp1, flag: boolean;

 function TriAvg (string1: string): integer;
  var
   i, j, k, nt, kkk: integer;
   sum, avg: real;
 begin
   nt := length(string1) - 2; { number of trigrams }
   sum := 0;
   for kkk := 1 to nt do
      begin
         i := ord(string1[kkk]) - 64;
         j := ord(string1[kkk + 1]) - 64;
         k := ord(string1[kkk + 2]) - 64;
         sum := sum + a[i, j, k];
      end;
   avg := 14 * sum / nt;
   TriAvg := trunc(avg);
 end;    { of function Triavg }

 procedure init (n: integer; var inc, sig: ind; var firstp: boolean);
  var
   j: integer;
 begin
  for j := 1 to n - 1 do
   begin
    sig[j] := 0;
    inc[j] := 1
   end;
  firstp := false
 end;		{ of procedure init }

 procedure exch (l: integer; var x: vec);
  var
   t: integer;
 begin
  t := x[l];
  x[l] := x[l + 1];
  x[l + 1] := t
 end;    { of procedure exch }

 procedure nextperm (n: integer; var x: vec; var inc, sig: ind; var firstp: boolean);
  var
   k, m, sigm: integer;
 begin
   if firstp then
      init(n, inc, sig, firstp);
   k := 0;
   m := 1;
   sigm := sig[m] + inc[m];
   sig[m] := sigm;
   while (sigm = n - m + 1) or (sigm = 0) do
      begin
         if sigm = 0 then
            begin
               inc[m] := 1;
               k := k + 1
            end
         else
            inc[m] := -1;
         if m = n - 1 then
            begin
               exch(n - 1, x);
               firstp := true;
               sigm := 1
            end
         else
            begin
               m := m + 1;
               sigm := sig[m] + inc[m];
               sig[m] := sigm
            end
      end;  { of while }
   if not firstp then
      exch(k + sigm, x)
 end;    { of procedure nextperm }

 procedure AddRecord;	{ puts current score into buffer.  Enter with current scorerec=temp }
  var
   i, j: integer;
 begin
   for i := 1 to nbuf do
      if temp.score >= buff[i].score then
         begin
            for j := nbuf - 1 downto i do	{ move down remaining entries }
               buff[j + 1] := buff[j];
						buff[i] := temp;		{ insert current one }
						exit;		{ finished, get out of AddRecord changed 3/12/08 }
         end;
 end;	{ of procedure AddRecord }

{     Main Program }

begin
 assign(datafile, 'trigramp.dat');
 reset(datafile);	{ open datafile with title trigramp.dat changed 3/12/08 }
 for k := 1 to 26 do
  for j := 1 to 26 do
   begin
    readln(datafile, str);			{ read in a line of trigram data }
    for i := 1 to 26 do
     a[k, j, i] := 10 * (ord(str[3 * i - 2]) - 48) + ord(str[3 * i - 1]) - 48;
   end;

{			Now get con  }

 title := '      SWAGMAN HELPER';
 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 changed 3/12 08 }
 reset(Infile);	
 readln(Infile, str);			{ read puzzle into str }
 Writeln(title, '   ', str1);
 len := length(str);
 writeln('Length=', len:3);

{		Find factors of len }

 j := 0;
 for i := 2 to len div 2 do
  if len mod i = 0 then
   begin
    j := j + 1;			{ advance counter }
    col[j] := i;			{ store factor in array }
   end;
 nfac := j;					{ number of factors found }
 write('Factors:');
 for i := 1 to nfac do
  write(col[i] : 3);
 writeln;

 write('ENTER DESIRED NUMBER OF COLUMNS (''-1'' to quit): ');
 readln(ncol);
 if ncol = -1 then
  halt;
 flag := false;			{ factor not found flag  }
 for i := 1 to nfac do
  if ncol = col[i] then
   flag := true;
 if not (flag) then
  begin
   write('Column number ', ncol : 2, ' not allowed');
   halt;
  end;
 nb := len div(ncol * ncol);		{ number of complete blocks }
 ncl := (len mod (ncol * ncol)) div ncol; { number of remaining columns }
 writeln;
   for i := 1 to nbuf do
      begin		{ initialize buffer }
         buff[i].score := 0;
         buff[i].vec := copy(str, 1, ncol);
         buff[i].sol := copy(str, 1, len div ncol);
      end;
 temp.score := 0;	{ initialize temporary buffer used for each square }
 temp.vec := copy(str, 1, ncol);
 temp.sol := copy(str, 1, len div ncol);

{		Now write out cipher by columns in blocks of size ncol X ncol }

 for i := 1 to ncol do		{ this is how many lines there will be }
   begin
		 for j := 1 to nb do	{ write out full blocks first }
				begin
					for k := 1 to ncol do
						begin
							C := str[i + ncol*ncol*(j - 1) + ncol*(k - 1)];	{ get character }
							write(C);
							block[i, k + ncol*(j - 1)] := C;		{ store in array }
						end;
					write(' ');
				end;	{ of j loop }
		 for k := 1 to ncl do	{ now write out partial block }
				begin
					C := str[i + ncol*ncol*nb + ncol*(k - 1)];
					write(C);
					block[i, k + ncol*nb] := C;		{ store in array }
				end;
		 writeln;
   end;	{ of i loop }
 writeln;

{		Get permutations of row numbers, put in vector x[i], where i is column }

 firstp1 := true;
 for i := 1 to ncol do
   x[i] := i;		{ initialize array x }
 repeat
  sol := '';
  nextperm(ncol, x, inc, sig, firstp1);	{ get next permutation of x }

{		Construct solution with this permutation }

  for j := 1 to nb do { full blocks }
		for i := 1 to ncol do 	{ columns }
			sol := concat(sol, block[x[i], i + ncol * (j - 1)]);
  for i := 1 to ncl do 	{ remaining columns }
		sol := concat(sol, block[x[i], i + ncol * nb]);
  score := Triavg(sol);
  temp.score := score;
  temp.sol := sol;
  temp.vec := '';
  for i := 1 to ncol do
		temp.vec := concat(temp.vec, ' ', chr(x[i] + 48));
  AddRecord;
 until firstp1;
 for i := 1 to nbuf do
		writeln(buff[i].vec,' ',' ', buff[i].sol,'  ', buff[i].score);
end.