#####                              #     #                             
 #     # #    # ######  ####   ####  ##   ##   ##   #    # ###### #####  
 #       #    # #      #      #      # # # #  #  #  #   #  #      #    # 
 #       ###### #####   ####   ####  #  #  # #    # ####   #####  #    # 
 #       #    # #           #      # #     # ###### #  #   #      #####  
 #     # #    # #      #    # #    # #     # #    # #   #  #      #   #  Last update:
  #####  #    # ######  ####   ####  #     # #    # #    # ###### #    # June 9, 2011

##################################################################################
#  For optimum display of ASCII labels, this line should not be broken until here --------------------->|
#
#
#  Contents:
#  Conventions   ---- The conventions and data structures.
#  Moves  --- The moves for chess pieces
#  PuzzleSolve  --- Solves a given puzzle to get black in checkmate
#  ChessDraw  --  Draws a given chess configuration
#  Generation --- Procedures to generate a puzzle.
#
#
#
#


  #####                                                                  
 #     #  ####  #    # #    # ###### #    # ##### #  ####  #    #  ####  
 #       #    # ##   # #    # #      ##   #   #   # #    # ##   # #      
 #       #    # # #  # #    # #####  # #  #   #   # #    # # #  #  ####  
 #       #    # #  # # #    # #      #  # #   #   # #    # #  # #      # 
 #     # #    # #   ##  #  #  #      #   ##   #   # #    # #   ## #    # 
  #####   ####  #    #   ##   ###### #    #   #   #  ####  #    #  ####  
################################################################################
#Conventions
#
#
# Board Convention: 
#  A list of triples representing the pieces on the board
#  of the form [[i,j],"Piece",color].
#
# Size Convention: 
#  The board is size m*n where m is the number of
#  columns (width) and n the number of rows (height)
#
# Coordinates Convention: 
#  [i,j] is i to the right and j up from the origin (bottom left corner)
#
# Piece Convention: 
#  King - "K", Queen - "Q", Rook - "R",
#  Knight - "N", Bishop - "B", Pawn - "P"
#
# Color Convention: 
#  White - 0, Black - 1
#  White will play from the "bottom" of the board and black from the "top"
#
# Move Convention
#  A move is a quadruple [[i,j],[i1,j1],"Piece",color] where [i,j] are the
#  initial coordinates and [i1,j1] the final coordinates
#
##################################################################################



# __  __                     
#|  \/  |                    
#| \  / | _____   _____  ___ 
#| |\/| |/ _ \ \ / / _ \/ __|
#| |  | | (_) \ V /  __/\__ \
#|_|  |_|\___/ \_/ \___||___/
#                           
# Written by Susan Durst, Simao Herdade, Matthew Samuel and David Wilson
#                           

print(`Moves by Susan Durst, Simao Herdade, Matthew Samuel and David Wilson`):
print(`Run MovesHelp() for more information on the programs`):

MovesHelp:=proc()

if args=NULL then
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Main Procedure:`):
  print(`Moves(B,m,n,color)`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Sub-Procedures:`):
  print(`InCheck(B,m,n,color)`):
  print(`KingMoves(B,m,n,type,color,KC)`):
  print(`KnightMoves(B,m,n,type,color,NC)`):
  print(`RookMoves(B,m,n,type,color,loc)`):
  print(`BishopMoves(B,m,n,type,color,loc)`):
  print(`QueenMoves(B,m,n,type,color,loc)`):
  print(`Also some Sub-Sub-Procedures!`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`For more information on a procedure or sub-procedure`):
  print(`run MovesHelp again with 323123123#ame of the procedure as`):
  print(`the argument, i.e. MovesHelp(Moves)`):
  print(`Running MovesHelp(Conventions) will provide a list of`):
  print(`conventions for inputs.`):
  
  
elif nargs=1 and args[1]=Conventions then
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Board Convention: `):
  print(`A list of triples representing the pieces on the board`):
  print(`of the form [[i,j],"Piece",color].`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Size Convention: `):
  print(`The board is size m*n where m is the number of`):
  print(`columns (width) and n the number of rows (height)`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Coordinates Convention: `):
  print(`[i,j] is i to the right and j up from the origin (bottom left corner)`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Piece Convention: `):
  print(`King - "K", Queen - "Q", Rook - "R",`):
  print(`Knight - "N", Bishop - "B", Pawn - "P"`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Color Convention: `):
  print(`White - 0, Black - 1`):
  print(`White will play from the "bottom" of the board and black from the "top"`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Move Convention: `):
  print(`A move is a quadruple [[i,j],[i1,j1],"Piece",color] where [i,j] are the`):
  print(`initial coordinates and [i1,j1] the final coordinates`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  
  
elif nargs=1 and args[1]=Moves then
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Moves(B,m,n,color):`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Inputs: A board, B, of size m*n with the next move to be color`):
  print(`Outputs: A list of pairs of the form [B,M] where B is the new`):
  print(`         board and M is the move to get there`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):

elif nargs=1 and args[1]=InCheck then
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`InCheck(B,m,n,color):`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Inputs: A board, B, of size m*n and a color`):
  print(`Outputs: true if the given color is in check, false otherwise`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):

elif nargs=1 and args=KingMoves then
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`KingMoves(B,m,n,type,color,loc):`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Inputs: A board, B, of size m*n, a color, type (should be "K") `):
  print(`        and the position loc (of the form [i,j]) of that color's king`):
  print(`Outputs: A list of all possible moves that king can make`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):

elif nargs=1 and args=KnightMoves then
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`KnightMoves(B,m,n,type,color,loc):`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Inputs: A board, B, of size m*n, a color, type (should be "N") `):
  print(`        and the position loc (of the form [i,j]) of that color's knight`):
  print(`Outputs: A list of all possible moves that knight can make`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):

elif nargs=1 and args=RookMoves then
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`RookMoves(B,m,n,type,color,loc):`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Inputs: A board, B, of size m*n, a color, type (should be "R") `):
  print(`        and the position loc (of the form [i,j]) of that color's rook`):
  print(`Outputs: A list of all possible moves that rook can make`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):

elif nargs=1 and args=BishopMoves then
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`BishopMoves(B,m,n,type,color,loc):`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Inputs: A board, B, of size m*n, a color, type (should be "B") `):
  print(`        and the position loc (of the form [i,j]) of that color's bishop`):
  print(`Outputs: A list of all possible moves that bishop can make`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):

elif nargs=1 and args=QueenMoves then
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`QueenMoves(B,m,n,type,color,loc):`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):
  print(`Inputs: A board, B, of size m*n, a color, type (should be "Q") `):
  print(`        and the position loc (of the form [i,j]) of that color's queen`):
  print(`Outputs: A list of all possible moves that queen can make`):
  print(`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`):

fi:

end:






########################################################################
#
# David Wilson's Moves Procedure
#
########################################################################

#Moves(B,m,n,color)
Moves:=proc(B,m,n,color) local M,i,IC,P,curm,CurM,CM:

#M: the set of possible moves
M:={}:

#CM: 0 if not in checkmate, 1 if in checkmate,
CM:=1:

#IC: 0 if not in check, 1 if in check, -1 if in checkmate
if InCheck(B,m,n,color) then
  IC:=1:
else
  IC:=0:
fi:

for i from 1 to nops(B) do
  P:=B[i]:
  CurM:={}:
  
  if P[3]=color then
    if P[2]="K" then
      CurM:=KingMoves(B,m,n,"K",color,P[1]):
    elif P[2]="Q" then
      CurM:=QueenMoves(B,m,n,"Q",color,P[1]):
    elif P[2]="R" then
      CurM:=RookMoves(B,m,n,"R",color,P[1]):
    elif P[2]="B" then
      CurM:=BishopMoves(B,m,n,"B",color,P[1]):
    elif P[2]="N" then
      CurM:=KnightMoves(B,m,n,"N",color,P[1]):
    elif P[2]="P" then
      CurM:=PawnMoves(B,m,n,"P",color,P[1]):
    else
      ERROR(`Piece is not K,Q,R,B,N or P`):
    fi:
  fi:

  CurM:=convert(CurM,set):

  for curm in CurM do
    if InCheck(curm[1],m,n,color) then
      CurM:=CurM minus {curm}:
    else
      if IC=1 then
        CM:=0:
      fi:
    fi:
  od:
M:=M union CurM:
 
od:

if IC=1 and CM=1 then
  RETURN(1):
fi:

M:=[op(M)]:

RETURN(M):

end:




#RMoves(B,m,n,color)
RMoves:=proc(B,m,n,color) local M,i,P,curm,CurM:

#M: the set of possible moves
M:={}:

for i from 1 to nops(B) do
  P:=B[i]:
  CurM:={}:
  
  if P[3]=color then
    if P[2]="K" then
      CurM:=RKingMoves(B,m,n,"K",color,P[1]):
    elif P[2]="Q" then
      CurM:=QueenMoves(B,m,n,"Q",color,P[1]):
    elif P[2]="R" then
      CurM:=RookMoves(B,m,n,"R",color,P[1]):
    elif P[2]="B" then
      CurM:=BishopMoves(B,m,n,"B",color,P[1]):
    elif P[2]="N" then
      CurM:=KnightMoves(B,m,n,"N",color,P[1]):
    elif P[2]="P" then
      CurM:=PawnMoves(B,m,n,"P",color,P[1]):
    else
      ERROR(`Piece is not K,Q,R,B,N or P`):
    fi:
  fi:

  CurM:=convert(CurM,set):

  if color=0 then
    for curm in CurM do
      if nops(B)>nops(curm[1]) then
        CurM:=CurM minus {curm}:
      elif InCheck(B,m,n,1) and InCheck(curm[1],m,n,1) then
        CurM:=CurM minus {curm}:
      fi:
    od:
  else
    for curm in CurM do
      if nops(B)>nops(curm[1]) then
        CurM:=CurM minus {curm}:
      elif InCheck(curm[1],m,n,0) then
        CurM:=CurM minus {curm}:
      fi:
    od:
  fi:

  M:=M union CurM:
 
od:

M:=[op(M)]:

RETURN(M):

end:


#RKingMoves(B,m,n,type,color,KC)
#Inputs: a board B, size, color of King and the location of King
#Outputs: a list of possible resulting boards (ignoring Check) for king 
#	in the form [ [B1,move1], [B2,move2], ..]

RKingMoves:=proc(B,m,n,type,color,KC) local i,j,Neis,pt,Mov:
i:=KC[1]:
j:=KC[2]:

Neis:={[i+1,j],[i-1,j],[i,j+1],[i,j-1],[i+1,j-1],[i-1,j+1],
   [i+1,j+1],[i-1,j-1]}:

Mov:={}:
for pt in Neis do

 if color=0 then
  if InBoard(pt,m,n)  and {pt} intersect Positions(B,color)={} 
    and not InCheck(MovstoBoards(B,{[[i,j],pt,"K",color]},color,"K")[1][1],m,n,color) 
  then
   Mov:=Mov union {[[i,j],pt,"K",color]}:
  fi:
 else
  if InBoard(pt,m,n)  and {pt} intersect Positions(B,color)={} then
   Mov:=Mov union {[[i,j],pt,"K",color]}:
  fi:

 fi:

od:

#Mov:
MovstoBoards(B,Mov,color,"K");

end:



########################################################################
#
# Matthew Samuel's InCheck Procedure
#   (Slight editing by David Wilson)
#
########################################################################

#inbetween(z,x,y): z,x,y integers
#check if z is strictly between x and y
#read "z is in between x and y"
inbetween:=proc(z,x,y)
	evalb(min(x,y)<z and max(x,y)>z):
end:

#same45diagonal(p1,p2): check if points p1, p2 on the same 45 degree diagonal
same45diagonal:=proc(p1,p2)
	evalb(p1[1]-p1[2]=p2[1]-p2[2]):
end:

#same135diagonal(p1,p2): check if points p1, p2 on the same 135 degree diagonal
same135diagonal:=proc(p1,p2)
	evalb(p1[1]+p1[2]=p2[1]+p2[2]):
end:

#InCheck(B,m,n,color): check if color's king is in check
#true if in check, false if not in check, FAIL if there's no king
#strategy: check every piece of the opposite color and see if it can attack the king
#NOTICE WE DON'T USE m AND n!
InCheck:=proc(B,m,n,color) local i, j, k, king, piece, piece2, between:
	#find our color's king
	i:=1:
	while B[i][2]<>"K" or B[i][3]<>color do
		i:=i+1:
		if i>nops(B) then
			#no king!
			RETURN(FAIL):
		end:
	end:
	
	#found the king
	king:=B[i]:
	
	#loop over the other pieces, check if any can take the king
	for j from 1 to nops(B) do
		
		#we only care if the piece is not our color
		if B[j][3]=color then
			#piece is our color, move to the next piece
			next:
		end:
		
		piece:=B[j]:
		
		#check cases
		if piece[2]="K" then
			#king can attack if it is at most one away in any direction
			if abs(piece[1][1]-king[1][1])<=1 and abs(piece[1][2]-king[1][2])<=1 then
				RETURN(true):
			end:
		elif piece[2]="N" then
			#knight: one coordinate differs by 1, the other differs by 2
			if {abs(piece[1][1]-king[1][1]),abs(piece[1][2]-king[1][2])}={1,2} then
				RETURN(true):
			end:
		elif piece[2]="P" then
			#pawn: attacks forward, diagonally
			if color=0 then
				#white pawn needs to move up
				if king[1][2]-piece[1][2]=1 and abs(king[1][1]-piece[1][1])=1 then
					#pawn attacks; we're in check
					RETURN(true):
				end:
			else
				#black pawn moves down
				if piece[1][2]-king[1][2]=1 and abs(king[1][1]-piece[1][1])=1 then
					#pawn attacks; we're in check
					RETURN(true):
				end:
			end:
		end:
		
		#the next two cases are not mutually exclusive, so can't use elif
		
		if piece[2]="Q" or piece[2]="R" then 
			#queen or rook can attack along rows or columns
			if piece[1][1]=king[1][1] then
				#in the same column, check for something in between
				between:=false:
				for k from 1 to nops(B) do
					piece2:=B[k]:
					if piece2[1][1]=piece[1][1] and inbetween(piece2[1][2],piece[1][2],king[1][2]) then
						#something is in between
						between:=true:
						break:
					end:
				end:
				
				#anything in between?
				if between=false then
					RETURN(true): #no; we are indeed in check
				end:
			elif piece[1][2]=king[1][2] then
				#same row; same idea
				between:=false:
				for k from 1 to nops(B) do
					piece2:=B[k]:
					if piece2[1][2]=piece[1][2] and inbetween(piece2[1][1],piece[1][1],king[1][1]) then
						#something is in between
						between:=true:
						break:
					end:
				end:
				
				#anything in between?
				if between=false then
					RETURN(true): #no; we are indeed in check
				end:
			end:
		end:
		
		if piece[2]="Q" or piece[2]="B" then 
			#queen or bishop can attack along diagonals
			if same45diagonal(piece[1],king[1]) then
				#same 45 degree diagonal, again check if something in between
				between:=false:
				for k from 1 to nops(B) do
					piece2:=B[k]:
					if same45diagonal(piece[1],piece2[1]) and inbetween(piece2[1][1],piece[1][1],king[1][1]) then
						#something is in between
						between:=true:
						break:
					end:
				end:
				
				#anything in between?
				if between=false then
					RETURN(true): #no; we are indeed in check
				end:
			elif same135diagonal(piece[1],king[1]) then
				#same 135 degree diagonal
				between:=false:
				for k from 1 to nops(B) do
					piece2:=B[k]:
					if same135diagonal(piece[1],piece2[1]) and inbetween(piece2[1][1],piece[1][1],king[1][1]) then
						#something is in between
						between:=true:
						break:
					end:
				end:
				
				#anything in between?
				if between=false then
					RETURN(true): #no; we are indeed in check
				end:
			end:
		end:
		
	end:
	#after all that, nothing attacks
	false:
end:


########################################################################
#
# Simao Herdade's Move Procedures
#   (Slight editing by David Wilson)
#
########################################################################

#InBoard(pt,m,n)
#Checks if a square pt is 
#inside the m x n board or not

InBoard:=proc(pt,m,n) local i,j:
i:=pt[1]: 
j:=pt[2]:

evalb(1<=i and i<=m and 1<=j and j<=n):

end:

#Positions(B,Colour)
#outputs the set of positions of the list B
#occupied by pieces of the Colour inputed.
#	It will be used to avoid
#moving a piece to a square occupied
#by a piece of the same colour 

Positions:=proc(B,color) local k,S:

S:={}:
for k from 1 to nops(B) do:
	if B[k][3]=color then
	S:=S union {B[k][1]}:
	fi:
od:
S:
end:

#KingMoves(B,m,n,type,color,KC)
#Inputs: a board B, size, color of King and the location of King
#Outputs: a list of possible resulting boards (ignoring Check) for king 
#	in the form [ [B1,move1], [B2,move2], ..]

KingMoves:=proc(B,m,n,type,color,KC) local i,j,Neis,pt,Mov:
i:=KC[1]:
j:=KC[2]:

Neis:={[i+1,j],[i-1,j],[i,j+1],[i,j-1],[i+1,j-1],[i-1,j+1],
   [i+1,j+1],[i-1,j-1]}:

Mov:={}:
for pt in Neis do
 if InBoard(pt,m,n)  and {pt} intersect Positions(B,color)={} 
   and not InCheck(MovstoBoards(B,{[[i,j],pt,"K",color]},color,"K")[1][1],m,n,color) 
 then
  Mov:=Mov union {[[i,j],pt,"K",color]}:
 fi:
od:

#Mov:
MovstoBoards(B,Mov,color,"K");

end:


#From the set Mov of all possible moves for a piece
# MovstoBoards produces the list of pairs of resulting 
# boards and moves from which they were obtained
#	in the form [ [B1,move1], [B2,move2], ..]

MovstoBoards:=proc(B,Mov,color,piece) local BS,BT,Ot, go, Board,k:
Ot:=[]:

for go in Mov do:
	
	BS:=convert(B,set):
	BT:=BS:
	#in case out move eats a piece let us take it out
	# in here it can only eat a piece of the other color
	# since out moves don't intersect pieces of the same clr
	for k from 1 to nops(B) do: 
	if BS[k][1]=go[2] then
	BT:=BS minus {BS[k]}:
	fi:
	od:

	Board:=BT minus {B[FindPiece(B,piece,color)]} union {[go[2],piece,color]}:
	Board:=[seq(Board[h],h=1..nops(Board))]:
	Ot:=[op(Ot),[Board,go]]:
od:

Ot;
end:

#FindPiece is a procedure that just 
# outputs the entry of the list B where
# the piece (type,color) is

FindPiece:=proc(B,type,color) local l:
for l from 1 to nops(B) do	
	#print(evalb(B[l][2]=type),evalb(B[l][3]=0)):
	if	B[l][2]=type and B[l][3]=color	then
	RETURN(l):
	fi:
od:
end:

#KnightMoves(B,m,n,type,color,NC)
#Inputs: a board B, size, color of Knight and the location of Knight
#Outputs: a list of possible resulting boards (ignoring Check) for knight 
#	in the form [ [B1,move1], [B2,move2], ..]

KnightMoves:=proc(B,m,n,type,color,NC) local i,j,Neis,pt,Mov:
i:=NC[1]:
j:=NC[2]:

Neis:={[i+2,j+1],[i+2,j-1],[i-2,j+1],[i-2,j-1],[i+1,j+2],[i-1,j+2],
   [i-1,j-2],[i+1,j-1]}:

Mov:={}:
for pt in Neis do
 if InBoard(pt,m,n)  and {pt} intersect Positions(B,color)={} then
  Mov:=Mov union {[[i,j],pt,"N",color]}:
 fi:
od:


#Mov:

MovstoBoards(B,Mov,color,"N");

end:


########################################################################
#
# Susan Durst's Move Procedures
#   (Slight editing by David Wilson)
#
########################################################################

#==================================================

#NewBoard(B,loc1,loc2): Inputs a board and two locations
#and outputs a new board with a single piece moved 
#from loc1 to loc2, capturing the piece at loc2 if 
#appropriate.

NewBoard:=proc(B,loc1,loc2) local b,p,N:

N:=convert(B,set):

for b in B do
 if b[1]=loc2 then
  N:=N minus {b}:
 elif b[1]=loc1 then
  N:=N minus {b} union {[loc2,b[2],b[3]]}:
 fi:
od:

N:

end:

#==================================================

#FriendSpaces(B,color): Inputs a board B and a color, and 
#outputs the set of coordinates of all pieces of the
#same color.

FriendSpaces:=proc(B,color) local S,p:

S:={}:

for p in B do
 if p[3]=color then
  S:=S union {p[1]}:
 fi:
od:

S:

end:

#==================================================

#EnemySpaces(B,color): Inputs a board B and a color, and 
#outputs the set of coordinates of all pieces of the
#opposite color.

EnemySpaces:=proc(B,color) local S,p:

S:={}:

for p in B do
 if p[3]<>color then
  S:=S union {p[1]}:
 fi:
od:

S:

end:

#==================================================

WestMoves:=proc(B,m,n,type,color,loc) local L,S,c:

L:=[loc[1]-1,loc[2]]:
S:={}:
c:=0:

while c=0 do
 
 if L[1]=0 then
  c:=1:

 elif member(L,FriendSpaces(B,color)) then
  c:=1:

 elif member(L,EnemySpaces(B,color)) then
  S:=S union {L}:
  c:=1:

 else
  S:=S union {[NewBoard(B,loc,L),[loc,L,type,color]]}:
  L:=[L[1]-1,L[2]]:

 fi:

od:

S:

end:

#==================================================

EastMoves:=proc(B,m,n,type,color,loc) local L,S,c:

L:=[loc[1]+1,loc[2]]:
S:={}:
c:=0:

while c=0 do
 
 if L[1]=m+1 then
  c:=1:

 elif member(L,FriendSpaces(B,color)) then
  c:=1:

 elif member(L,EnemySpaces(B,color)) then
  S:=S union {L}:
  c:=1:

 else
  S:=S union {[NewBoard(B,loc,L),[loc,L,type,color]]}:
  L:=[L[1]+1,L[2]]:

 fi:

od:

S:

end:

#==================================================

NorthMoves:=proc(B,m,n,type,color,loc) local L,S,c:

L:=[loc[1],loc[2]+1]:
S:={}:
c:=0:

while c=0 do
 
 if L[2]=n+1 then
  c:=1:

 elif member(L,FriendSpaces(B,color)) then
  c:=1:

 elif member(L,EnemySpaces(B,color)) then
  S:=S union {L}:
  c:=1:

 else
  S:=S union {[NewBoard(B,loc,L),[loc,L,type,color]]}:
  L:=[L[1],L[2]+1]:

 fi:

od:

S:

end:


#==================================================

SouthMoves:=proc(B,m,n,type,color,loc) local L,S,c:

L:=[loc[1],loc[2]-1]:
S:={}:
c:=0:

while c=0 do
 
 if L[2]=0 then
  c:=1:

 elif member(L,FriendSpaces(B,color)) then
  c:=1:

 elif member(L,EnemySpaces(B,color)) then
  S:=S union {L}:
  c:=1:

 else
  S:=S union {[NewBoard(B,loc,L),[loc,L,type,color]]}:
  L:=[L[1],L[2]-1]:

 fi:

od:

S:

end:

#==================================================

NorthEastMoves:=proc(B,m,n,type,color,loc) local L,S,c:

L:=[loc[1]+1,loc[2]+1]:
S:={}:
c:=0:

while c=0 do
 
 if L[1]=m+1 or L[2]=n+1 then
  c:=1:

 elif member(L,FriendSpaces(B,color)) then
  c:=1:

 elif member(L,EnemySpaces(B,color)) then
  S:=S union {L}:
  c:=1:

 else
  S:=S union {[NewBoard(B,loc,L),[loc,L,type,color]]}:
  L:=[L[1]+1,L[2]+1]:

 fi:

