program verify(input,output);

/* verifies the claims the paper of Karhumaki and Shallit */
/* "Polynomial versus exponential growth in repetition-free binary words" */


const
	morphlength = 21;
	maxarraysize = 1000;

type
	morphismtype = array[0..3,1..morphlength] of integer;

	arraytype = record
		elts : array[1..maxarraysize] of integer;
		size : integer
		end;

var
	i, j, r, count : integer;
	h : morphismtype;
	w : array[1..10] of integer;
	a, vv : arraytype;

function power(a,n:integer):integer;

var
	t, i : integer;

begin
	t := 1;
	for i := 1 to n do
		t := t*a;
	power := t
end;

function endswithsquareofsize(var a:arraytype; len:integer):boolean;

/* true if a[1..n] ends with a square xx with |x| >= len */

var
	ll, i, n : integer;
	squarefound : boolean;

begin
	ll := len;
	squarefound := false;
	n := a.size;

	while ((2*ll)<= n) and (not squarefound) do begin
		i := 1;
		while (i <= ll) and (a.elts[n-2*ll+i]=a.elts[n-ll+i]) 
			do i := i+1;
		ll := ll+1;
		squarefound := (i=ll);
		end;	

	endswithsquareofsize := squarefound
end;

function nosquaresofsize(var a:arraytype; len:integer):boolean;

/* returns true if a has no squares of size >= len, false if it does */

var
	q, i : integer;
	t : boolean;

begin
	q := a.size;
	t := true;
	i := 1;
	while (t and (i <= q)) do begin
		a.size := i;
		t := not(endswithsquareofsize(a, len));
		i := i+1;
		end;
	a.size := q;
	nosquaresofsize := t;
end;

function squarefree(var a:arraytype):boolean;

/* returns true if a has no squares at all, false if it does */

begin
	squarefree := nosquaresofsize(a, 1);
end;


function endswithpower(var a:arraytype; p, q, ps: integer):boolean;

/* true if a[1..n] ends with a power of exponent > p/q 
   of size >= ps */

var
	n, i, s, ll : integer;
	powerfound : boolean;

begin
	ll := ps;
	powerfound := false;
	n := a.size;

	while ( ((ll*p) div q) <= n) and (not powerfound) do begin
		i := 1;
		s := 1 +  ((ll*p) div q);
		while (i <= s-ll) and (a.elts[n-s+i]=a.elts[n+ll-s+i]) 
			do i := i+1;
		powerfound := (i=(s-ll+1));
		ll := ll+1
		end;	

	endswithpower := powerfound
end;

function nopowers(var a:arraytype; p, q, ps:integer):boolean;

/* returns true if a has no fractions powers > p/q of size >= ps */

var
	qq, i : integer;
	t : boolean;

begin
	qq := a.size;
	t := true;
	i := 1;
	while (t and (i <= qq)) do begin
		a.size := i;
		t := not(endswithpower(a, p, q, ps));
		i := i+1;
		end;
	a.size := qq;
	nopowers := t;
end;

procedure copyarray(var c, d:arraytype);

var
	i : integer;

begin
	d.size := c.size;
	for i := 1 to c.size do
		d.elts[i] := c.elts[i]
end;

procedure printarray(var c : arraytype);

var
	i : integer;

begin
	for i := 1 to c.size do
		write(c.elts[i]:1); 
	writeln;
	flush(output);
end;

function index(var h: morphismtype; var a:arraytype):arraytype;

var
	b : arraytype;
	c, i, j : integer;

begin
	c := 0;

	for i := 1 to a.size do 
		for j := 1 to morphlength do begin
			c := c+1;
			b.elts[c] := h[a.elts[i],j]
			end;
	b.size := c;
	index := b;
end;


function negate(a:integer):integer;

begin
	negate := 1-a;
end;

function tothe(a,b:real):real;

begin
	tothe := exp(b*ln(a))
end;

/* main code begins here */

begin
	w[1] := 0; w[2] := 1; w[3] := 1; w[4] := 0; w[5] := 1;
	w[6] := 0; w[7] := 0; w[8] := 1; w[9] := 1; w[10] := 0;

	for i := 1 to 10 do begin
		h[0,i] := w[i];
		h[0,22-i] := negate(w[i]);

		h[1,i] := negate(w[i]);
		h[1,22-i] := w[i];

		h[2,i] := negate(w[i]);
		h[2,22-i] := w[i];

		h[3,i] := w[i];
		h[3,22-i] := negate(w[i]);
		end;

	h[0,11] := 0;
	h[1,11] := 0;
	h[2,11] := 1;
	h[3,11] := 1;

	writeln('Here is the morphism h: ');

	for j := 0 to 3 do begin
		write('h[',j:1,'] = ');
		for i := 1 to 21 do write(h[j,i]:1);
		writeln;
		end;

	writeln;

	writeln('We now check to see if h(w) contains no squares yy with');
	writeln('|y| > 13 for all squarefree words w of length 5.');
	writeln;

	count := 0;

	for i := 0 to power(4,5)-1 do begin
		r := i;
		for j := 5 downto 1 do begin
			a.elts[j] := r mod 4;
			r := r div 4;
			end;
		a.size := 5;
		if squarefree(a) then begin 
			writeln;
			count := count+1;
			write(count:3, ' ');
			printarray(a);
			vv := index(h, a);
			printarray(vv);
			if nosquaresofsize(vv,14) then writeln('passed test')
				else writeln('failed test');
			end; 
		end;

	writeln; writeln;

	writeln('We now check to see if h(w) contains no (7/3)+ power');
	writeln('for all squarefree words w of length 3.');
	writeln;

	count := 0;

	for i := 0 to power(4,3)-1 do begin
		r := i;
		for j := 3 downto 1 do begin
			a.elts[j] := r mod 4;
			r := r div 4;
			end;
		a.size := 3;
		if squarefree(a) then begin 
			writeln;
			count := count+1;
			write(count:3, ' ');
			printarray(a);
			vv := index(h, a);
			printarray(vv);
			if nopowers(vv,7,3,1) then writeln('passed test')
				else writeln('failed test');
			end; 
		end;


		
end.