# Experimental Math Rocks
# Math-640 Project: Explore Solitaire games using Depth First Search (DFS)
# Phil Benjamin

# DFS Application: Find Solution to Peg Solitaire Game
# Prefix for this application: PS

# Note: board is defined as list of
#	-1 out of bounds location
#	0 empty location
#	1 occupied location
# Moves of form: [1,1,0] --> [0,0,1] where locations are
#	in a row
#	in a column

# Global game parameters
PSboard := []:
PSnrow := 0:
PSncol := 0:
PSnwin := 0:

# Global play parameters
PSplay := []: # Members are triples [i,j,k] where [1,1,0] --> [0,0,1]
# Note: possible plays are searched in this order:
#	by row, left-to-right
#	by col, top-to-bottom
#	by row, right-to-left
#	by col, bottom-to-top
PSpotent := []: # List of potential moves
# Each element of PSpotent is a list of possible moves 
#	at this step of the game
PStimer := 0: # number of moves left, end at 0
PSdbg := 0: # turn on debugging for initial moves

# Build board and initialize play parameters
PSinit := proc()
	global PSboard,PSnrow,PSncol,PSnwin;
	global PSplay,PSpotent;
	global PStimer,PSdbg;
	local n,i,j;

	# Build rectangular board
	PSnrow := 5;
	PSncol := 5;
	n := PSnrow * PSncol;
	PSboard := [1$n];

	# Place forbidden squares (if any)

	# Place empty squares
	PSboard[PSrc2i(1,1)] := 0;

	# Initialize play parameters
	PSnwin := 1;
	PSplay := [];
	PSpotent := [];
	PStimer := 10000;
	PSdbg := 3;
end proc:

# Packages
with(ListTools):

# Debugging tool
PSDBG := proc(PSproc)
	global PSdbg;
	local n;
	if PSdbg = false then return; end if;
	n := nops(PSplay);
	if PSdbg < n then return; end if;
	print(cat(PSproc," n: ",convert(n,string)));
	if n > 0 then
		print(cat(PSproc," PSpotent: ",convert(PSpotent[n],string)));
		print(cat(PSproc," PSplay: ",convert(PSplay[n],string)));
	end if;
end proc:
	

# Standard control program
PScontrol := proc()
	local success;
	success := DFScontrol(PSinit,PSisTerm,
	PSprog,PSalt,PSback);
	if success then print(`Success`);
	else print(`Fail`);
	end if;
end proc:

# Toroidal control program
PSTcontrol := proc()
	local success;
	success := DFScontrol(PSinit,PSisTerm,
	PSTprog,PSalt,PSback);
	if success then print(`Success`);
	else print(`Fail`);
	end if;
end proc:

PSisTerm := proc()
	global PSboard,PSnwin;
	local b1;
	b1 := SearchAll(1,PSboard);
	if nops([b1]) > PSnwin then return false; end if;

	# Could test for perfect win here ...
	return PSboard[PSrc2i(1,1)] = 1;
#	return true;
end proc:

# Utility function: r,c --> i (row and column to board index)
# Return 0 if out of bounds
PSrc2i := proc(r,c)
	global PSnrow, PSncol;
	if r < 1 or r > PSnrow then return 0; end if;
	if c < 1 or c > PSncol then return 0; end if;
	return PSncol*(r-1) + c;
end proc:

# Toriodal version of PSrc2i: never returns 0!
PSTrc2i := proc(r,c)
	global PSnrow, PSncol;
	local r1,c1;
	r1 := 1 + ((r - 1) mod PSnrow);
	c1 := 1 + ((c - 1) mod PSncol);
	return PSncol*(r1-1) + c1;
end proc:

# Standard version
PSprog := proc()
	global PSboard,PSnrow,PSncol,PSplay,PSpotent,PStimer;
	local PSpotentNew,play;
	local r1,c1,r2,c2,r3,c3,i1,i2,i3; # indices for potential moves
	local n;

	# Check timer first
	if PStimer = 0 then return false; end if;
	PStimer := PStimer - 1;

	# Build list of potential moves
	PSpotentNew := [];
	for r1 from 1 to PSnrow do
	for c1 from 1 to PSncol do
		i1 := PSrc2i(r1,c1);
		if PSboard[i1]<>1 then next; end if;

		# Try by row, left-to-right
		r2 := r1; c2 := c1 + 1; r3 := r1; c3 := c2 + 1;
		i2 := PSrc2i(r2,c2); i3 := PSrc2i(r3,c3);
		if i2>0 and i3>0 and PSboard[i2]=1 and PSboard[i3]=0 then
			PSpotentNew := [op(PSpotentNew),[i1,i2,i3]];
		end if;

		# Try by col, top-to-bottom
		r2 := r1 + 1; c2 := c1; r3 := r2 + 1; c3 := c2;
		i2 := PSrc2i(r2,c2); i3 := PSrc2i(r3,c3);
		if i2>0 and i3>0 and PSboard[i2]=1 and PSboard[i3]=0 then
			PSpotentNew := [op(PSpotentNew),[i1,i2,i3]];
		end if;

		# Try by row, right-to-left
		r2 := r1; c2 := c1 - 1; r3 := r1; c3 := c2 - 1;
		i2 := PSrc2i(r2,c2); i3 := PSrc2i(r3,c3);
		if i2>0 and i3>0 and PSboard[i2]=1 and PSboard[i3]=0 then
			PSpotentNew := [op(PSpotentNew),[i1,i2,i3]];
		end if;

		# Try by col, bottom-to-top
		r2 := r1 - 1; c2 := c1; r3 := r2 - 1; c3 := c2;
		i2 := PSrc2i(r2,c2); i3 := PSrc2i(r3,c3);
		if i2>0 and i3>0 and PSboard[i2]=1 and PSboard[i3]=0 then
			PSpotentNew := [op(PSpotentNew),[i1,i2,i3]];
		end if;

	end do; end do;

	if PSpotentNew = [] then return false; end if;
	play := PSpotentNew[1];

	# Update PSboard, PSplay, and PSpotent
	PSboard[play[1]] := 0; PSboard[play[2]] := 0; PSboard[play[3]] := 1;
	PSplay := [op(PSplay),play];
	PSpotent := [op(PSpotent),PSpotentNew];
PSDBG("PSprog");
	return true;
end proc:

# Toroidal version
PSTprog := proc()
	global PSboard,PSnrow,PSncol,PSplay,PSpotent,PStimer;
	local PSpotentNew,play;
	local r1,c1,r2,c2,r3,c3,i1,i2,i3; # indices for potential moves
	local n;

	# Check timer first
	if PStimer = 0 then return false; end if;
	PStimer := PStimer - 1;

	# Build list of potential moves
	PSpotentNew := [];
	for r1 from 1 to PSnrow do
	for c1 from 1 to PSncol do
		i1 := PSTrc2i(r1,c1);
		if PSboard[i1]<>1 then next; end if;

		# Try by row, left-to-right
		r2 := r1; c2 := c1 + 1; r3 := r1; c3 := c2 + 1;
		i2 := PSTrc2i(r2,c2); i3 := PSTrc2i(r3,c3);
		if i2>0 and i3>0 and PSboard[i2]=1 and PSboard[i3]=0 then
			PSpotentNew := [op(PSpotentNew),[i1,i2,i3]];
		end if;

		# Try by col, top-to-bottom
		r2 := r1 + 1; c2 := c1; r3 := r2 + 1; c3 := c2;
		i2 := PSTrc2i(r2,c2); i3 := PSTrc2i(r3,c3);
		if i2>0 and i3>0 and PSboard[i2]=1 and PSboard[i3]=0 then
			PSpotentNew := [op(PSpotentNew),[i1,i2,i3]];
		end if;

		# Try by row, right-to-left
		r2 := r1; c2 := c1 - 1; r3 := r1; c3 := c2 - 1;
		i2 := PSTrc2i(r2,c2); i3 := PSTrc2i(r3,c3);
		if i2>0 and i3>0 and PSboard[i2]=1 and PSboard[i3]=0 then
			PSpotentNew := [op(PSpotentNew),[i1,i2,i3]];
		end if;

		# Try by col, bottom-to-top
		r2 := r1 - 1; c2 := c1; r3 := r2 - 1; c3 := c2;
		i2 := PSTrc2i(r2,c2); i3 := PSTrc2i(r3,c3);
		if i2>0 and i3>0 and PSboard[i2]=1 and PSboard[i3]=0 then
			PSpotentNew := [op(PSpotentNew),[i1,i2,i3]];
		end if;

	end do; end do;

	if PSpotentNew = [] then return false; end if;
	play := PSpotentNew[1];

	# Update PSboard, PSplay, and PSpotent
	PSboard[play[1]] := 0; PSboard[play[2]] := 0; PSboard[play[3]] := 1;
	PSplay := [op(PSplay),play];
	PSpotent := [op(PSpotent),PSpotentNew];
PSDBG("PSTprog");
	return true;
end proc:
		
PSalt := proc()
	global PSboard,PSplay,PSpotent,PStimer;
	local play,k,n;

	# Check timer first
	if PStimer = 0 then return false; end if;
	PStimer := PStimer - 1;

	n := nops(PSplay); # also nops(PSpotent)
	if n = 0 then return false; end if;
	play := PSplay[n];
	k := Search(play,PSpotent[n]);
	if k = 0 or k = nops(PSpotent[n]) then return false; end if;

	# Undo current play
	PSboard[play[1]] := 1; PSboard[play[2]] := 1; PSboard[play[3]] := 0;

	# Update PSboard and PSplay with new play
	play := PSpotent[n][k+1];
	PSboard[play[1]] := 0; PSboard[play[2]] := 0; PSboard[play[3]] := 1;
	PSplay := [op(1..n-1,PSplay),play];
PSDBG("PSalt");
	return true;
end proc:

PSback := proc()
	global PSboard,PSplay,PSpotent,PStimer;
	local play,k,n;

	# Check timer first
	if PStimer = 0 then return false; end if;
	PStimer := PStimer - 1;

	n := nops(PSplay); # also nops(PSpotent)
	if n = 0 then return false; end if;
	play := PSplay[n];

	# Undo current play, PSplay, PSpotent
	PSboard[play[1]] := 1; PSboard[play[2]] := 1; PSboard[play[3]] := 0;
	PSplay := [op(1..n-1,PSplay)];
	PSpotent := [op(1..n-1,PSpotent)];
	n := nops(PSplay); # also nops(PSpotent)
PSDBG("PSback");
	return true;
end proc:

# Experimental Results
# Note: Experiments limited to 100000 function calls to prog,alt,back
# Board: 4x4 one hole:
#	1 left if hole at [1,2]
#	2 left if hole at other places
# Board: 4x5 one hole:
#	1 left if hole at [1,2] or [2,3]
#	2 left if hole at other places
# Board: 5x5 one hole:
#	3 left if hole at [3,3]
# Standard board:
#	1 left in center hole after 50525 function calls
# European board:
#	2 not successful in 500000 function calls
#	3 successful in 30324 function calls
# Toroidal board: 3x3
#	1 left in corner
# Toroidal board: 4x4
#	1 left in corner
# Toroidal board: 5x5
#	1 left in corner
#	needed 3120 function calls
#	Final play list:
#	[3, 2, 1], [5, 1, 2], [11, 6, 1], [1, 2, 3],
#	[3, 4, 5], [8, 7, 6], [10, 6, 7], [12, 7, 2],
#	[14, 15, 11], [16, 21, 1], [1, 2, 3], [17, 22, 2],
#	[2, 3, 4], [4, 5, 1], [18, 23, 3], [19, 24, 4],
#	[4, 3, 2], [2, 1, 5], [25, 20, 15], [15, 11, 12],
#	[12, 13, 14], [14, 9, 4], [4, 5, 1]]