od:

S:

end:

#==================================================

SouthEastMoves:=proc(B,m,n,type,color,loc) local L,S,c:

L:=[loc[1]+1,loc[2]-1]:
S:={}:
c:=0:

while c=0 do
 
 if L[1]=m+1 or L[2]=0 then
  c:=1:

 elif member(L,FriendSpaces(B,color)) then
  c:=1:

 elif member(L,EnemySpaces(B,color)) then
  S:=S union {L}:
  c:=1:

 else
  S:=S union {[NewBoard(B,loc,L),[loc,L,type,color]]}:
  L:=[L[1]+1,L[2]-1]:

 fi:

od:

S:

end:

#==================================================

SouthWestMoves:=proc(B,m,n,type,color,loc) local L,S,c:

L:=[loc[1]-1,loc[2]-1]:
S:={}:
c:=0:

while c=0 do
 
 if L[1]=0 or L[2]=0 then
  c:=1:

 elif member(L,FriendSpaces(B,color)) then
  c:=1:

 elif member(L,EnemySpaces(B,color)) then
  S:=S union {L}:
  c:=1:

 else
  S:=S union {[NewBoard(B,loc,L),[loc,L,type,color]]}:
  L:=[L[1]-1,L[2]-1]:

 fi:

od:

S:

end:

#==================================================

NorthWestMoves:=proc(B,m,n,type,color,loc) local L,S,c:

L:=[loc[1]-1,loc[2]+1]:
S:={}:
c:=0:

while c=0 do
 
 if L[1]=0 or L[2]=n+1 then
  c:=1:

 elif member(L,FriendSpaces(B,color)) then
  c:=1:

 elif member(L,EnemySpaces(B,color)) then
  S:=S union {L}:
  c:=1:

 else
  S:=S union {[NewBoard(B,loc,L),[loc,L,type,color]]}:
  L:=[L[1]-1,L[2]+1]:

 fi:

od:

S:

end:

#==================================================

RookMoves:=proc(B,m,n,type,color,loc):

NorthMoves(B,m,n,type,color,loc) union SouthMoves(B,m,n,type,color,loc) union EastMoves(B,m,n,type,color,loc) union WestMoves(B,m,n,type,color,loc):

end:

#==================================================

BishopMoves:=proc(B,m,n,type,color,loc):

NorthWestMoves(B,m,n,type,color,loc) union SouthEastMoves(B,m,n,type,color,loc) union NorthEastMoves(B,m,n,type,color,loc) union SouthWestMoves(B,m,n,type,color,loc):

end:

#==================================================

QueenMoves:=proc(B,m,n,type,color,loc):

RookMoves(B,m,n,type,color,loc) union BishopMoves(B,m,n,type,color,loc):

end:







#   ______                    _             _____      _            
#  (_____ \                  | |           (   __)    | |           
#   _____) )_   _ _____ _____| | ____       \ \   ___ | |_   _ ____ 
#  |  ____/| | | (___  |___  ) |/ _  )       \ \ / _ \| | | | / _  )
#  | |     | |_| |/ __/ / __/| ( (/ /    _____) ) |_| | |\ V ( (/ / 
#  |_|      \____(_____|_____)_|\____)  (______/ \___/|_| \_/ \____)
#
#  Created by Jacob Baron, Taylor Burmeister, CK Lee, Brian Nakamura, 
#             Tim Naumovitz, Matthew Russel


print(` PuzzleSolve created by Jacob Baron, Taylor Burmeister, CK Lee, Brian Nakamura, Tim Naumovitz, Matthew Russel `):
print(` Run SolveHelp() for more information on procedures. `):


SolveHelp:=proc()

if args=NULL then
  print(` Main procedures: `):
  print(` SolveGameK(B,m,n,K), BeforeMateK(B,m,n,K) `):
  print(` `):
  print(` Primary sub-procedures: `):
  print(` MoveTreeK(B,m,n,K), CheckmateTree(MTK1), MinCheckmate(MTK1) `):
  print(` ReverseStepsK(B,m,n,K) `):
  print(` `):
  print(` For information on a specific procedure, run SolveHelp(procedure_name); `):
  print(` For example, try SolveHelp(SolveGameK); `):
  print(` `):
  print(` For the convention of a MTK (Move Tree of depth K), run SolveHelp(MTK); `):

elif nargs=1 and args[1]=SolveGameK then
  print(` SolveGameK(B,m,n,K): `):
  print(` INPUTS: a board configuration (B) with White to play, dimensions of the     `):
  print(` board (m and n), and the number of moves (K) that White is allowed to make `):
  print(` `):
  print(` OUTPUT: a MTK encoding White's minimum length winning strategies (within K moves) `):
  print(` `):
  print(` Note: run SolveHelp(MTK); for information on the data structure `):
  print(` `):

elif nargs=1 and args[1]=BeforeMateK then
  print(` BeforeMateK(B,m,n,K): `):
  print(` INPUTS: a board configuration (B) where Black is in a checkmated configuration, ` ):
  print(` dimensions of the board (m and n), and the number of White moves to backtrack (K) `):
  print(` `):
  print(` OUTPUT: the set of all board configurations that could have occurred K White moves ago`):
  print(` `):
  print(` Note: this procedure will backtrack 2K-1 moves total (White + Black moves) `):
  print(` `):

elif nargs=1 and args[1]=MoveTreeK then
  print(` MoveTreeK(B,m,n,K): `):
  print(` INPUTS: a board configuration (B) with White to play, dimensions of the     `):
  print(` board (m and n), and the number of moves (K) that White is allowed to make `):
  print(` `):
  print(` OUTPUT: the MTK encoding all sequences of White and Black moves (up to K White moves) `):
  print(` `):
  print(` Note: run SolveHelp(MTK); for information on the data structure `):
  print(` `):

elif nargs=1 and args[1]=CheckmateTree then
  print(` CheckmateTree(MTK1): `):
  print(` INPUT: a MTK encoding all sequences of White and Black moves (up to K White moves) `):
  print(` `):
  print(` OUTPUT: a MTK (representing a subtree of MTK1) that encodes all of White's winning strategies `):
  print(` `):
  print(` Notes: the input of this procedure should be the output of MoveTreeK, `):
  print(`        run SolveHelp(MTK); for information on the data structure     `):
  print(` `):

elif nargs=1 and args[1]=MinCheckmate then
  print(` MinCheckmate(MTK1): `):
  print(` INPUT: a MTK encoding all of White's winning strategies (up to K White moves) `):
  print(` `):
  print(` OUTPUT: a MTK (representing a subtree of MTK1) that encodes White's winning strategies `):
  print(` of minimum length `):
  print(` `):
  print(` Notes: the input of this procedure should be the output of CheckmateTree, `):
  print(`        run SolveHelp(MTK); for information on the data structure `):
  print(` `):

elif nargs=1 and args[1]=ReverseStepsK then
  print(` ReverseStepsK(B,m,n,K): `):
  print(` INPUTS: a board configuration (B), dimensions of the board (m and n), and the number `):
  print(` of TOTAL moves (White + Black moves) to backtrack (K) beginning with a White move `):
  print(` `):
  print(` OUTPUT: the set of all board configurations that could have occurred K TOTAL moves ago`):
  print(` `):
  print(` Note: this procedure will backtrack K TOTAL moves beginning with a White move, so `):
  print(` the number of White moves = ceiling(K/2) and number of Black moves = floor(K/2) `):
  print(` `):

elif nargs=1 and args[1]=MTK then
  print(` MTK (Move Tree of depth K): `):
  print(` Encodes the sequences of White/Black moves from a starting configuration up to K total moves. `):
  print(` The data structure is an "encoded" digraph [V,E,M] where each vertex represents a board       `):
  print(` configuration and there is a directed edge from v1 to v2 if the board configuration of v2     `):
  print(` can be achieved by one move from v1. `):
  print(` `):
  print(` The inner structure of the digraph [V,E,M] is as follows: `):
  print(` V - set of vertices {1, .., n} `):
  print(` E - set of edges {[u1,v1], [u2,v2], ...}, where [ui,vi] is the directed edge from vertex ui to vi `):
  print(` M - set of maps/correspondences {[1,vert1], [2,vert2], .. }, where verti=[Bi,mi,statusi,depthi] `):
  print(` (board configuration Bi, previous move mi, current status statusi, and distance from first `):
  print(` configuration depthi) `):
  print(` `):
  print(` NOTE: status=1 denotes checkmate, status=-1 denotes stalemate, status=0 denotes neither `):
  print(` `):

else
  print(` Invalid input(s) into SolveHelp. Run SolveHelp(); to see a list of procedures. `):
fi:

end:


####################
#
# Written by Brian Nakamura and Matthew Russel
#
####################

# Attempts to solve the game represented in the board configuration B
# with White to play and win in K (White) moves
SolveGameK:=proc(B,m,n,K)
local MTK,CMT:

MTK:=MoveTreeK(B,m,n,2*K-1):
CMT:=CheckmateTree(MTK):
RETURN(MinCheckmate(CMT)):

end:



# Inputs a configuration where Black is in checkmate and returns the 
# set of possible configurations K (White) moves ago
BeforeMateK:=proc(B,m,n,K)
ReverseStepsK(B,m,n,2*K-1):
end:



####################
#
# Written by Tim Naumovitz
#   (Edited by Brian Nakamura)
#
####################

#ReverseStepsK(B,m,n,K):
#Inputs:
#- a board configuration B where Black is in checkmate
#- dimensions of board m & n
#- number of steps K to reverse
#Outputs:
#- the set of configurations S={B1,B2,..} that could have occurred K moves
#prior to the checkmate
ReverseStepsK:=proc(B,m,n,K)
ReverseStepsColorK(B,m,n,K,0):
end:



#ReverseStepsColorK(B,m,n,K,color): implements ReverseStepsK
#recursively, keeping track of whose turn it is.
ReverseStepsColorK:=proc(B,m,n,K,color) local p,S,l,L:
option remember:
if K=0 then
 RETURN({B}):
fi:
S:={}:
L:=RMoves(B,m,n,color):
for l in L do
 #Making a backwards move can't result in the opposing player being in check.
 if not InCheck(l[1],m,n,color+1 mod 2) then
  #White is never in check
  if not InCheck(l[1],m,n,0) then
   S:=S union ReverseStepsColorK(l[1],m,n,K-1,color+1 mod 2):
  fi:
 fi:
od:
S:
end:
 



####################
#
# Written by Jake Baron
#   (Edited by Brian Nakamura)
#
####################

# Creates a MTK of depth K starting with the board configuration B
MoveTreeK:=proc(B,m,n,K):
MoveTreeHelper(m,n,K,0, [ {1}, {}, {[1,[B,{},status(B,m,n,1),0]]} ] ):
end:



MoveTreeHelper:=proc(m,n,K,whosemove,treesofar)
local L,leaves,i,j,k,moves,mo,V,E,M,Vnew,Enew,Mnew,a,newmover:
option remember:

if K=0 then
  RETURN(treesofar):
fi:

V:=treesofar[1]: Vnew:=V:
E:=treesofar[2]: Enew:=E:
M:=treesofar[3]: Mnew:=M:
newmover:=`mod`(whosemove+1,2):

L:=max(seq(M[i][2][4], i=1..nops(M))):
leaves:={}:
for i from 1 to nops(V) do
  if M[i][2][4]=L then
    leaves:=leaves union {i}
  fi:
od:

for j in leaves do
  moves:=Moves(M[j][2][1],m,n,whosemove):

  if moves<>1 then
    a:=nops(Vnew):
    Vnew:=Vnew union {seq(i+nops(Vnew),i=1..nops(moves))}:
    Enew:=Enew union {seq([j,i+a],i=1..nops(moves))}:
    for k from 1 to nops(moves) do
      mo:=moves[k]:
      Mnew:={op(Mnew), [a+k,[mo[1],mo[2],status(mo[1],m,n,whosemove),L+1]] }:
    od:

  fi:
od:

MoveTreeHelper(m,n,K-1,newmover,[Vnew,Enew,Mnew]):

end:



# check "status" of board (note that whenever it's white's move, there is neither checkmate nor stalemate)
# "status" of board: 1=checkmate, -1=stalemate, 0=neither
status:=proc(B,m,n,whosemove) local i,board,newboards,piecesleft:
option remember:

if whosemove=0 then
  if Moves(B,m,n,1)=1 then
    RETURN(1):
  elif Moves(B,m,n,1)=[] then
    RETURN(-1):
  else
    RETURN(0):
  fi:
else
  RETURN(0):
fi:

end:



# check "status" of board (note that whenever it's white's move, there is neither checkmate nor stalemate)
# "status" of board: 1=checkmate, -1=stalemate, 0=neither
statusOLD:=proc(B,m,n,whosemove) local i,board,newboards,piecesleft:

if whosemove=0 or Moves(B,m,n,1)<>[] then
  RETURN(0):
else
  newboards:={ seq( Moves(B,m,n,0)[i][1], i=1..nops(Moves(B,m,n,0))) }:
  piecesleft:={ seq(nops(board), board in newboards) }:
  if piecesleft<>{nops(B)} then
    RETURN(1):      # white can take black's king
  else
    RETURN(-1):
  fi:
fi:

end:



####################
#
# Written by C.K. Lee
#
####################

# Inputs an MTK and outputs a subtree MTK that encodes all of White's winning strategies
CheckmateTree:=proc(MTK) local S,T,v:
 T:=MTK:
 S:=lab(T):
 T[1]:=T[1] minus S:
 for v in T[3] do
  if evalb(v[1] in S) then
   T[3]:=T[3] minus {v}:
  fi:
 od:
 for v in T[2] do
  if not evalb(v[1] in T[1]) or not evalb(v[2] in T[1]) then
   T[2]:=T[2] minus {v}:
  fi:
 od:
 return T:
end:


###
findleaf:=proc(T) local L,NL,edge,v,P:
 NL:={}:
 L:=T[1]:
 for edge in T[2] do
  NL:=NL union {edge[1]}:
 od:
 L:=L minus NL:
 return L:
end:


###
child:=proc(MTK,v) local C,u:
 C:={}:
 for u in MTK[2] do
  if u[1]=v then
   C:=C union {u[2]}:
  fi:
 od:
 return C:
end:


###
lab:=proc(T) local F,L1,v,s,Md,S:
 Md:=0:
 F:={}:
 S:={0}:
 L1:=findleaf(T):
 for v in T[3] do
  if evalb(v[1] in L1) then
   if v[2][3]<>1 then
    F:=F union {v[1]}:
   fi:
   if v[2][4]>Md then
    Md:=v[2][4]:
   fi:
  fi:
 od:
 Md:=Md-1:
 while Md>=0 do
  for v in T[3] do
   if v[2][4]= Md then
    if not evalb(v[1] in L1) then
     if type(Md,odd) and (child(T,v[1]) intersect F)<>{} then
      F:=F union {v[1]}:
     elif type(Md,even) and (child(T,v[1]) subset F) then 
      F:=F union {v[1]}:
     fi:
    fi:
   fi:
  od: 
  Md:=Md-1:
 od:
 F:=F minus {1}:
 while S<>{} do
  S:={}:
  for s in F do
   S:=S union child(T,s):
  od:
  S:=S minus F:
  F:=F union S: 
 od:
 return F:
end:



####################
#
# Written by Brian Nakamura and Taylor Burmeister
#
####################

# Inputs an MTK containing White's winning strategies and returns the one(s) of minimum length
# (assuming that Black makes optimal moves for itself as well)
MinCheckmate:=proc(MTK)
local childrenlist,n,i,e,branchdepth,depths,mindepth,L,v,MTK2:

n:=max(MTK[1]):

childrenlist:=[{}$n]:

# create childrenlist [C1,C2,..,Cn], with Ci=children of vertex i
for e in MTK[2] do
  childrenlist:=[op(1..e[1]-1,childrenlist), childrenlist[e[1]] union {e[2]}, op(e[1]+1..n,childrenlist)]:
od:

for i from 1 to n do
  if member(i,MTK[1]) and childrenlist[i]={} then
    childrenlist:=[op(1..i-1,childrenlist), {-1}, op(i+1..n,childrenlist)]:
  fi:
od:

branchdepth:=[]:
depths:={}:

for v in childrenlist[1] do
  if v<2 then
    RETURN(FAIL):
  fi:

  branchdepth:=[op(branchdepth), [v,BranchDepth(childrenlist,v)]]:
  depths:=depths union {BranchDepth(childrenlist,v)}:

od:

mindepth:=min(depths):

MTK2:=MTK:

for L in branchdepth do
  if L[2]<>mindepth then
    MTK2:=KillBranch(MTK2,childrenlist,1,L[1]):
  fi:
od:

MTK2:

end:



# Finds the depth from vertex v down the rest of the branch
BranchDepth:=proc(CL,v)
local S,c1:
option remember:

if CL[v]={} then
  ERROR(`BranchDepth hit a non-existant vertex.`):
elif CL[v]={-1} then
  RETURN(0):
else
  S:=CL[v]:
  RETURN(max(seq(BranchDepth(CL,c1),c1 in S))+1):
fi:

end:



# Kills off the branch beginning at vertex v (whose parent is u)
KillBranch:=proc(MTK,CL,u,v)
local V,E,M,m1,MTK2,S,s1:

V:=MTK[1]:
E:=MTK[2]:
M:=MTK[3]:

if CL[v]={} then
  ERROR(`KillBranch hit a non-existant vertex.`):
elif CL[v]={-1} then
  V:=V minus {v}:
  E:=E minus {[u,v]}:
  
  for m1 in M while m1[1]<>v do od:
  M:=M minus {m1}:
  RETURN([V,E,M]):
else
  S:=CL[v]:
  V:=V minus {v}:
  E:=E minus {[u,v]}:
  
  for m1 in M while m1[1]<>v do od:
  M:=M minus {m1}:
  MTK2:=[V,E,M]:

  for s1 in S do
    MTK2:=KillBranch(MTK2,CL,v,s1):
  od:

  RETURN(MTK2):

fi:

end:





#UniqueMate(MTK): inputs the output of MoveTreeK
#and outputs the subtree of all sequences of moves
#that will cause White to checkmate.
#
#To do this, we prune off all leaves that are not
#checkmates, then repeat until we have the subtree
#or an empty tree (FAIL).
UniqueMate:=proc(MTK) local depth,k,MMTK:

#First find depth of tree
depth:=max(seq(m[2][4], m in MTK[3])):

MMTK:=MTK:

#We need to prune at most "depth" times, and
#redundant prunes are okay (won't do anything).
for k from 1 to depth do
  MMTK:=Prune(MMTK):
od:

MMTK:

end:



#IsLeaf(n, E): inputs a vertex number and an edge set
#and outputs true if that vertex is a leaf, false 
#if not.
IsLeaf:=proc(n, E) local e:

for e in E do
  if e[1]=n then
    return(false):
  fi:
od:

return(true):

end:



#Prune(MTK): inputs a chess tree and outputs that
#tree with all leaves that are not checkmates removed.
Prune:=proc(MTK) local V,E,M,v,e,m,status:

V:=MTK[1]: E:=MTK[2]: M:=MTK[3]:

for v in MTK[1] do
  for m in MTK[3] do
    if m[1]=v then
      status:=m[2][3]:
    fi:
  od:
  #Remove vertex from tree if a non-checkmate leaf
  if IsLeaf(v,E) and evalb(status<>checkmate) then
    V:=V minus {v}:
    for e in MTK[2] do
      if e[2]=v then
        E:=E minus {e}:
      fi:
    od:
    for m in MTK[3] do
      if m[1]=v then
        M:=M minus {m}:
      fi:
    od:
  fi:
od:

[V,E,M]:

end:



#  ._______  .______          ___   ____    __    ____  ______  __    __   _______     _______.  _______.
#  |       \ |   _  \        /   \  \   \  /  \  /   / /      ||  |  |  | |   ____|   /       | /       |
#  |  .--.  ||  |_)  |      /  ^  \  \   \/    \/   / |  ,----'|  |__|  | |  |__     |   (----`|   (----`
#  |  |  |  ||      /      /  /_\  \  \            /  |  |     |   __   | |   __|     \   \     \   \    
#  |  '--'  ||  |\  \----./  _____  \  \    /\    /   |  `----.|  |  |  | |  |____.----)   |.----)   |   
#  |_______/ | _| `._____/__/     \__\  \__/  \__/     \______||__|  |__| |_______|_______/ |_______/    
#                                                                                                        
#  Written by Andrew Baxter, Justin Gilmer, Jocelyn Quaintance, and Emily Sergel
#  

print(`DrawChess by Andrew Baxter, Justin Gilmer, Jocelyn Quaintance, and Emily Sergel`):
print(`Run DrawHelp() for more information`):

DrawHelp:=proc()
 print(`DrawPiece([ [x,y], piece, player]) executes piecename([[x,y],player]), where piece is a one-letter string dictating which piece to draw:`):
 print(`    "K"=king, "R"=rook, "B"=bishop, "N"=knight, "Q"=queen, "P"=pawn`):
 print(`    If piece does not match one of the 6 given types, textplot is used as a default.`):
 print(`  Example: display( DrawPiece( [ [1,2], "R", 0 ]) )`):
 print():
 print(`DrawConfiguration( [piece_1, piece_2,...piece_k], m, n, turn ) draws the board with pieces`):
 print(`     piece_i = [ [x,y], piece, player], in the same data structure as the argument for DrawPiece`):
 print(`     n and m are as in DrawBoard`):
 print(`     turn is 0 or 1, depending on whose turn it is (0=white, 1=black)`):
 print(`  Example: DrawConfiguration( [ [[1,4],"K",0], [[6,5],"K",1], [[2,3],"R",0] ], 8,8, 0) `):
 print(`  Preset configurations: whiteopening, blackopening, opening.  Try DrawConfiguration([opening, 8, 8, 0])`):
end:


###
# Packages needed:
###
with(plots):
with(plottools):


###
# Procedures to draw individual pieces.
# piecename([[x,y], player]) gives the polygons to draw the piece in the square with vertices (x-1,y-1), (x-1,y), (x, y), (x, y-1),
#    where player = 0 (white) or = 1 (black).
# 
# Example:  display( rook([[1,2],0]) ):
#
# Rook and King by Justin Gilmer
# Queen, Bishop, Pawn, and Knight by Jocelyn Quaintance
# Edited by Andrew Baxter
###


 #rook(L): the program which draws the rook in the unit square located in column i, row j.
 #For example, try rook([[1,1],0]).
rook:=proc(L) local x,y,b1,b2,b3,b4,b5,b6:
  x:=(2*L[1,1]-1)/2:
  y:=(2*L[1,2]-1)/2:
  if L[2] = 0 then
    b1:=polygon([[x-0.3,y-.1],[x-0.3,y-0.3],[x+0.3,y-0.3],[x+0.3,y-.1]],color=white):
    b2:=polygon([[x-0.15,y+.2],[x-0.15,y-.1],[x+0.15,y-.1],[x+0.15,y+.2]],color=white):
    b3:=polygon([[x-0.3,y+.3],[x-0.3,y+.2],[x+0.3,y+.2],[x+0.3,y+.3]],color=white):
    b4:=polygon([[x-0.3,y+.4],[x-0.3,y+.3],[x-.12,y+.3],[x-.12,y+.4]],color=white):
    b5:=polygon([[x-0.08,y+.4],[x-0.08,y+.3],[x+.08,y+.3],[x+.08,y+.4]],color=white):
    b6:=polygon([[x+.12,y+.4],[x+.12,y+.3],[x+.3,y+.3],[x+.3,y+.4]],color=white):

  elif L[2] = 1 then
    b1:=polygon([[x-0.3,y-.1],[x-0.3,y-0.3],[x+0.3,y-0.3],[x+0.3,y-.1]],color=black):
    b2:=polygon([[x-0.15,y+.2],[x-0.15,y-.1],[x+0.15,y-.1],[x+0.15,y+.2]],color=black):
    b3:=polygon([[x-0.3,y+.3],[x-0.3,y+.2],[x+0.3,y+.2],[x+0.3,y+.3]],color=black):
    b4:=polygon([[x-0.3,y+.4],[x-0.3,y+.3],[x-.12,y+.3],[x-.12,y+.4]],color=black):
    b5:=polygon([[x-0.08,y+.4],[x-0.08,y+.3],[x+.08,y+.3],[x+.08,y+.4]],color=black):
    b6:=polygon([[x+.12,y+.4],[x+.12,y+.3],[x+.3,y+.3],[x+.3,y+.4]],color=black):
  fi:
  [b1,b2,b3,b4,b5,b6]:
  end:


 #king(L): the program which draws the king in the unit square located in column i, row j.
 #For example, try king([[1,1],0]).
king:=proc(L) local x,y,b1,b2,b3,b4:
  x:=(2*L[1,1]-1)/2:
  y:=(2*L[1,2]-1)/2:
  if L[2] = 0 then
    b1:=polygon([[x-0.15,y-.1],[x-0.15,y-0.3],[x+0.15,y-0.3],[x+0.15,y-.1]],color=white):
    b2:=polygon([[x-0.15,y-.1],[x-0.3,y+.15],[x-.2,y+.3],[x,y+.2],[x,y-.1]],color=white):
    b3:=polygon([[x,y-.1],[x,y+0.2],[x+0.2,y+0.3],[x+0.3,y+.15],[x+.15,y-.1]],color=white):
    b4:=polygon([[x,y+.2],[x-0.1,y+.25],[x,y+.35],[x+.1,y+.25]],color=white):

  elif L[2] = 1 then
    b1:=polygon([[x-0.15,y-.1],[x-0.15,y-0.3],[x+0.15,y-0.3],[x+0.15,y-.1]],color=black):
    b2:=polygon([[x-0.15,y-.1],[x-0.3,y+.15],[x-.2,y+.3],[x,y+.2],[x,y-.1]],color=black):
    b3:=polygon([[x,y-.1],[x,y+0.2],[x+0.2,y+0.3],[x+0.3,y+.15],[x+.15,y-.1]],color=black):
    b4:=polygon([[x,y+.2],[x-0.1,y+.25],[x,y+.35],[x+.1,y+.25]],color=black):
  fi:
  [b1,b2,b3,b4]:
  end:


 #pawn(L): the program which draws the pawn in the unit square located in column i, row j.
 #For example, try pawn([[1,1],0]).
pawn:=proc(L) local x,y,c11,t1:
 x:=(2*L[1,1]-1)/2:
 y:=(2*L[1,2]-1)/2:
 if L[2] = 0 then
   c11:=disk([x,y+0.1],0.1,color=white):
   t1:=polygon([[x-0.2,y],[x-0.2,y-0.3],[x+0.2,y-0.3],[x+0.2,y]],color=white):
 elif L[2] = 1 then
   c11:=disk([x,y+0.1],0.1,color=black):
   t1:=polygon([[x-0.2,y],[x-0.2,y-0.3],[x+0.2,y-0.3],[x+0.2,y]],color=black):
 fi:
 [c11,t1]:
end:


 #bishop(L): the program which draws the bishop in the unit square located in column i, row j.
 #For example, try bishop([[1,1],0]).
bishop:=proc(L) local x,y,h1,b1,c2,l1:
 x:=(2*L[1,1]-1)/2:
 y:=(2*L[1,2]-1)/2:
 if L[2] = 0 then
   h1:=polygon([[x,y+0.25],[x-0.25,y],[x-0.125,y-0.125],[x+0.125,y-0.125],[x+0.25,y]],color=white):
   b1:=polygon([[x-0.125,y-0.125],[x-0.125,y-0.3],[x+0.125,y-0.3],[x+0.125,y-0.125]],color=white):
   c2:=disk([x,y+0.3],0.05,color=white):
   l1:=line([x-0.125,y-0.125],[x+0.125,y-0.125],color=black,thickness=2):
 elif L[2] = 1 then
   h1:=polygon([[x,y+0.25],[x-0.25,y],[x-0.125,y-0.125],[x+0.125,y-0.125],[x+0.25,y]],color=black):
   b1:=polygon([[x-0.125,y-0.125],[x-0.125,y-0.3],[x+0.125,y-0.3],[x+0.125,y-0.125]],color=black):
   c2:=disk([x,y+0.3],0.05,color=black):
   l1:=line([x-0.125,y-0.125],[x+0.125,y-0.125],color=white,thickness=2):
 fi:
 [h1,b1,c2,l1]:
end:

 #knight(L): the program which draws the knight in the unit square located in column i, row j.
 #For example, try knight([[1,1],0]).
knight:=proc(L) local x,y,t2,q,e2,e1,l,l1,l2,l3:
 x:=(2*L[1,1]-1)/2:
 y:=(2*L[1,2]-1)/2:
 if L[2] = 0 then
   t2:=polygon([[x,y],[x-0.25,y],[x,y+0.25]],color=white):
   q:=polygon([[x,y+0.25],[x+0.4,y-0.3],[x-0.15,y-0.3],[x,y]],color=white):
   e1:=polygon([[x,y+0.25],[x+0.05,y+0.3],[x+0.05,y+0.2]],color=white):
   e2:=polygon([[x,y+0.25],[x-0.125,y+0.25],[x-0.05,y+0.2]],color=white):
   #l:=point([x-0.1,y+0.1],symbol=diamond,color=black,symbolsize=25):
   l1:=line([x,y+0.25],[x,y],color=black,thickness=1):
   l2:=line([x,y+0.25],[x+0.05,y+0.2],color=black,thickness=1):
   l3:=line([x,y+0.25],[x-0.05,y+0.2],color=black,thickness=1):
 elif L[2] = 1 then
   t2:=polygon([[x,y],[x-0.25,y],[x,y+0.25]],color=black):
   q:=polygon([[x,y+0.25],[x+0.4,y-0.3],[x-0.15,y-0.3],[x,y]],color=black):
   e1:=polygon([[x,y+0.25],[x+0.05,y+0.3],[x+0.05,y+0.2]],color=black):
   e2:=polygon([[x,y+0.25],[x-0.125,y+0.25],[x-0.05,y+0.2]],color=black):
   #l:=point([x-0.1,y+0.1],symbol=diamond,color=white,symbolsize=25):
   l1:=line([x,y+0.25],[x,y],color=white,thickness=1):
   l2:=line([x,y+0.25],[x+0.05,y+0.2],color=white,thickness=1):
   l3:=line([x,y+0.25],[x-0.05,y+0.2],color=white,thickness=1):
 fi:
 [t2,q,e1,e2,l1,l2,l3]:
end:


 #queen(L): the program which draws the queen in the unit square located in column i, row j.
 #For example, try queen([[1,1],0]).
queen:=proc(L) local x,y,b3,t31,t32,t33,c31,c32,c33,l1:
 x:=(2*L[1,1]-1)/2:
 y:=(2*L[1,2]-1)/2:
 if L[2] = 0 then
   b3:=polygon([[x-0.4,y],[x-0.3,y-0.3],[x+0.3,y-0.3],[x+0.4,y]],color=white):
   t31:=polygon([[x-0.4,y],[x-0.3,y+0.25],[x-0.2,y]],color=white):
   t32:=polygon([[x-0.2,y],[x,y+0.375],[x+0.2,y]],color=white):
   t33:=polygon([[x+0.2,y],[x+0.3,y+0.25],[x+0.4,y]],color=white):
   c31:=disk([x-0.3,y+0.28],0.03,color=white):
   c33:=disk([x+0.3,y+0.28],0.03,color=white):
   c32:=disk([x,y+0.425],0.05,color=white):
   l1:=line([x-0.4,y],[x+0.4,y],color=black, thickness=2):
 elif L[2] = 1 then
   b3:=polygon([[x-0.4,y],[x-0.3,y-0.3],[x+0.3,y-0.3],[x+0.4,y]],color=black):
   t31:=polygon([[x-0.4,y],[x-0.3,y+0.25],[x-0.2,y]],color=black):
   t32:=polygon([[x-0.2,y],[x,y+0.375],[x+0.2,y]],color=black):
   t33:=polygon([[x+0.2,y],[x+0.3,y+0.25],[x+0.4,y]],color=black):
   c31:=disk([x-0.3,y+0.28],0.03,color=black):
   c33:=disk([x+0.3,y+0.28],0.03,color=black):
   c32:=disk([x,y+0.425],0.05,color=black):
   l1:=line([x-0.4,y],[x+0.4,y],color=white, thickness=2):
 fi:
 [b3,t31,t32,t33,c31,c32,c33,l1]:
end:

 #prints a generic piece, represented by a square in the player's color with lettering of the string namen.
 #For example, try generic([[1,2],0], "Camel"). (Camel?!  See http://en.wikipedia.org/wiki/Tamerlane_Chess )
generic:=proc(L,namen) local x,y, base, label:
 x:=(2*L[1,1]-1)/2:
 y:=(2*L[1,2]-1)/2:
 base:=rectangle([x-0.4, y-0.4], [x+0.4, y+0.4], color=`if`(L[2]=0, white, black) ):
 label:=textplot([x,y,namen], color=`if`(L[2]=1, white, black) ):
 [base, label];
end:

###
# DrawPiece([ [x,y], piece, player]) executes piecename([[x,y],player]), where piece is a one-letter string dictating which piece to draw:
#    "K"=king, "R"=rook, "B"=bishop, "N"=knight, "Q"=queen, "P"=pawn
#    If piece does not match one of the 6 given types, textplot is used as a default.
# 
# Example: display( DrawPiece( [ [1,2], "R", 0 ]) )
#
# Original programming by Jocelyn Quaintance.
# Edited by Justin Gilmer and Andrew Baxter.
###

DrawPiece:=proc(L):
    if L[2] = "K" then
      king([L[1],L[3]]):
  elif L[2] = "R" then
      rook([L[1],L[3]]):
  elif L[2] = "B" then
      bishop([L[1],L[3]]):
  elif L[2] = "N" then
      knight([L[1],L[3]]):
  elif L[2] = "Q" then
      queen([L[1],L[3]]):
  elif L[2] = "P" then
      pawn([L[1],L[3]]):
  else
      generic([L[1],L[3]], L[2]):
  fi:
end:

###
# DrawBoard(m,n,color1,color2) draws an n (row) x m (column) board with alternating colors color1 and color2.
#   Use ?plot/colornames for options for color1 and color2
#   Default colors are color1=black, color2=white
#
# Example: display(DrawBoard(6,8, "AliceBlue", "PapayaWhip") );
#
# Written by Andrew Baxter
###

DrawBoard:=proc(m,n,color1:=black, color2:=white) local i, j, S:
  S:={seq(seq(rectangle([i-1,j-1],[i,j],color=`if`(type(i-j,even),color1,color2)),i=1..m),j=1..n)}:
end:


###
# DrawConfiguration( [piece_1, piece_2,...piece_k], m,n, turn ) draws the board with pieces
#     piece_i = [ [x,y], piece, player], in the same data structure as the argument for DrawPiece
#     n and m are as in DrawBoard
#     turn is 0 or 1, depending on whose turn it is (0=white, 1=black)
#
#  Example: DrawConfiguration( [ [[1,4],"K",0], [[6,5],"K",1], [[2,3],"R",0] ], 8,8, 0):
#
#  Original programming by Emily Sergel
#  Edited by Andrew Baxter
###

DrawConfiguration:=proc(Pieces, m,n, turn) local piece,L:

  L:=[seq(op(DrawPiece(piece)), piece in Pieces), op(DrawBoard(m,n,"Gray","GhostWhite"))]:

display(L, axes=none, title=`if`(turn=0, "White's turn", "Black's turn"), scaling=constrained):
end:  





  #####                                                           
 #     # ###### #    # ###### #####    ##   ##### #  ####  #    # 
 #       #      ##   # #      #    #  #  #    #   # #    # ##   # 
 #  #### #####  # #  # #####  #    # #    #   #   # #    # # #  # 
 #     # #      #  # # #      #####  ######   #   # #    # #  # # 
 #     # #      #   ## #      #   #  #    #   #   # #    # #   ## 
  #####  ###### #    # ###### #    # #    #   #   #  ####  #    # 


#  Written by Emilie Hogan
#=============================================================================
# MakePuzzle(m,n,Wpieces,K): inputs a board size (m,n), a set of white
# piece names (other than "K"), and an integer K to be the mate threshold.
# Outputs a list of length 3: first is a random starting configuration, 
# next is a list of intermediate configurations that lead to checkmate,
# and third is the minimum number of white moves it takes to checkmate

MakePuzzle := proc(m,n,Wpieces,K)
local B,SG,paths,P,minMate,M,moves,i,config,sizePaths,minSize,j;


B := RandomConfig(m,n,Wpieces);

	#make sure that black is not in check to start with
while InCheck(B,m,n,1) do
	B := RandomConfig(m,n,Wpieces);
od;

SG := SolveGameK(B,m,n,K);
if SG=FAIL then
	print(`The randomly generated configuration requires more than `,K,` moves to checkmate.`);
	RETURN(FAIL);
fi;

	#all possible ways to checkmate
paths := FindPaths(SG[2]); 

	#set of path lengths
sizePaths := {seq(nops(paths[j]),j=1..nops(paths))}; 

	#minimum length of checkmate path
minSize := min(sizePaths); 

	#finding one minimum way to checkmate
P := paths[1];
for j from 2 to nops(paths) while nops(P)<>minSize do 
	P := paths[j];
od;

	#dictionary of configurations with config #
M := SG[3];

minMate := minSize/2;

moves := [];
for i from 1 to nops(P) do
	config := op(select(j->evalb(j[1]=P[i]),M));
	moves := [op(moves),config[2][1]];
od;

RETURN([B, moves, minMate]);

end:

#=============================================================================
# RandomConfig(m,n,Wpieces): inputs a board size (m rows, n columns) and a set
# of white pieces besides the king. Outputs a randomly generated board (set of 
# pieces with locations).

RandomConfig := proc(m,n,Wpieces)
local bK,wK,randX,randY,i,Locs,B,newLoc;

randX := rand(1..m);
randY := rand(1..n);

bK := [randX(),randY()];
wK := [randX(),randY()];
Locs := {bK,wK};
B := {[bK,"K",1],[wK,"K",0]};

for i from 1 to nops(Wpieces) do
	newLoc := [randX(),randY()];
	while member(newLoc,Locs) do
		newLoc := [randX(),randY()];
	od;
	B := B union {[newLoc,Wpieces[i],0]};
        Locs:=Locs union {newLoc};
od;

RETURN(B);

end:

#=============================================================================
# FindPaths(E): Intputs a set of directed edges and outputs
# all directed paths through the graph. Used on the seceond element
# of the list of length 3 that is output by of SolveGameK in PuzzleGen.txt

FindPaths := proc(E)
local P1,P2,i,p,e,last,first,Ret,path;

first := select(i->evalb(i[1]=1),E);

P1 := {seq([first[j]],j=1..nops(first))};
P2 := P1;

for i from 1 while P2<>{} do
	P1 := P2;
	P2 := {};
	#print(P1);
	for p in P1 do
		for e in E do
			#print(p,e);
			last := p[-1][2];
			if e[1]=last then
				P2 := P2 union {[op(p),e]};
				#print(P2);
			fi;
		od;
	od;
od;

Ret := {};
for path in P1 do
	Ret := Ret union {[path[1][1],seq(path[j][2],j=1..nops(path))]};
od;

RETURN(Ret);

end: