#restart; read `d:/Aek/Rook/FSRook.txt`;

# September 1st, 2013
# Accompany my note:
# Rook Endgame Problem in Chess.
# Try to show the sharp upper bounds on 
# 3 by n board.


print(`Welcome to ShortRook, a Maple package written by`):
print(`Thotsaporn (Aek) Thanatipanonda with help from his`):
print(`brother Thotsaphon. First Version: September, 1st, 2013 `):
print():
print(`It accompanies the article: `):
print(`Rook Endgame Problem in Chess `):
print(` by Thotsaporn (Aek) Thanatipanonda`):
print(`available from authors' website`):

Help := proc()

if args = NULL then
print(` Part 1: PConj(k);`);
print(` Part 2: SymInduction(k)`);
print(` ` ); 
print(` For more info: type 'Help(Part1)' or 'Help(Part2)'` ); 

elif args = Part1 then
print(` Function: PConj(k);`);
print(` Input: the width of the board `);
print(` Output: conjectures of standard position`); 
print(` of a k by n board.`);
print(` `);
print(` Try  " PConj(3);  "`);

elif args = Part2 then
print(` Function: SymInduction(k);`);
print(` Input: the width of the board `);
print(` Output: the detials proof of the conjectures `);
print(` of standard positions on a k by n board`); 
print(` `);
print(` Try  " SymInduction(3);  "`);

fi:
end:




#####################################
# Section 1 : Back tracking search
# Section 2 : Provide the list of numbers 
# for each function f
# Section 3 : Conjectures
# Section 4 : Proof by induction
#####################################



########################################
# Section 1 : Back tracking search
# I modify as following 
# 1) Rook moves only 1st or 2nd rank.
# 2) No WR on 2nd rank if BK or WK on 2nd rank.
# 3) No WK on 2nd rank if WR on 2nd rank.
#
# Main Function:  BoardRook
# Other Functions: MateInOne, Sboard
# Aux Functons: BMBT, BM, WM, GenBKMoveBT, 
# GenBKMove, GenWKMove, GenWRMove, InCheck 
########################################

# board := [width, height, BK, WK, RK]:
# Run all the positions of an m by n board.

# Input: borad width and height m,n, 
# and option
# Output:
# no print info, no output, but update
# MT (mate table).

# Try: BoardRook(3,6);
BoardRook := proc(m,n)  option remember:
global MT:
local numMate, TempGone, Gone, board, s, P;

#Check Input
if m < 3 or n < 3 then
	ERROR();
fi:

# Update mate in one position
numMate := 1;
TempGone := MateInOne(m,n);
Gone := {};


while TempGone <> {} do
	numMate := numMate+1;
	Gone := TempGone union Gone;
	
	# Qualify positions
	P := {seq(op(BMBT(s)),s in TempGone)};
	TempGone := {};

	# board is a target position.
	for s in P do 	
		if BM(s) subset Gone then
			for board in WM(s) do 
			if not(InCheck(board)) and
			board[3] <> board[5] and
			not(member(board,Gone)) then
				TempGone := TempGone union {board};			
				MT[op(board)] := numMate;			
			fi:
			od:
		fi:
	od:  
	
od: 

return({}):
end:

#################################################
# Print out the position of mate in one
# on m by n board
# Try: MateInOne(3,6);
MateInOne := proc(m,n)
global MT:
local Temp,s,P,i,j,k;

# Vertical check
P := {
seq(seq(seq(SBoard([m,n,[1,i],[3,i],[j,k]])
,i=k+2..n),j=2..m),k=1..2),
seq(seq(seq(SBoard([m,n,[m,i],[m-2,i],[j,k]])
,i=k+2..n),j=1..m-1),k=1..2),

# Horizontal check
seq(seq(SBoard([m,n,[i,1],[i,3],[j,2]])
,j=1..i-2),i=1..m),
seq(seq(SBoard([m,n,[i,1],[i,3],[j,2]])
,j=i+2..m),i=1..m),
seq(seq(seq(SBoard([m,n,[i,n],[i,n-2],[j,k]])
,j=1..i-2),i=1..m),k=1..2),
seq(seq(seq(SBoard([m,n,[i,n],[i,n-2],[j,k]])
,j=i+2..m),i=1..m),k=1..2),


# Corner
seq(SBoard([m,n,[1,1],[2,3],[j,2]]),j=3..m),
seq(SBoard([m,n,[m,1],[m-1,3],[j,2]]),j=1..m-2),
seq(seq(SBoard([m,n,[1,n],[3,n-1],[j,k]])
,j=2..m),k=1..min(2,n-2)),
seq(seq(SBoard([m,n,[m,n],[m-2,n-1],[j,k]])
,j=1..m-1),k=1..min(2,n-2)),
seq(seq(SBoard([m,n,[1,n],[2,n-2],[j,k]])
,j=3..m),k=1..2),
seq(seq(SBoard([m,n,[m,n],[m-1,n-2],[j,k]])
,j=1..m-2),k=1..2)
}:

# Delete unwanted positions.
Temp := {};
for s in P do
	if s[4][2] <> 1 and
	  not(s[4][2] = 2 and s[5][2]=2) then
		Temp := Temp union {s};
	fi:
od:

P := Temp:
for s in P do
	MT[op(s)] := 1; 
od:
P;
end:


############################
# Speed up the procedure
############################

# Reverse Board
SBoard := proc(board) option remember;
local h,width,BKCol,WKCol,WRCol;

BKCol := board[3][1];
WKCol := board[4][1];
WRCol := board[5][1];
width := board[1];
h := ceil(width/2):

if BKCol > h or  ( width mod 2 = 1 and
((BKCol = h and WKCol > h) or
(BKCol = h and WKCol = h and WRCol > h)))
then
	return([board[1],board[2],
    [(width+1)-BKCol,board[3][2]],
	[(width+1)-WKCol,board[4][2]],
	[(width+1)-WRCol,board[5][2]]   ]);
		
else
	return(board);
fi:
end:


#####################################################
BMBT := proc(board) option remember;
local aek;

{seq(SBoard([board[1],board[2],aek,board[4],board[5]]),
aek in GenBKMoveBT(board))};
end:

# Black move
BM := proc(board) option remember;
local aek;

{seq(SBoard([board[1],board[2],aek,board[4],board[5]]),
aek in GenBKMove(board))};
end:

# White move
WM := proc(board) option remember;
local aek;
{seq(SBoard([board[1],board[2],board[3],board[4],aek]),
aek in GenWRMove(board))} union 
{seq(SBoard([board[1],board[2],board[3],aek,board[5]]),
aek in GenWKMove(board))};
end:


GenBKMoveBT := proc(board) option remember;
local ret, posWK, posWR, posBK, direct, directKing:

directKing := [[-1,  1], [0,  1], [1,  1], 
               [-1,  0],          [1,  0],
               [-1, -1], [0, -1], [1, -1]]:	

ret   := [];
posWK := board[4];
posWR := board[5];

for direct in directKing do
  posBK := [board[3][1]+direct[1], 
			board[3][2]+direct[2]];
        
  if posBK[1] >= 1 and posBK[1] <= board[1]
     and posBK[2] >= 1 and posBK[2] <= board[2]
     and max(abs(posBK[1]-posWK[1]), 
			 abs(posBK[2]-posWK[2])) > 1
	 # Added code here
	   and not(posBK[2]=2 and posWR[2]=2)
	 # Just in case
	 and posBK <> posWR 
	 
	 then
     ret := [op(ret) , posBK];
   fi;
od;

ret;
end:


# Output: list of possible black move.
# Try: GenBKMove([5,5,[2,2],[4,4],[5,2]]);

GenBKMove := proc(board) option remember;
local ret,posWK,posWR,posBK,direct,directKing,nb:

directKing := [[-1,  1], [0,  1], [1,  1], 
               [-1,  0],          [1,  0],
               [-1, -1], [0, -1], [1, -1]]:	

ret   := [];
posWK := board[4];
posWR := board[5];
nb := board:

for direct in directKing do
  posBK := [board[3][1]+direct[1], 
			board[3][2]+direct[2]];
  nb[3] := posBK:    
  if posBK[1] >= 1 and posBK[1] <= board[1]
     and posBK[2] >= 1 and posBK[2] <= board[2]
     and not(InCheck(nb))
     and max(abs(posBK[1]-posWK[1]), 
			 abs(posBK[2]-posWK[2])) > 1 then
        ret := [op(ret) , posBK];
   fi;
od;

ret;
end:


# Output: List of possible White King move.
# Try: GenWKMove([5,5,[2,4],[4,4],[5,5]]);

GenWKMove := proc(board) option remember;
local ret, posWK, posWR, posBK, direct, directKing;

directKing := [[-1,  1], [0,  1], [1,  1], 
               [-1,  0],          [1,  0],
               [-1, -1], [0, -1], [1, -1]]:	

ret   := [];
posBK := board[3];
posWR := board[5];

for direct in directKing do
    posWK := [board[4][1]+direct[1], 
			  board[4][2]+direct[2]];

        
    if posWK[1] >= 1 and posWK[1] <= board[1]
	   # Changed posWK[2] >= 2
       and posWK[2] >= 2 and posWK[2] <= board[2]
       # Added code here
	   and not(posWK[2] = 2 and posWR[2] =2) 
	   and max(abs(posWK[1]-posBK[1]), 
		   abs(posWK[2]-posBK[2])) > 1 
	   and posWK <> posWR	   then
       ret := [op(ret) , posWK];
    fi;
od;

ret;
end:

# Output: List of possible White Rook move
#         with constraint.
# Try: GenWRMove([5,5,[1,2],[3,2],[4,2]]);

GenWRMove := proc(board)   option remember;
local ret, posWK, posWR, posBK, direct, directRook;

directRook := [[1, 0], [-1, 0], [0, 1], [0, -1]]:
ret   := [];
posBK := board[3];    
posWK := board[4];
    
for direct in directRook do
    posWR := [board[5][1]+direct[1], 
			  board[5][2]+direct[2]];
        
    while posWR[1] >= 1 and posWR[1] <= board[1]
		 
		 # Changed posWR[2] <= 2
         and posWR[2] >= 1 and posWR[2] <= 2
		 # Added code here
		 and not(posWR[2]=2 and 
		        (posWK[2]=2 or posBK[2]=2))
		 and posWK <> posWR
		 do
         ret := [op(ret), posWR];

         posWR := [posWR[1]+direct[1], 
				   posWR[2]+direct[2]];
    od;
od;

ret;
end:



InCheck := proc(board) option remember;
local wrPos,bkPos,wkPos;

bkPos := board[3];
wkPos := board[4];
wrPos := board[5];

if bkPos <> wrPos and
   ((wrPos[1] = bkPos[1] 
	and (wkPos[1] <> wrPos[1] 
		 or wkPos[2] > max(wrPos[2], bkPos[2]) 
		 or wkPos[2] < min(wrPos[2], bkPos[2])))
or (wrPos[2] = bkPos[2]  
	and (wkPos[2] <> wrPos[2] 
		 or wkPos[1] > max(wrPos[1], bkPos[1]) 
		 or wkPos[1] < min(wrPos[1], bkPos[1])))) then
	return(true);
else
	return(false)
fi:
end:


##########################################
# Section 2 : Provide the list of 
# numbers for each function. 
#
# Main Function: AllF, EachF 
#########################################

# Ultimate data for all functions f to be
# guessed!
# Try: AllF(3,-2,6,6);

AllF := proc(width,R,MaxA,MaxB)
local ret,temp,h,i,j,k;

ret := [];
# prerun the data!
seq(BoardRook(width,i),i=4..MaxA+MaxB+(-R+1));

h := ceil(width/2);
for i from 1 to h do
for j from 1 to width do
for k from 1 to width do
if (i <> k or i = j) and (width mod 2 = 0 or
(not(i=h and j>h) and not(i=h and j=h and k>h))) then
	
	temp := EachF(width,R,[i,j,k],MaxA, MaxB):
	ret := [op(ret),[[i,j,k],temp]]:

fi:od:od:od:
ret:
end:



# Input: ( width of the board,R,W,
#          list of BK,WK,R in column, 
#          max of a, max of b)
# Output: 2D List of Number of Moves to Mate-a-b

# Try: EachF(3,-2,[2,2,1],6,4);
# Try: EachF(4,-1,[2,2,1],6,4);

EachF := proc(width,R,PosCol,aMax,bMax)
local bkCol, wkCol, wrCol, W, ret, a,b,i, j;
	
bkCol  := PosCol[1];
wkCol  := PosCol[2];
wrCol  := PosCol[3];


W := 4;

# prerun the data!
seq(BoardRook(width,i),i=W..aMax+bMax+W);

ret :=[seq([seq( MT[
		op(SBoard([width, a+b+W, 
      [bkCol, W+a], [wkCol, W], [wrCol, R+W]]))
	  ],b=0..aMax+bMax-a)],a=0..aMax)];	

for i from 0 to aMax do
	for j from 0 to aMax+bMax-i do
		if type(ret[i+1][j+1],integer) then
			ret[i+1][j+1] := ret[i+1][j+1]-i-j;
		else
			ret[i+1][j+1] := `X`;
		fi:
	od:
od:

ret;
end:


##############################################
# Section 3 : Provide a conjecture of each f
# 
# Main function:  Conj 
# Other functions: MakeConj, MakeOneConj
# Addition function for my paper:
# PConj, PrintConj
##############################################

# Output: [1,2,3] where
# 1 = [postion of BK, WK, WR], 
# 2 = [x] if a+b+x works for all or 
# [x,y] if a+b+x for even and a+b+y for odd
# 3 = exception for a = 0,1, ....
# 1111 = constant, mate in one, two, ....

# Try: 
# S:=AllF(3,-2,6,4);
# S:=AllF(4,-2,10,5):
# Conj(S);

Conj := proc(S)
local s: 
[seq(MakeConj(s),s in S)];
end:

MakeConj := proc(s)
local small,big,aek,L,run:

aek := [seq(MakeOneConj(s[2][i]),i=1..nops(s[2]))]:

# Make a meta conjecture here.
L := nops(aek):
if not(aek[L]=aek[L-1] and aek[L-1]=aek[L-2])  
and not(aek[L]=aek[L-2] and aek[L-1]=aek[L-3]) then
	ERROR(`More a's`,s):
fi:

run := L:
while run >= 3 and aek[run] = aek[run-2] do
	run := run-1:
od:

if run = 4 and aek[1]=aek[2] and aek[1] = `X` then
	small := []:
else
	small := [seq(aek[i], i =1..run-2)]:
fi:

if aek[run] = aek[run+1] then
	big := [aek[run]];
# Even n 
elif (L-1) mod 2 = 0 then
	big := [aek[L],aek[L-1]];
# Odd n
elif (L-1) mod 2 = 1 then
	big := [aek[L-1],aek[L]];
else
	ERROR():
fi:
return([s[1],big,small]):
end:

# Conjecture for each row
# look at the last 3 elements
MakeOneConj := proc(row)
local aek,ind;

ind := nops(row):

# Take the last three that is not `X`
if {seq(row[i],i=1..ind)} = {`X`} then
	return(`X`);
fi:

while row[ind] = `X` do
	ind := ind-1;
od:

aek := {row[ind]-row[ind-1],row[ind-1]-row[ind-2]};

# check it is a constant or decrasing by 1.
if nops(aek) =1 then
	if op(aek) = 0 then
		return(row[ind]):
	elif op(aek) = -1 then
		return(1111);
	elif op(aek) = 1 then
		return(100);
	else
		ERROR(`MakeOneConj`,row,aek):
	fi:
else
	return(200);
	#ERROR(`MakeOneConj, More b's`,row);
fi:
end:


#####################################
# Input: the width of the board
# Ouput: same as conj but also print out conj
# Try: PConj(3);
PConj := proc(n) option remember;
local S,T;

S:=AllF(n,-2,2*(n+1),n+1);
T := Conj(S); 
PrintConj(T);
end:

# Input: Conjectures
# Ouput: NULL, but print out conjectures.
PrintConj := proc(T) 
local f,a,b,t,i,low;

for t in T do
	if abs(t[1][1]-t[1][2])<2 then
		low := 2;
	else 
		low := 0;
	fi:

	for i from 1 to nops(t[3]) do
		if t[3][i] = 1111 then
			print( f(op(t[1])), `=`, 
			1, `for a =`, low+i-1);
		else
			print( f(op(t[1])), `<=`, 
			a+b+t[3][i], `for a =`, low+i-1);
		fi:
	od:

	low  := low+nops(t[3]);
	if nops(t[2]) = 1 then
		print( f(op(t[1])), `<=`, a+b+t[2][1],
		`for a >=`, low);
	else
		print( f(op(t[1])), `<=`, a+b+t[2][1],
		`for a is even and a >=`,low);
		print( f(op(t[1])), `<=`, a+b+t[2][2],
		`for a is odd and a >=`, low);
	fi:
	print(`###############`);
od:

return();
end:


#######################################
# Section 4: Do Induction Symbolically
# (this program is self-run) 
#
# Functions:
# 1.Main:
# SymInduction, 
# BaseCase, ProveS, 
# WTurn, BTurn, 
#
# 2.Moves:
# SymBKMove, SymWKMove, SymWRMove,
#
# 3.Update Board:
# NewWBoard, NewBBoard,
#
# 4.Read Conjectures:
# MoveThree, ConjThree, 
#
# 5.Sub-functions:
# State, SSBoard, FindMinA,
# 
# 6.Print:
# WPrint, BPrint, ConvertMove.


###########
# 1.Main:
###########
# SymInduction(width);
# Try: SymInduction(3):
SymInduction := proc(width)
local f,s;

if width <>3 then
	return(`NoCaseYet`);
fi:

# Check BaseCase
BaseCase(width);

# Check Induction
for s in State(width) do
	ProveS(width,s);
od:  
print(`The proof is done.`);
return():
end:


# Try: BaseCase(3);
BaseCase := proc(width)
local s,i,x,a,b,board;

# prerun the data!
seq(BoardRook(width,i),i=4..7);

for s in State(width) do
for i from 0 to 3 do
for x from 0 to i do
	if abs(s[1]-s[2]) >= 2 or x >=2 then
		board := [width,op(s),x,i-x,0];
		if MoveThree(board,a,b) <
	MT[width,4+i,[s[1],4+x],[s[2],4],[s[3],2]] then
		print(`BaseCase Is Wrong`,s,x,i-x);
		fi:
	fi:
od:
od:
od:  
end:


# Try: ProveS(3,[1,1,1]);
ProveS := proc(width,s)
local i,v,mina,board,a,b;

print(`####For `, f(op(s)),`####`);

v := ConjThree()[op(s)];

mina := FindMinA(s,nops(v[2]));

for i from 1 to nops(v[2]) do
	board := [width,op(s),i-1,b,0];
	WTurn(board,a,b);
od:

board := [width,op(s),a,b,0,mina];
WTurn(board,a,b);
board := [width,op(s),a,b,1,mina];
WTurn(board,a,b);
return();
end:


# board := [width,BK,WK,WR,a,b,parity,minimum of a];
# Try: WTurn([3,1,1,1,a,b,0,2],a,b);
# WTurn([3,1,1,1,a,b,1,2],a,b);
# WTurn([3,1,1,2,a,b,0,2],a,b);
WTurn := proc(board,a,b)
local w,whitemove,nb,champ,ret;

print(`#################`);
if not(type(board[5],integer)) then
	if board[7] = 0 then
		print(`Case a is even and a >=`, board[8]);
	else
		print(`Case a is odd and a>=`, board[8]);
	fi:
else
	print(`Case a is`, board[5]);
fi:
print(`#################`);

champ := MoveThree(board,a,b);           
# Find all white's moves
whitemove := [op(SymWRMove(board,a,b)),
			  op(SymWKMove(board,a,b))]; 

for w in whitemove do
	nb := NewWBoard(board,w,a,b);
	if simplify(BTurn(nb,a,b)+1-champ) <= 0  then
		WPrint(board,w);
		BPrint(nb,a,b);
		print(`Colclusion black lasts at most`,
		BTurn(nb,a,b)+1, "<=", champ, 
		`which is our assumption.`);
		return();
	fi;	
od:

ERROR(`WTurn, NoGoodMove, Might have to seperate cases.`);
end:


# Try: BTurn([3,1,1,2,a,b,0],a,b);
# BTurn([3,1,2,2,a-1,b,0],a,b);
BTurn := proc(board,a,b) option remember;
local nb, t, blackmove, S;

blackmove := SymBKMove(board,a,b);

# Checkmate
if blackmove = [] then
	return(0);
fi:

S := {};
for t in blackmove do 
	nb := NewBBoard(board,t,a,b);
	S := S union {MoveThree(nb,a,b)};
od:

max(op(S));
end:



##########
# 2.Moves:
##########
# Generate Black King Move
# Output: [BKCol, newa, newb, newpar];
# Try: SymBKMove([3,2,1,3,3,3,0],a,b);
SymBKMove := proc(board,a,b)
local ret, x, y, BKCol, WKCol, WRCol, 
width, direct, directKing, par;

directKing := [[-1,  1], [0,  1], [1,  1], 
               [-1,  0],          [1,  0],
               [-1, -1], [0, -1], [1, -1]]:
ret   := [];
width := board[1];
WKCol := board[3];
WRCol := board[4];

for direct in directKing do
    
	BKCol := board[2]+direct[1]:
	x := board[5]+direct[2]:
	y := board[6]-direct[2];
   
	if direct[2] <> 0 then
		par := (board[7]+1) mod 2;
	else 
		par := board[7];
	fi:

    if BKCol >= 1 and BKCol <= width and 
	(BKCol = WKCol or BKCol <> WRCol) 
	and (abs(BKCol-WKCol) >= 2  or 
	not(type(x,integer)) or x >= 2)   
	then
        ret := [op(ret), [BKCol,x,y,par]];
    fi;
od;

ret;
end:


# Generate White King Move
# Output: [4, WKCol, newa, newpar];
# Try: SymWKMove([3,2,1,3,3,3,0,2],a,b);
SymWKMove := proc(board,a,b)
local ret, x, BKCol, WKCol,
width, direct, directKing,par;

directKing := [[-1,  1], [0,  1], [1,  1], 
               [-1,  0],          [1,  0]]:

ret   := [];
width := board[1];
BKCol := board[2];

for direct in directKing do
	WKCol := board[3]+direct[1]:     
	x := board[5]-direct[2];
	if direct[2] = 1 then
		par := (board[7]+1) mod 2;
	else
		par := board[7];
	fi:

	if WKCol >= 1 and WKCol <= width 
    and ( abs(BKCol-WKCol) >= 2 or
		  (type(x,integer) and x >=3) or
		  ( not(type(x,integer)) and
		  (board[8] > 2 or 
		 (board[8]=2 and board[7]=1)))  ) then
       ret := [op(ret), [3,WKCol,x,par]];
	fi;
od;

ret;
end:


# Generate White Rook Move
# Output: [5, WRCol, newa,newpar];
# Try: SymWRMove([3,2,1,3,3,3,0],a,b);
SymWRMove := proc(board,a,b) 
local i;

# assume a >= 0
[seq([4,i,board[5],board[7]], i=1..board[1])];
end:



###################
# 3.Update Board:
###################
NewWBoard := proc(board,move,a,b)
local nb;

nb := board;
nb[move[1]] := move[2];
nb[5] := move[3];
nb[7] := move[4];
nb;
end:

NewBBoard := proc(board,move,a,b)
local nb;

nb := board;
nb[2] := move[1];
nb[5] := move[2];
nb[6] := move[3];
nb[7] := move[4];
nb;
end:


######################
# 4.Read Conjectures:
######################
# Number of move.
# Input: board, a,b.
# Try: MoveThree([3,2,1,3,a,b,0],a,b);
MoveThree := proc(board,a,b) option remember:
local v,pos,x,y,par:

if board[1] <> 3 then
	ERROR(`NoWidth`);
fi:

pos := SSBoard(3,[board[2],board[3],board[4]]);
x := board[5];
y := board[6];
if type(x,integer) then
	par := x mod 2;
else
	par := board[7];
fi:
v := ConjThree()[op(pos)]; 

if type(x,integer) and x+1 <= nops(v[2]) then
		if x = -1 or x = -2 then
			infinity;
		elif v[2][x+1] = 1111 then
			1;
		else
			x+y+v[2][a+1];
		fi:
elif nops(v[1]) = 1 then
	x+y+v[1][1];
elif  par = 0 then
    x+y+v[1][1];
elif par = 1 then
	x+y+v[1][2];
fi:
end:

ConjThree := proc() option remember;
local i,M;

M := [[[1, 1, 1], [1], []], 
[[1, 1, 2], [1, 0], []],
[[1, 1, 3], [1], []], 
[[1, 2, 2], [0], []],
[[1, 2, 3], [2, 1], []], 
[[1, 3, 2], [0, 1], [1111]],
[[1, 3, 3], [2, 1], [1111]], 
[[2, 1, 1], [2], []],
[[2, 1, 3], [2, 1], []], 
[[2, 2, 1], [1], []],
[[2, 2, 2], [1, 0], []]]:

table([seq(op(M[i][1])=[M[i][2],M[i][3]]
,i=1..nops(M))]);
end:



###################
# 5.Sub-functions:
###################
# Output: the list of all states.
State := proc(width) option remember;
local h,i,j,k,S;

S := [];
h := ceil(width/2):
for i from 1 to h do
for j from 1 to width do
for k from 1 to width do
if (i <> k or i = j) and (width mod 2 = 0 or
(not(i=h and j>h) and not(i=h and j=h and k>h))) then
	S := [op(S) ,[i,j,k]];
fi:od:od:od:

S:
end:


# Make to standard pos.
# Try: SSBoard(3,[2,2,3]);
SSBoard := proc(width,pos)
local h,bk,wk,wr;

bk := pos[1]:
wk := pos[2]:
wr := pos[3]:
h := ceil(width/2):

# reverse the position
if bk > h or  
( width mod 2 = 1 and
((bk = h and wk > h) or
(bk = h and wk = h and wr > h)))
then
	[(width+1)$3]-pos;	
else
	pos;
fi:
end:


# Find minimum of a to use in the induction.
FindMinA := proc(pos,k)

if abs(pos[1]-pos[2]) >= 2 then
	k;
else
	max(2,k);
fi:
end:



############
# 6.Print:
############
WPrint := proc(board,w)
local dir,word1;

if w[1] = 4 and board[4] <> w[2] then
	print(`White chooses to move Rook from Column`
	, board[4], `to Column`, w[2] );
elif w[1] = 4 and board[4] = w[2] then
	print(`White chooses to do the waiting move by`,
	`moving his Rook one square up`, 
	`or down the same column`);
else
	dir := [w[2]-board[3],board[5]-w[3]];
	word1 := op(ConvertMove(dir)); 

	print(`White chooses to move King in direction`,
	word1);
fi:
end:


# Try: BPrint([3,1,1,2,a,b,0],a,b);
# BPrint([3,1,2,2,a-1,b,0],a,b);
BPrint := proc(board,a,b)
local nb, t, blackmove, S, dir, word1, count, f;

blackmove := SymBKMove(board,a,b);

# Checkmate
if blackmove = [] then
	print(`Black is checkmated`);
	return();
fi:

S := {};
count := 0;	 	
for t in blackmove do 
	nb := NewBBoard(board,t,a,b);
	count := count+1;
	dir := [t[1]-board[2],t[2]-board[5]];
	word1 := op(ConvertMove(dir));
	print(`Subcase`, count,`:black's move is`,word1, 
	`which by induction assumption takes at most`,
	f_(nb[2],nb[3],nb[4])(nb[5],nb[6]), "=",
	MoveThree(nb,a,b),`moves to checkmate.`);
	S := S union {MoveThree(nb,a,b)};
od:
print(`max of these cases is`, max(op(S)),`moves`);
end:


# Make the output simpler
# Try: ConvertMove([1,1]);
ConvertMove := proc(Move)
local T;

T := table([
(-1,1)=[UpLeft],(0,1)=[Up],(1,1)=[UpRight],
(-1,0)=[Left],             (1,0)=[Right],
(-1,-1)=[DownLeft],(0,-1)=[Down],
(1,-1)=[DownRight]]):

T[op(Move)];
end: