with(linalg):

MIN_OCCURRENCE := 3:
PRINT_RESULT := true:


AllMoves := [	[[-1, 0], [-2, 0]], [[+1, 0], [+2, 0]],
	[[0, -1], [0, -2]], [[0, +1], [0, +2]]	]:

calctime := 0:

#####################################################################################
# Find all the positions that can be generated from startposition
# following the rules defined by AllMoves
#
# return a list of matrixes
#####################################################################################

FindAllPositions := proc(width, length)
	local i, j, k, ii, returnlist, result, result1, result2, newpos, totalpegs, 
		positionlist, pattern, patternlist, lenpatternlist, lenpositionlist,
		startposition, poslist1, maxrefreshrate;
global calctime;

	if nargs = 2 then
		# normal start. initialize all variables
		startposition := matrix(width, length, 0):
		startposition[1, iquo(length, 2) + 1] := 1:

		# verify AllMoves is well defined
		VerifyMoves(AllMoves);
	
		result := [op(startposition)];
	
#		returnlist := [];

		positionlist := [ConvertMatrixToList(startposition)];	# the list of all the positions not in patternlist
		poslist1 := [];		# backup of positionlist
		maxrefreshrate := 0;
		
		# the list of all the patterns found
		# the format of each element is described in CreatePatternListElement function
		patternlist := [];		
	
		totalpegs := 1;		# the total number of pegs in any of the newly generated positions
							# and there is only one peg on the board at the beginning
	else
PrintResult(`reading results. Please wait...`);

		# previous result supplied. read and convert the results
		result := ReadResults(args[3][1], width, length);
		patternlist := args[3][2];
		positionlist := args[3][3];
		totalpegs := args[3][4];
	fi;
		
#	while nops(result) > 0 do

	# continue generating new positions until no more positions or patterns are being generated
	# and all positions with large number of pegs are in patterns
	# If it is true, then all positions generated by patterns are in patterns 
	# (because all solid large positions are in patterns)
	# and all positions in patterns are generated by some other patterns 
	# (because of the refresh rate)
	# and therefore complete our proof
	
	while positionlist <> poslist1 or 
			totalpegs - GetMaxRefreshRate(patternlist) <= GetMaxSolidPositionPegs(positionlist) do

PrintResult(`totalpegs = `, totalpegs, ` total num resutls = `, nops(result));

		if positionlist = poslist1 or 
			totalpegs - GetMaxRefreshRate(patternlist) > GetMaxSolidPositionPegs(positionlist) then
PrintResult(`totalpegs := `, totalpegs, 
	`: Max refresh rate := `, GetMaxRefreshRate(patternlist), 
	`: Max position pegs := `, GetMaxSolidPositionPegs(positionlist),
	`: positionlist := `, positionlist,
	`: poslist1 := `, poslist1, 
	`: patternlist := `, patternlist);
		fi:
		
		poslist1 := positionlist;	# remember the current state of position list for later comparision
		
		# add all the new non-duplicate results into the return list
#		returnlist := [op(returnlist), result];

		# we are moving from existing positions to the next ones 
		# which will have one more pegs than the current ones		
		totalpegs := totalpegs + 1;
		
		patternlist := TestRefreshRate(patternlist, positionlist, totalpegs);
		positionlist := patternlist[2];
		patternlist := patternlist[1];

		if not TestBoudary(result) then
			# if there is not enough room for some positions to expand, stop
			# because TestRefreshRate will eventually break them up,
			# which might be unneccesary
			
PrintResult(`Caculation is stopped because the boudary has been `,
	`reached, and may not yield correct result. Save the result and `,
	`run the program with longer strip again.`);
			break;
		fi:

		result1 := [];	# result1 will be all the non-duplicates in the newly generated positions
		for i from 1 to nops(result) do
			# get the generated positions
			result2 := NextPositions(result[i], AllMoves);

			while nops(result2) > 0 do
				
				newpos := ConvertMatrixToList(result2[1]);

				# if newpos is a duplicate or a shift, we will ignore it
				if not IsPositionADuplicate(newpos, positionlist) then

					# check if the new position is already in a pattern list
					lenpatternlist := nops(patternlist);

#starttime := time();
					for k from 1 to lenpatternlist 
							while not IsInstanceOf(newpos, patternlist[k][2]) do
					od:
#calctime := calctime + time() - starttime;
#PrintResult(` time used: `, calctime, time() - starttime, lenpatternlist);

					if k > lenpatternlist then
						# add the position to result list for next round of calculation, 
						# since it is not in the position list and not an instance of any patterns
						result1 := [op(result1), result2[1]];
	
						# if newpos is not in the position list already, 
						# add it into the list and try to find new patterns
						
						pattern := FindPatternInPositionList(newpos, patternlist, positionlist, totalpegs);
						
						patternlist := pattern[1];															
						positionlist := pattern[2];
					else
						if IsPositionInPatternListElement(patternlist[k], newpos) then
#print(newpos, " not added because it is in patternlist");
						else
							# add the position to result list for next round of calculation, 
							# since it is not in the position list and not in any patterns
							result1 := [op(result1), result2[1]];
							
							# if it is in a pattern, add the position into the list of positions
							# that generate the pattern
								
							patternlist := [op(1..k - 1, patternlist), 
								AddPositionIntoPatternListElement(patternlist[k], newpos, totalpegs), 
								op(k + 1..lenpatternlist, patternlist)];
						fi:
					fi:
				else
#print(newpos, " not added because it has a dup");
				fi:
										
				result2 := [op(2..nops(result2), result2)];
			od:
		od:
		
		result := result1;	
	od:
	
	totalpegs := totalpegs - 1;	# minus one because the loop adds one extra
	
#print(`returnlist = `, returnlist);

	[result, patternlist, positionlist, totalpegs];
end:

#####################################################################################
# Check the refresh rate against the totalpegs
# if some patterns are not refreshed promptly, they will be broken up as positions
# 
# return the new patternlist, positionlist
#####################################################################################

TestRefreshRate := proc(patternlist, positionlist, totalpegs)
	local i, j, len, patlist, poslist, resultlist;
	
	len := nops(patternlist);
	patlist := patternlist;
	poslist := positionlist;
	
	for i from 1 to len do
		resultlist := RecursivelyTestRefreshRate(patternlist[i], totalpegs);
		
		if resultlist[1] <> [] or resultlist[2] <> [] then
			# the pattern was broken up
		
PrintResult(`pattern `, patternlist, ` is removed. totalpegs = `, totalpegs);
			if resultlist[1] <> [] then
				patlist := RemovePositionsFromPatternList(patlist, resultlist[1])[1];
			fi:
			
			poslist := [op(poslist), op(resultlist[2])];
		fi;
	od:
	
	[patlist, poslist];
end:

#####################################################################################
# recursively check the patternlistelements against the totalpegs
# break them up into single positions if they are not refreshed promptly
#
# return the new patterns, positions if it has to be updated
# [], [] otherwise
#####################################################################################

RecursivelyTestRefreshRate := proc(patternlistelement, totalpegs)
	local i, j, returnlist, retpatternlist, retpositionlist, len, bBreak;

# the format is : ["PLE", the pattern, 
#	the refresh rate ( the number by which at least one position should be added into 
#		the position list of the patternlistlement before the totalpegs is increased), 
#	the last value of totalpegs when a position is added into the following list,
#	the positions that generated the list (which can be pattern lists too)]
	
	retpatternlist := [];
	retpositionlist := [];
	bBreak := false;
	
	len := nops(patternlistelement);
	
	for i from 5 to len do
		if patternlistelement[i][1] = "PLE" then
			# if the element is a pattern constructed from other patternslistelements
			# check it recursively
		
			returnlist := RecursivelyTestRefreshRate(patternlistelement[i], totalpegs);
			
			if returnlist[1] <> [] or returnlist[2] <> [] then
				if not bBreak then
PrintResult(`pattern `, patternlistelement, ` is removed because one of its subpatterns was removed`);
					retpatternlist = [op(5..i - 1, patternlistelement)];
				fi:

				bBreak := true;

				retpatternlist := [op(retpatternlist), op(returnlist[1])];
				retpositionlist := [op(retpositionlist), op(returnlist[2])];
			else
				# no subpatterns were broken up, check the refresh rate
				# a pattern can be broken up because no new positions are added into it
				# then the current one shall be broken up too

				if totalpegs > patternlistelement[i][3] + patternlistelement[i][4] then
PrintResult(`pattern `, patternlistelement, ` is removed because of the refresh rate`);
					retpatternlist := [op(5..len, patternlistelement[i])];
					retpositionlist := [op(retpositionlist)];
				elif bBreak = true then
					# nothing is wrong, but the original patternlistelement is broken up
					retpatternlist := [op(retpatternlist), patternlistelement[i]];
				fi:
			fi:							
		else
			# if it is not a pattern constructed from other patterns, 
			# we need only to check the refresh rate
			
			if totalpegs > patternlistelement[3] + patternlistelement[4] or bBreak then
PrintResult(`pattern `, patternlistelement, ` is removed because of the refresh rate`);
				retpatternlist := [op(retpatternlist)];
				retpositionlist := [op(retpositionlist), patternlistelement[i]];
			fi;
		fi;
	od;
	
	[retpatternlist, retpositionlist];
end:			




#####################################################################################
# Read the old result of matrixes and put them into the middle of the new strip
#
# return the new result list for further calculation
#####################################################################################

ReadResults := proc(resultlist, width, length)
	local i, j1, j2, rows, cols, len, pos, returnlist, rolsleft, newpos;
	
	returnlist := [];
	
	# get the size of the positions
	if resultlist <> [] then
		rows := rowdim(resultlist[1]);
		cols := coldim(resultlist[1]);
	else
		RETURN([]);
	fi:
	
	if rows <> width then
		ERROR(`Cannot change the width of the strip`);
	fi:
	
	if cols >= length then
		ERROR(`The length of the strip must be increased to continue`);
	fi:
	
	rolsleft := iquo(length - cols, 2);
	
	# double check the values
	len := nops(resultlist);
	
	for i from 1 to len do
		pos := resultlist[i];
		
		if rowdim(pos) <> rows or coldim(pos) <> cols then
			ERROR(`Invalid input: the input sizes are not constant`);
		fi:
		
		newpos := matrix(width, length, 0);
		
		# add new rows, then copy old data into the middle of the strip
		for j1 from rolsleft + 1 to rolsleft + cols do
			for j2 from 1 to rows do
				newpos[j2, j1] := pos[j2, j1 - rolsleft];
			od:
		od:
		
		returnlist := [op(returnlist), op(newpos)];
	od:
	
	returnlist;
end:

#####################################################################################
# take a list of positions as matrixes and find out if there is enough room to expand
# on both sides of the strip along the x-axis
#
# return true if yes, false otherwise#
#####################################################################################

TestBoudary := proc(positions)
	local i, j, k, rows, cols, len, pos;
	
	len := nops(positions);
	
	for k from 1 to len do 
		pos := positions[k];
		
		rows := rowdim(pos);
		cols := coldim(pos);

		for j from 1 to rows do
			for i from 1 to 2 do
				if pos[j, i] <> 0 then
					RETURN(false);
				fi:
			od:
		od:

		for j from 1 to rows do
			for i from cols - 1 to cols do
				if pos[j, i] <> 0 then
					RETURN(false);
				fi:
			od:
		od:
	od:
		
	RETURN(true);
end:

#####################################################################################
# Check to see if a new position is an exact duplicate of an existing position in 
# the position list or can be obtained from one by shifting horizontally
#####################################################################################

IsPositionADuplicate := proc(newpos, positionlist)
	local lenpositionlist, i, ii;
	
	# we need to find out if it is an exact duplicate or a simple shift from another one,
	# e.g. [1,1,0] and [0,1,1]
	# and let us find out if we can use it to generate patterns

	lenpositionlist := nops(positionlist);
	for ii from 1 to lenpositionlist do
		if positionlist[ii] = newpos then
			break;
		fi:
	od:

	# if newpos is not in positionlist, then add it and check possible patterns
	# otherwise, the newly found position is merely a horizontal shift
	# from an existing position, and we treat them as the same position
	if ii > lenpositionlist then
		false;
	else
		true;
	fi:
end:

#####################################################################################
# Given a list of positions, find out the largest number of pegs in SOLID positions
#####################################################################################

GetMaxSolidPositionPegs := proc(positionlist)
	local i, j, len, pos, lenpos, pegs, maxpegs;
	
	maxpegs := 0;
	len := nops(positionlist);
	
	for i from 1 to len do
		pos := positionlist[i];
		lenpos := nops(pos);
		
		pegs := 0;
		for j from 1 to lenpos do
			if type(pos[j], integer) then
				pegs := pegs + GetTotalBits(pos[j]);
			else
				# not a solid position, ignore it
				pegs := 0;
				break;
			fi:
		od:
		
		if pegs > maxpegs then
			maxpegs := pegs;
		fi:
	od:
	
	maxpegs;
end:

#####################################################################################
# Given a list of patterns, find out the largest refresh rate in the list
#####################################################################################

GetMaxRefreshRate := proc(patternlist)
	local i, j, len, rate, maxrate;
	
	maxrate := 0;
	len := nops(patternlist);
	
	for i from 1 to len do
		rate := patternlist[i][3];
		
		if rate > maxrate then
			maxrate := rate;
		fi:
	od:
	
	maxrate;
end:
	
#####################################################################################
# Find all possible new patterns in positionlist
#
# return new patternlist, positionlist
#####################################################################################

FindPatternInPositionList := proc(newpos, patternlist, positionlist, totalpegs)
	local i, pattern, patlist, lenposlist, poslist, newpat, removelist;

	patlist := patternlist:
	poslist := positionlist;
	
	poslist := [op(poslist), newpos];
	
	pattern := FindPatternInAllResults(newpos, poslist);

	while pattern <> NULL do
		# we may find patterns of patterns, so we keep trying until nothing is found
		
PrintResult(`Found pattern: `, pattern);
		lenposlist := nops(poslist);
		removelist := [];

		for i from 1 to lenposlist do
			if IsInstanceOf(poslist[i], pattern[1]) then
				removelist := [op(removelist), poslist[i]];
			fi;
		od;
		
		# remove the positions that were used to generate the patterns
		patlist := RemovePositionsFromPatternList(patlist, removelist);
		patlist := [op(patlist[1]), 
			CreatePatternListElement(pattern[1], patlist[2], totalpegs)];
								
		# the new patterns are added to the position list
		# so that we can find new patterns out of existing patterns				
		poslist := RemovePositionsFromPositionList(poslist, removelist) ;
		poslist := [op(poslist), pattern[1]];

		# try to find if the new pattern(s) are part of bigger pattern(s)
		pattern := FindPatternInAllResults(pattern[1], poslist);
	od;
	
	patlist, poslist;
end:

#####################################################################################
# Recursively find out if a position is in a patternlistelement
# assuming that the position is an instance of the patternlistelement
#####################################################################################

IsPositionInPatternListElement := proc(patternlistelement, position)
	local i, j, len;
	
	len := nops(patternlistelement);
	
	for i from 5 to len do
		if patternlistelement[i][1] = "PLE" then
			if IsPositionInPatternListElement(patternlistelement[i], position) then
				RETURN(true);
			fi:
		else
			if patternlistelement[i] = position then
				RETURN(true);
			fi:
		fi:
	od:
	
	RETURN(false);
end:

#####################################################################################
# For a newly found pattern, create an elment in its corresponding patternlist
# the format is : ["PLE", the pattern, 
#	the refresh rate ( the number by which at least one position should be added into 
#		the position list of the patternlistlement before the totalpegs is increased), 
#	the last value of totalpegs when a position is added into the following list,
#	the positions that generated the list (which can be pattern lists too)]
#
# return the element
#####################################################################################

CreatePatternListElement := proc(pattern, positionlist, totalpegs)
	local i, j, listelement, returnlist, lenpositionlist;
	
	["PLE", pattern, GetRefreshRate(pattern, false), totalpegs, op(positionlist)];
end:

#####################################################################################
# add a new position into a patternlist element, and record totalpegs (when this happened) 
# a patternlist element is a entry in the patternlist in FindAllPositions function
# assuming the position is not in the list element yet
#
# return the new patternlist element
#####################################################################################

AddPositionIntoPatternListElement := proc(patternlistelement, position, totalpegs)
	local len, i;

	if patternlistelement[1] <> "PLE" then 
		ERROR(`Input is NOT a patternlistelement: `, patternlistelement);
	fi:
	
	len := nops(patternlistelement);
	
	for i from 5 to len do
		if patternlistelement[i][1] = "PLE" then 
	
			if IsInstanceOf(position, patternlistelement[i][2]) then	
				
				RETURN([op(1..4, patternlistelement), op(5..i - 1, patternlistelement),
					AddPositionIntoPatternListElement(patternlistelement[i], position, totalpegs),
					op(i + 1..len, patternlistelement)]);

				# ???? do we want to update the totalpegs here ????
	#			RETURN([op(1..3, patternlistelement), 
	#				totalpegs, op(5..i - 1, patternlistelement),
	#				AddPositionIntoPatternListElement(patternlistelement[i], position, totalpegs),
	#				op(i + 1..len, patternlistelement)]);
			fi:
		else
			break;
		fi:
	od:		
	
	[op(1..3, patternlistelement), 
		totalpegs, op(5..len, patternlistelement), position];
end:

#####################################################################################
# Get the total number of 1 bits in the binary expression of a number
#####################################################################################

GetTotalBits := proc(no)
	local i, total, remainder;
	
	total := 0;
	remainder := no;
	
	while remainder <> 0 do
		if remainder mod 2 <> 0 then
			total := total + 1;
		fi:
		
		remainder := iquo(remainder, 2);
	od:
	
	total;
end:

#####################################################################################
# Get the minimum number of pegs generated 
# before a new position should be added into the pattern
# 
# pattern is a list
# bRecursive should be true if to count all numbers in the list 
# (only to be used when called by itself recursively),
# false otherwise. 
#####################################################################################

GetRefreshRate := proc(pattern, bRecursive)
	local i, j, len, rate;
	
	len := nops(pattern):
	rate := 0;
	
	for i from 1 to len do
		if type(pattern[i], list) then
			rate := rate + GetRefreshRate(pattern[i], true);
		elif bRecursive then
			rate := rate + GetTotalBits(pattern[i]);
		fi:
	od:
	
	rate;
end:

#####################################################################################
# remove a list of positions/patterns from the pattern list, therefore the items
# in positions list may be exist in pattern list
#
# return the old patternlist, and positions list if the positions is a list of 
# positions instead of patterns;
# otherwise return the new patternlist, 
# and the list of elements in patternlist that are actually to be removed
#####################################################################################

RemovePositionsFromPatternList := proc(patternlist, positions)
	local i, j, lenlist, lenpos, returnpatternlist, pos1, lenp1, removepatternlist, removeposlist;

	returnpatternlist := patternlist;
	removepatternlist := [];
	removeposlist := [];
	lenlist := nops(patternlist);
	lenpos := nops(positions);
	
	
	for j from 1 to lenpos do
		# check if the position is a pattern
		pos1 := positions[j];
		lenp1 := nops(pos1);
		for i from 1 to lenp1 do
			if type(pos1[i], list) then
				break;
			fi:
		od:
		
		if i > lenp1 then
			# if the position is not a pattern, then add it to the remove list
			removeposlist := [op(removeposlist), pos1];
		else
			# if the position is a pattern, then add the corresponding patternlistelement 
			# into the remove list
			for i from 1 to lenlist do
				if returnpatternlist[i][2] = positions[j] then
					removepatternlist := [op(removepatternlist), returnpatternlist[i]];
					returnpatternlist := [op(1..i - 1, returnpatternlist), op(i + 1..lenlist, returnpatternlist)]:
#print(`removed: `, i, positions[j], returnpatternlist);		
					break;
				fi:
			od:

			if i > lenlist then
				ERROR(`position `, positions[j], ` not found in pattern list `, patternlist);
			fi:
		fi:
		
		lenlist := nops(returnpatternlist);
	od:
	
	returnpatternlist, [op(removepatternlist), op(removeposlist)];
end:

#####################################################################################
# remove a position from the position list
#
# returns the new positionlist
#####################################################################################

RemovePositionsFromPositionList := proc(positionlist, positions)
	local i, j, lenlist, lenpos, returnlist;

	returnlist := positionlist;
	lenlist := nops(positionlist);
	lenpos := nops(positions);
	
	for j from 1 to lenpos do
		for i from 1 to lenlist do
			if returnlist[i] = positions[j] then
				returnlist := [op(1..i - 1, returnlist), op(i + 1..lenlist, returnlist)]:
				
				break;
			fi:
		od:
#print(`removed: `, i, positions[j], returnlist);		

		if i > lenlist then
			ERROR(`position `, positions[j], ` not found in position list `, positionlist);
		fi:
				
		lenlist := nops(returnlist);
	od:

	returnlist;
end:

#####################################################################################
# moves must be a list of single moves
# each move must be a list of two elements of the form [x', y']
# where x' and y' are the relative coordinates of the pegs 
# to the one that is currently being inspected
# the move is to move positions [1, 0, 0] to [0, 1, 1] 
# with the actual coordinates of the pegs are determined by x's and y's
# Diaganal move is not allowed
# i.e. moves := [[[[-1, 0], [-2, 0]]]
#
# no return. Halt program if error
#####################################################################################

VerifyMoves := proc(moves)
	local i, j, lenmoves, onemove;
	
	lenmoves := nops(moves);
	
	for i from 1 to lenmoves do
		onemove := moves[i];
		if onemove[1][2] = 0 then
			# if the y coordinates of the first two items are the same 
			# then all ys must be the same, and xs form an arithematic series
			if onemove[2][2] <> 0 or 
					abs(onemove[1][1]) <> 1 or
					abs(onemove[2][1]) <> 2 or
					onemove[1][1] * onemove[2][1] < 0 then
				ERROR(`Illegal moves: all pegs must have the same y-values if they started this way`);
			fi:
		elif onemove[1][1] = 0 then
			# the same is true for xs
			if onemove[2][1] <> 0 or 
					abs(onemove[1][2]) <> 1 or
					abs(onemove[2][2]) <> 2 or
					onemove[1][2] * onemove[2][2] < 0 then
				ERROR(`Illegal moves: all pegs must have the same y-values if they started this way`);
			fi:
		else
			ERROR(`Illegal moves: all moves must be along the x-axis or the y-axis`);
		fi:
	od:
end:

#####################################################################################
# Find all the positions that can be generated directly from POS
# following the rules defined by moves
#
# POS is a matrix 
#
# returns a list of matrixes
#####################################################################################

NextPositions := proc(POS, moves)
	local icol, irow, j, maxrow, maxcol, newpos, onemove, lenmoves, 
		returnlist, xtemp1, ytemp1, xtemp2, ytemp2;
	
	maxcol := coldim(POS):
	maxrow := rowdim(POS):
	 	
	returnlist := [];
	lenmoves := nops(moves);
	
	for irow from 1 to maxrow do
		for icol from 1 to maxcol do
			#find any item whose value is 1
			if POS[irow, icol] = 1 then
				for j from 1 to lenmoves do
					onemove := moves[j];
					
					# check if the move is applicable to the item
					# i.e. it has two consequetive 0s in the neighborhood
					xtemp1 := icol + onemove[1][1];
					ytemp1 := irow + onemove[1][2];
					xtemp2 := icol + onemove[2][1];
					ytemp2 := irow + onemove[2][2];
#print(icol, irow, onemove, xtemp1, ytemp1, xtemp2, ytemp2, maxcol, maxrow);

					# the x and y coordinates must be within boundary
					if xtemp2 > 0 and xtemp2 <= maxcol and ytemp2 > 0 and ytemp2 <= maxrow then
						# the last two items must have 0 values
						if POS[ytemp1, xtemp1] = 0 and POS[ytemp2, xtemp2] = 0 then
							# now change the first one to 0 and the other two to 1s
							# and add the new result to returnlist
							newpos := submatrix(POS, 1..maxrow, 1..maxcol);
							newpos[irow, icol] := 0;
							newpos[ytemp1, xtemp1] := 1;
							newpos[ytemp2, xtemp2] := 1;
							
							returnlist := [op(returnlist), op(newpos)];
#print(returnlist, newpos, POS);
						fi:
					fi:
				od:
			fi:
		od:
	od:

#print(POS, returnlist);	
	returnlist:
end:

#####################################################################################
# Test if POS1 is an instance of POS2
# both can be symbolic
# assume they are trimed
#
# return true if POS1 is an instance of POS2, false otherwise
#####################################################################################

IsInstanceOf := proc(POS1, POS2)
	if ComparePositions(POS1, POS2) = nops(POS1) then
		RETURN(true);
	else
		RETURN(false);
	fi:	
end:

#####################################################################################
# Compare POS1 with POS2
# both can be symbolic
# assume they are trimed
#
# This method is by no means complete, 
# but it serves our purposes when used along with our methods
# to find symbolic positions
#			
# ???? for example, we do not know how to compare [[1, 0], 1] with [1, [0, 1]]	????
# 0, [1, 0], 1 -> [0, 1]
# 0, [1, 0], 1 -> [0, 1], 0, 1
# 1, [0, 1] -> [1, 0], 1
# [1, 0], 1, 0 -> [1, 0]
# [1, 0], 1, 0 -> [1, 0], 1, 0
# [1, 0, 1, 0] -> [1, 0]
# [1, 0] -> [1, 0, 1, 0]
#
# Because of the way that we generate patterns, i.e. [1,0,1,0,1,0,1,0] yields [1,0,[1,0]]
# we compare positions from left to right until we see things we do not like
#
# returns the length of POS1 if POS1 is an instance of POS2
# a positive number n less than the length POS1 if the first n letters is an instance of POS2
# otherwise -1, so that we can use the function recursively
#####################################################################################

ComparePositions := proc(POS1, POS2)
	local i, j, k, len1, len2, list2, lenlist2;
	
	len1 := nops(POS1);
	len2 := nops(POS2);

	i := 1:
	j := 1:
	
	while i <= len1 and j <= len2 do
#print(`beginning comparing: `, i, POS1, j, POS2);

		if type(POS1[i], integer) then
			# if POS1[i] is a number, then POS2[j] must be the same number
			# or a list 
		
			if type(POS2[j], integer) then
				if POS1[i] <> POS2[j] then
#print(`Not the same integer`, i, POS1, j, POS2);
					RETURN(-1);
				fi:
			else
				k := i + RecursivelyComparePositions([op(i..len1, POS1)], POS2[j]) - 1;
				
				# if the index for POS1 moved, and item in POS2 is a list
				# we might want to reuse the list item again
				if k >= i then
					j := j - 1;
				fi:
				i := k;
			fi:
		else
			# if POS1[i] is a list, then POS2[j] must be a list too
			if not type(POS2[j], list) then
#print(`POS1 is a list while POS2 is not: `, i, POS1, j, POS2);
				RETURN(-1);
			elif POS1[i] <> POS2[j] then
				k := i + RecursivelyComparePositions([op(i..len1, POS1)], POS2[j]) - 1;

				# if the index for POS1 moved, and item in POS2 is a list
				# we might want to reuse the list item again
				if k >= i then
					j := j - 1;
				fi:
				i := k;
			else
				j := j - 1:
			fi:
		fi:
#print(`end comparing: `, i, POS1, j, POS2);
		
		i := i + 1;
		j := j + 1;
	od:

	if i > len1 then
		if j > len2 then
			# if they both reach the end at the same time, it is a match
#print(`POS1, POS2 reach the end at the same time: `, i, POS1, j, POS2);
			RETURN(len1):
		else
			# otherwise, the leftover of POS2 must be list(s)
			for k from j to len2 do
				if not type(POS2[k], list) then
#print(`The leftover of POS2 is not list`, i, POS1, j, POS2);
					RETURN(-1);
				fi:
			od:
			
#print(`The leftover of POS2 is list`, i, POS1, j, POS2);
			RETURN(len1);	
		fi;	
	else
#print(`POS1 does not reach the end at the same time as POS2: `, i, POS1, j, POS2);
		# minus 1 because the loop adds 1 automatically
		RETURN(i - 1);
	fi:	
end:

#####################################################################################
# Similar to ComparePositions
# except that we compare POS1 against POS2 as many times as possible, 
# and return the index of the fist mismatch
# i.e. we compare POS1 and POS2, if the first part of POS1 is an instance of POS2,
# we keep comparing the leftover of POS1 to POS2, until the leftover is
# no longer an instance of POS2, 
# and we return the index of the last letter of the last occurrence of the instances
#####################################################################################

RecursivelyComparePositions := proc(POS1, POS2)
	local i, indx, len1;
	
	# Because POS2 is a list, we recursively call the function
	# to remove any letters that form the list
	# and add the number of letters removed from the sublist
	# back to i.
	i := 1;
	indx := 0;
	len1 := nops(POS1);
	
	while indx <> -1 do
		i := i + indx;
		indx := ComparePositions([op(i..len1, POS1)], POS2);
					
		# if there is nothing alike, get out of the loop
		if indx = 0 then
			break;
		fi:
	od:

	i - 1;
end:

#####################################################################################
# convert a position in matrix to a list
# by converting each row into an alphabeta
# i.e. a 3xn matrix will use eight letters
#####################################################################################

ConvertMatrixToList := proc(pos)
	local i, j, poslist, row, col, alpha;
	
	poslist := [];
	row := rowdim(pos);
	col := coldim(pos);
	
	for i from 1 to col do
		alpha := 0;
		
		for j from row by -1 to 1 do
			alpha := alpha * 2 + pos[j, i];
		od:
		
		poslist := [op(poslist), alpha];
	od:
	
	Trim(poslist):
end:

#####################################################################################
# Find the number of occurance of list2 in list1 started from the beginning of list1
#####################################################################################

NumOfOccuranceAtBeginning := proc(list1, list2)
	local len1, len2, listTemp, i, j, num;
	
	listTemp := list1;
	len1 := nops(listTemp);
	len2 := nops(list2);
	num := 0;
	
	while len1 >= len2 do
		if [op(1..len2, listTemp)] = list2 then
			num := num + 1;
		else
			break;
		fi:
		
		listTemp := [op(len2+1..len1, listTemp)];
		len1 := len1 - len2;
	od:
	
	num;
end:

#####################################################################################
# remove the 0s from the beginning and the end
# find the start and the end of both positions
#####################################################################################

Trim := proc(POS)
	local i, start1, end1;
	
	for i from 1 to nops(POS) while POS[i] = 0 do
	od:
	start1 := i;
	if start1 > nops(POS) then
		ERROR(`Invalid input: the first item is empty`):
	fi:
	for i from nops(POS) by -1 to 1 while POS[i] = 0 do
	od:
	end1 := i:
	
	[op(start1..end1, POS)];
end:

#####################################################################################
# assuming all positions are trimed
# find possible patterns for a newly found position
#
# returns the newly found pattern list, followed by the positions that generated the list
#####################################################################################

FindPatternInAllResults := proc(newpos, AllLists)
	local i, j, k, k1, k2, occurrence, lenall, 
		pattern, lenpattern, occlist, prefix, suffix, lenprefix, lensuffix,
		postemp, lentemp, num, patternlist, maxnum;
	lenall := nops(AllLists);
	
	for i from 1 to lenall do
		pattern := FindPatternInOnePosition(newpos, AllLists[i]);
		
		if pattern <> NULL then
			occlist := [seq(0, j = 1..MIN_OCCURRENCE * 10)];	# a list long enough
			occlist[pattern[1]] := 1; # the list is 0 based, i.e. the first index is 0 instead of 1
			
			prefix := pattern[3];
			suffix := pattern[4];
			pattern := pattern[2];

			lenpattern := nops(pattern);
			lenprefix := nops(prefix):
			lensuffix := nops(suffix);
			
			occlist := FillOccurrenceList(occlist, prefix, pattern, suffix, AllLists);
			
			# now let us find out if we can develop something out of it
			patternlist := GetPatternListFromOccurrenceList(occlist, prefix, pattern, suffix);
			
			if patternlist <> NULL then
				RETURN(patternlist);
			fi:
		fi:
	od:
end:
			
#####################################################################################
# record all positions that look like [prefix, pattern, ..., pattern, suffix]
# and fill the occurrence list of all occurrence of the pattern 
# within the list of all positions to the occlist
#####################################################################################

FillOccurrenceList := proc(occlist, prefix, pattern, suffix, AllLists)
	local j, num, lenpattern, lenprefix, lensuffix, 
		postemp, lentemp, newocclist, lenall;

	lenpattern := nops(pattern);
	lenprefix := nops(prefix):
	lensuffix := nops(suffix);
	lenall := nops(AllLists);
	newocclist := occlist;
	
	# record all positions that look like [prefix, pattern, ..., pattern, suffix]
	for j from 1 to lenall do
		postemp := AllLists[j];
		lentemp := nops(postemp);
				
		# record the occurrence of the newly found pattern in newocclist
		if lentemp >= lenprefix + lensuffix and 
				prefix = [op(1..lenprefix, postemp)] and 
				suffix = [op(lentemp - lensuffix + 1..lentemp, postemp)] then
			num := NumOfOccuranceAtBeginning([op(lenprefix + 1..lentemp - lensuffix, postemp)], pattern);
			if num * lenpattern = lentemp - lensuffix - lenprefix then
				newocclist[num + 1] := 1;
			fi:
		fi:
	od:
	
	newocclist;
end:

			
#####################################################################################
# Given an occurrence list of a pattern, we try to find out if there is enough
# occurrence of the pattern in a formulated manner to generate a patternlist,
# and thus confirm the pattern
#####################################################################################

GetPatternListFromOccurrenceList := proc(occlist, prefix, pattern, suffix)			
	local j, k, k1, k2, occurrence, realpattern, 
		lenpattern, num, patternlist, maxnum;

	# now let us find out if we can develop something out of it
	for maxnum from nops(occlist) by -1 to 1 while occlist[maxnum] = 0 do
		# maxnum is the maximum number of occurrence of the pattern
		# and it is at least MIN_OCCURRENCE
	od:
#print(occlist, maxnum);

	for j from maxnum - 1 by -1 to 1 do
		# if we find enough number of positions to support the pattern
		# record it
		if occlist[j] = 1 then
			for k from j - (maxnum - j) by -(maxnum - j) to 1 while occlist[k] = 1 do
			od:

			if (maxnum - k) / (maxnum - j) >= MIN_OCCURRENCE then
				patternlist := [];
				# we has need multiple copies of pattern as the real pattern
				# e.g. [1,0,0,1], [1,0,1,1,0,1], [1,0,1,1,1,10,1] yields [1,0,[1,1],0,1]
				# where pattern found will be [1] but the correct pattern is [1,1]
						
				for k1 from k + maxnum - j by maxnum - j to maxnum do
					# the occlist is 0 based
					patternlist := [op(patternlist), 
							[op(prefix), 
							seq(op(pattern), k2 = 1..k1 - 1), 
							op(suffix)]];
				od:
						
				realpattern := [op(prefix), [seq(op(pattern), k2 = 1..maxnum - j)], op(suffix)];

				RETURN(realpattern, patternlist);
			fi:
		fi:
	od:
end:

#####################################################################################
# assuming all positions are trimed
# given list1 can be extended from list2 by inserting in a pattern
# the pattern must occur at least MIN_OCCURRENCE times
#####################################################################################

FindPatternInOnePosition := proc(list1, list2)
	local i, j, occurrence, len1, len2, suffix, prefix, pattern;
	
	len1 := nops(list1);
	len2 := nops(list2);
	
	# the list1 has to be longer than list2
	if len1 < len2 then
		RETURN();
	fi:
	
	# find the prefix, the remainder of list2 will be the suffix
	# the index goes backward because for something like 
	# [1,0,1,0,1,0,1,0] compared to [1,0] can be represented as [1,0,[1,0]]
	for i from len2 + 1 by -1 to 1 do
		prefix := [op(1..i-1, list2)];
		suffix := [op(i..len2, list2)];
	
		# is the beginning and the end of list1 the same as list2?
		# find out if there is a pattern hidden if yes, return NULL otherwise
		if [op(1..i-1, list1)] = prefix and [op(len1-len2+i..len1, list1)] = suffix then
			# find possible patterns
			# if the occurrence is greater than the minimal
			# try to find the other instances to make the case
			pattern := CopiesOfSublist([op(i..len1-len2+i-1, list1)]);

			# we have to add one to the occurrence count because 0 is a count too
			pattern := pattern[1] + 1, pattern[2]; 

			if pattern[1] >= MIN_OCCURRENCE then
				RETURN(pattern[1], pattern[2], prefix, suffix);
			fi:
		fi:
	od:
end:

#####################################################################################
# find the number of copies if the list is a multiple copy of a proper sublist
# return the number, the sublist
# 1, list otherwise
# if the pattern is [0,1,0,1] instead of [0,1], it will be handled in FindPatternInAllResults
#####################################################################################

CopiesOfSublist := proc(list)
	local i, j, len, sublist, occurrence;
	
	len := nops(list);
	occurrence := 0;
	
	for i from 1 to len / 2 do
		if type(len / i, integer) then
			sublist := [op(1..i, list)];
		
			j := 1;
			occurrence := 0;
			while j <= len and  [op(j..j+i-1, list)] = sublist do
				j := j + i;
				occurrence := occurrence + 1;
			od:
		fi:
		
		if j > len then
			RETURN(occurrence, sublist);
		fi:
	od:

	1, list;	
end:

#####################################################################################
# Print msg if PRINT_RESULT is true or printlevel > 1
#
# msg is a string
#####################################################################################

PrintResult := proc()
	local msg, i;
	
	if PRINT_RESULT and printlevel > 1 then
		msg := ``;
		
		for i from 1 to nargs do
			msg := cat(msg, args[i]);
		od:
		
		print(msg);
	fi;
end: