#OK to post homework
#Victoria Chayes, 4/21/19, Assignment 22

Help:=proc(): print(`NiceMoves(S,B), ExecuteMove(m,S,B), NiceBestRand(S,B,K), Verbose(S,B,L), VEFFull(n,S,B), VEF(n,S,B),VSmartGame(S,B,f,n)`): 
print(`Auxiliary Programs: NiceRHM(S,B), NiceLHM(S,B), NiceUVM(S,B), NiceDVM(S,B), NiceRG(S,B), Verbose1(m), ConvertToMoves1(S1,S2), ConvertToMoves(L), MakeRBoard(m,n), ExecuteMoves(S,B,L), NiceRG(S,B), NiceVEFFull(m,S,B), NiceVEF(m,n,S,B), VSmart1(S,B,f,n)`):
end:

#1 In my code a move was really the position resulting from the move. Using the data structure [[a,b],[1,0]] to indicate moving the peg in position [a,b] over the peg in position [a+1,b], assuming that [a+2,b] is in the board and is currently empty, with analogous meanings for [[a,b],[-1,0]], [[a,b],[0,1]], [[a,b],[0,-1]], write a procedure NiceMoves(S,B): The set of all possible legal moves from position S in a Peg Solitaire with board B that uses this more compact description.

NiceRHM:=proc(S,B) local mo,s:
mo:={}:
for s in S do
 if member(s+[1,0],S) and  (not member(s+[2,0],S)) and member(s+[2,0],B) then
  mo:=mo union {[s,[1,0]]}:
 fi:
od:
mo:
end:

NiceLHM:=proc(S,B) local mo,s:
mo:={}:
for s in S do
 if member(s-[1,0],S) and  (not member(s-[2,0],S)) and member(s-[2,0],B) then
  mo:=mo union {[s,[-1,0]]}:
 fi:
od:
mo:
end:

NiceUVM:=proc(S,B) local mo,s:
mo:={}:
for s in S do
 if member(s+[0,1],S) and  (not member(s+[0,2],S)) and member(s+[0,2],B) then
  mo:=mo union {[s,[0,1]]}:
 fi:
od:
mo:
end:

NiceDVM:=proc(S,B) local mo,s:
mo:={}:
for s in S do
 if member(s-[0,1],S) and  (not member(s-[0,2],S)) and member(s-[0,2],B) then
  mo:=mo union {[s,[0,-1]]}:
 fi:
od:
mo:
end:

NiceMoves:=proc(S,B):
NiceRHM(S,B) union NiceLHM(S,B) union NiceUVM(S,B) union NiceDVM(S,B):
end:



#2 To interface it with the previous convention, write a procedure ExecuteMove(m,S,B) that inputs m=[[a,b],[1,0]] or m=[[a,b],[-1,0]] etc. and outputs the set of remaining pegs.

ExecuteMove:=proc(m,S,B):
S minus {m[1], m[1]+m[2]} union {m[1]+2*m[2]}:
end: 

#As this was needed later for testing, I also made a version that converted a list of positions L into a list of moves:
ExecuteMoves:=proc(S,B,L) local i, n, S1:
n:=nops(L):
S1:=[S]:
for i from 1 to n do
  S1:=[op(S1),ExecuteMove(L[i],S1[i],B)]:
od:
S1:
end:



#3 Write NiceBestRand(S,B,K) that uses the new convention to get the sequence of moves in a game.

NiceRG:=proc(S,B) local L,S1,mo:
L:=[];
S1:=S:

while NiceMoves(S1,B)<>{} do
 mo:=NiceMoves(S1,B):
 mo:=mo[rand(1..nops(mo))()]:
 S1:=ExecuteMove(mo, S1, B):
 L:=[op(L),mo]:
od:

L:
end:

NiceBestRand:=proc(S,B,K) local i,rec,cha,hope:
cha:=NiceRG(S,B):
rec:=nops(cha): #every move eliminates one peg, so the more moves the better

for i from 1 to K do
 hope:=NiceRG(S,B):
 if nops(hope)> rec then
   cha:=hope:
   rec:=nops(hope):
 fi:
od:

cha:
end:



#4 Write a procedure Verbose(S,B,L) that inputs S, B, and L, the output of NiceBestRand(S,B,K) (or another procedure like it) and outputs a set of instructions clear to a seven-year old. Like
#"Move the peg in location [4,5] over the peg in location [4,6], thereby making locations [4,5] and [4,6] empty, and location [4,7] occupied."

Verbose1:=proc(m):
print(`Move the peg in location`, m[1], `over the peg in location`, m[1]+m[2], `thereby making location`, m[1], `and location`, m[1]+m[2], `empty`, `and location`, m[1]+2*m[2], `occupied`):
end:

#Helper functions to convert a list of positions into a list of moves:
ConvertToMoves1:=proc(S1,S2) local a, b, m1, m2:
a:=S1 minus S2:
b:=S2 minus S1:

if abs(convert(b[1]-a[1], `+`))=2 then
  m1:=a[1]:
  m2:=a[2]:
else
  m1:=a[2]:
  m2:=a[1]:
fi:

[m1, m2-m1]:
end:

ConvertToMoves:=proc(L) local M, n, i:
M:=[]:
n:=nops(L)-1:
for i from 1 to n do
  M:=[op(M), ConvertToMoves1(L[i],L[i+1])]:
od:
M:
end:

Verbose:=proc(S,B,L) local M, n, i:
if type(L[1], set) then
  M:=ConvertToMoves(L):
else
  M:=L:
fi:

n:=nops(M):
for i from 1 to n do
  Verbose1(M[i]):
od:
end:



#5 Experiment with rectangular m by n boards with the bottom-left peg removed, and see whether you can get good solutions.

#For small enough rectangular boards, my VEFFull evaluation function by construction gives the empirically best game you can play, so I used it for this testing for small m, n. Running VSmartGame for any of these individually will output the full solution; to save space, I didn't do it here.

#seq(seq([[i,j],nops(VSmartGame(RectBoardIP(i,j),RectBoard(i,j),VEFFull, 0)[-1])],i=2..min(4,j)),j=2..5);
#   [[2, 2], 3], [[2, 3], 4], [[3, 3], 4], [[2, 4], 6], [[3, 4], 1], [[4, 4], 2], [[2, 5], 7], [[3, 5], 2], [[4, 5], 1]

#For larger values of m, n, I found it better to experiment with BestRand:
#seq(seq([[i,j],nops(BestRand(RectBoardIP(i,j),RectBoard(i,j),100)[-1])],i=2..min(10,j)),j=2..10);
#[[2, 2], 3], [[2, 3], 4], [[3, 3], 4], [[2, 4], 6], [[3, 4], 1], [[4, 4], 2], [[2, 5], 7], [[3, 5], 2], [[4, 5], 1], [[5, 5], 2], [[2, 6], 9], [[3, 6], 2], [[4, 6], 2], [[5, 6], 3], [[6, 6], 4], [[2, 7], 10], [[3, 7], 1], [[4, 7], 2], [[5, 7], 4], [[6, 7], 3], [[7, 7], 5], [[2, 8], 12], [[3, 8], 2], [[4, 8], 3], [[5, 8], 4], [[6, 8], 5], [[7, 8], 5], [[8, 8], 6], [[2, 9], 13], [[3, 9], 2], [[4, 9], 4], [[5, 9], 5], [[6, 9], 6], [[7, 9], 8], [[8, 9], 7], [[9, 9], 9], [[2, 10], 15], [[3, 10], 3], [[4, 10], 5], [[5, 10], 5], [[6, 10], 7], [[7, 10], 8], [[8, 10], 9], [[9, 10], 10], [[10, 10], 9]

#Note that the BestRand values do agree with the VSmart values for smaller numbers, another indication that BestRand is indeed a useful function. However, as there are more possibilities for the larger games, this will not always give the correct answer. For example,

#seq([[3,i],nops(VSmartGame(RectBoardIP(3,i),RectBoard(3,i),VEFFull, 0)[-1])],i=1..9);
#   [[3, 1], 1], [[3, 2], 4], [[3, 3], 4], [[3, 4], 1], [[3, 5], 2], [[3, 6], 1], [[3, 7], 1], [[3, 8], 1], [[3, 9], 1]

#indicates that there might always be a single-peg solution to a rectangular board [3,n] for large enough n. In 8.3, we develop an algorithm that solves 3-by-n, n even rectangular boards, which indicates even further that there is always a single peg (in fact, in the bottom peg) remaining, so large patterns need more efficient evaluation functions to be found.



#6 Run BestRand(IP(2,2),PSB(2,2),10^5) all night, and see what you can come up with. The lucky winners will share the prize.
#BestRand(IP(2,2),PSB(2,2),10^5)[-1];
#    {[4, 5], [7, 3]}



#7 Find an evaluation function, f, for which SmartGame(IP(2,2),PSB(2,2),f) gives you a solution with one peg left, if possible at the central location.

#My reasoning for constructing the following evaluation functions is that every move removes one peg, so to win the game, you want the longest chain of moves. The first function I wrote would calculate the chain of all possible moves, which would always give you the best game. 
 
NiceVEFFull:=proc(m, S, B) local S1, M, v:
option remember:
S1:=ExecuteMove(m,S,B):
M:=NiceMoves(S1,B):

if M={} then
  return(0):
fi:

max(seq(NiceVEFFull(v,S1,B), v in M))+1:
end:

#To determine how ridiculous the time would be, I tested the assignment of values to moves against 
#  L:=NiceBestRand(IP(2,2),PSB(2,2),10):
#  S1:=ExecuteMoves(IP(2,2),PSB(2,2), L):

#and at time(VEFFull(L[-16],S1[-16],PSB(2,2))), it took about 16 seconds, nearly double that of time(VEFFull(L[-15],S1[-15],PSB(2,2))). I tried leaving it to run a full game of IP(2,2),PSB(2,2) and it had not finished in over two hours.

#The next version allows you to input the cutoff of how long you want to check that the chain goes. This function essentially returns min(VFEFull, n).

NiceVEF:=proc(m,n,S, B) local S1, M, v:
option remember:
if n=1 then
  S1:=ExecuteMove(m,S,B):
  M:=NiceMoves(S1,B):
  if M={} then
    return(0):
  else
    return(1):
  fi:
fi:

S1:=ExecuteMove(m,S,B):
M:=NiceMoves(S1,B):

if M={} then
  return(0):
fi:

max(seq(NiceVEF(v,n-1,S1,B), v in M))+1:
end:

#So long as the cutoff was short enough, this could evaluate strings in a reasonable amount of time: here we can go all the way back to the first move of the game, and we see:
#seq(time(VEF(L[1],i,i,S1[1],PSB(2,2))), i=1..8);
#   0., 0.3e-2, 0.12e-1, 0.67e-1, .189, 1.362, 4.441, 20.330
#so checking a chain of about seven moves in seems like the ideal.

#The next questions becomes how much worse it becomes when they're not nice:

VEFFull:=proc(n, S, B) local M, v:
option remember:
M:=Moves(S,B):

if M={} then
  return(0):
fi:

max(seq(VEFFull(n, v,B), v in M))+1:
end:

#The 'n' was added so that I can call it up interchangeably with VEF in the new VSmartGame function I wrote. It turns out the time is a lot better than the Nice version: time(VEFFull(S1[-16],PSB(2,2))) was only 6.3. Unfortunately, by the time you get to time(VEFFull(S1[-18],PSB(2,2))), it's up to nearly a minute. So we need a new, non-nice version of VEF:

VEF:=proc(n,S,B) local M, v:
option remember:
if n=1 then
  M:=Moves(S,B):
  if M={} then
    return(0):
  else
    return(1):
  fi:
fi:

M:=Moves(S,B):

if M={} then
  return(0):
fi:

max(seq(VEF(n-1,v,B), v in M))+1:
end:

#Now we can test for reasonable times for what n should potentially be from the first move:
#seq(time(VEF(i,S1[1],PSB(2,2))),i=1..10);
#  0., 0.002, 0.009, 0.037, 0.165, 0.558, 4.821, 8.776, 40.338, 139.410
#Note the 8 seconds at i=8 vs 20 seconds we had in NiceVEF. As option remember isn't going to help for each subsequent iteration of VEF, because the 'n' that each entry is evaluated with will be different, this is a good indication of how much time each step of the smart game is going to take.

#Time to see if this at all works for trying to implement a smart game! I wrote VSmartGame because I wanted to adjust our current function to choose a random move if multiple moves were scored the same. Note that we can add a forget if we're calling VFE because the entries are never going to be evaluated with these inputs of `n` that they are originally called with, so might as well save the memory space.

VSmart1:=proc(S,B,f,n) local mo,rec,cha,i, hope:
mo:=Moves(S,B):
if mo={} then
  RETURN(S):
fi:

cha:=[mo[1]]:
rec:=f(n,cha[1],B):
#forget(f):
for i from 2 to nops(mo) do
  hope:=f(n,mo[i],B): 
#  forget(f):
  if hope>rec then
    cha:=[mo[i]]:
    rec:=hope:
  elif hope=rec then
    cha:=[op(cha),mo[i]]:
  fi:
od:
cha[rand(1..nops(cha))()]:
end:

VSmartGame:=proc(S,B,f,n) local L,S1,S2:
S1:=S:
L:=[S1]:
S2:=VSmart1(S1,B,f,n):
while S1<>S2 do
L:=[op(L),S2]:
S1:=S2:
S2:=VSmart1(S1,B,f,n):
od:
L:
end:

#Because of the randomized element, I would get a range of numbers, usually no greater than 9, of remaining pegs when I tested it (I used values from n=1..6, and tested each value multiple times). Notably,
#min(seq(nops(VSmartGame(IP(2,2),PSB(2,2),VEF, 4)[-1]),i=1..20));
#   3
#Empirically from running BestRand overnight, we know that there exists a board with only two moves left. So while this function is better than the evaluation function from class, it's still not perfect.



#8 After class, I added procedures RectBoard(m,n) and RectBoardIP(m,n), for the board of a Peg Solitaire with an m by n board rectangular , and its initial position with the leftmost-bottom peg ([1,1]) removed. Before class, I also wrote procedure AllGames(S,B,K) that gives the set of ALL the start of games up to length K. In particular AllGames(S,B,nops(S)-1) outputs the set of ALL solutions (possibly an empty set). Alas for the actual Peg Solitaire with the size of S being 32, it is impractical.

#8.1 How many solutions of Peg Solitaire with a 3 by 4 rectangular board are there? For how many of them is the last peg at the position of the initial hole, [1,1]?

#A:=AllGames(RectBoardIP(3,4),RectBoard(3,4),nops(RectBoardIP(3,4))-1):
#nops(A);
#   852
#c:=0: for a in A do if a[-1]={[1,1]} then c:=c+1: fi: od: c;
#   420
#out of curiosity I checked what the others were:
#{seq(a[-1], a in A)};
#   {{[1, 1]}, {[4, 1]}}
#c:=0: for a in A do if a[-1]={[4,1]} then c:=c+1: fi: od: c;
#   432


#8.2 How many solutions of Peg Solitaire with a 3 by 5 are there? If there are no solutions with only one peg left, what is the best that can be done?

#From Problem 5 and the VSmart game I designed, we knew that the best solution to a 3 by 5 board is 2 pegs left. However, we can test:
#A:=AllGamesK(RectBoardIP(3,5),RectBoard(3,5),nops(RectBoardIP(3,5))-1):
#nops(A);
#   0
#A:=AllGamesK(RectBoardIP(3,5),RectBoard(3,5),nops(RectBoardIP(3,5))-2):
#nops(A);
#   5839
#the ending position is always:
#{seq(a[-1], a in A)};
#   {{[3, 1], [5, 1]}}.


#8.5 [Optional Human Challenge, 10 dollars] Prove that the best that one can do for a 3 by n board, with n, odd, is to have two pegs remaining.

#This is actively not true. There exist counterexamples. Running VSmartGame for a 3x7 board and a 3x9 board gives a solution with one peg remaining. The 3x7 board can be viewed with:
#A:=VSmartGame(RectBoardIP(3,7),RectBoard(3,7),VEFFull, 0):

PlotGameProper:=proc(G,s) local i,m,n,g:
m:=max(seq(g[1], g in G[1])):
n:=max(seq(g[2], g in G[1])):

for i from 1 to nops(G) do
  print(plot(G[i],style=point,axes=none, symbolsize=15,view=[1..m, 1..n])):
  print(``):
  Threads[Sleep](s):
od:
end:

#PlotGameProper(A, 1);
#lets you watch in realtime a very legal game on a 3x7 board where you only have one piece remaining in the end.


####################################################################################
#C22.txt, April 15, 2019, Dr,Z.'s ExpMath class

Help22:=proc(): print(` PSB(m,n), IP(m,n), RHM(S,B), Moves(S,B) , RG(S,B) ,`):
print(`  Cont(L,B) , AllGramesK(S,B,K), PlotPos(S) , EF(S,B) `):
print(`SmartOne(S,B), SmartGame(S,B)  , BestRand(S,B,K),  BestRandStory(S,B,K) `):
print(`RectBoard(m,n), RectBoardIP(m,n) `):
end:

PSB:=proc(m,n) local i,j:
{
seq(seq([i,j],i=m+1..m+2*n-1),j=1..m),
seq(seq([i,j],i=1..2*m+2*n-1),j=m+1..m+2*n-1),
seq(seq([i,j],i=m+1..m+2*n-1),j=m+n+1..2*m+2*n-1)}
end:

IP:=proc(m,n): PSB(m,n) minus {[m+n,m+n]}: end:

#RHM(S,B): Given a position S in a peg-solitaire with board B, all the right horizontal moves in Peg Solitaire
RHM:=proc(S,B) local mo,s:

mo:={}:

for s in S do
 if member(s+[1,0],S) and  (not member(s+[2,0],S)) and member(s+[2,0],B) then
  mo:=mo union {S minus {s,s+[1,0]} union {s+[2,0]}}:
 fi:
od:

mo:

end:



#LHM(S,B): Given a position S in a peg-solitaire with board B, all the left  horizontal moves in Peg Solitaire
LHM:=proc(S,B) local mo,s:

mo:={}:

for s in S do
 if member(s-[1,0],S) and  (not member(s-[2,0],S)) and member(s-[2,0],B) then
  mo:=mo union {S minus {s,s-[1,0]} union {s-[2,0]}}:
 fi:
od:

mo:

end:



#UVM(S,B): Given a position S in a peg-solitaire with board B, all the up vertical  moves in Peg Solitaire
UVM:=proc(S,B) local mo,s:

mo:={}:

for s in S do
 if member(s+[0,1],S) and  (not member(s+[0,2],S)) and member(s+[0,2],B) then
  mo:=mo union {S minus {s,s+[0,1]} union {s+[0,2]}}:
 fi:
od:

mo:

end:


#DVM(S,B): Given a position S in a peg-solitaire with board B, all the down vertical  moves in Peg Solitaire
DVM:=proc(S,B) local mo,s:

mo:={}:

for s in S do
 if member(s-[0,1],S) and  (not member(s-[0,2],S)) and member(s-[0,2],B) then
  mo:=mo union {S minus {s,s-[0,1]} union {s-[0,2]}}:
 fi:
od:

mo:

end:

Moves:=proc(S,B):RHM(S,B) union LHM(S,B) union UVM(S,B) union DVM(S,B): end:


#RG(S,B): a random game
RG:=proc(S,B) local L,S1,mo:
L:=[S];

S1:=S:

while Moves(S1,B)<>{} do
 mo:=Moves(S1,B):
 S1:=mo[rand(1..nops(mo))()]:
 L:=[op(L),S1]:
od:

L:

end:

Cont:=proc(L,B) local la,gu,gu1:
 la:=L[-1]:
 gu:=Moves(la,B):
 {seq([op(L),gu1],gu1 in gu)}
end:


#AllGamesK(S,B,K) of length K
AllGamesK:=proc(S,B,K) local gu,gu1:
option remember:
if K=0 then
 RETURN({[S]}):
fi:

gu:=AllGamesK(S,B,K-1):

{seq(op(Cont(gu1,B)), gu1 in gu)}:

end:

with(plots):

PlotPos:=proc(S) plot(S,style=point,axes=none): end:

#PlotGame(G): plots all the intermediate positions of the game
#pausing for s seconds
PlotGame:=proc(G) local i:

for i from 1 to nops(G) do
  PlotPos(G[i]):
  #Threads[Sleep](s):
od:

end:

#EF1(S,B): the number of moves available at position S with Peg Solitaire with board B
EF:=proc(S,B) : nops(Moves(S,B)): end:

#SmartOne(S,B,f): the best move from S using Quentin D.'s evaluation function
#(the position with most options)
SmartOne:=proc(S,B,f) local mo,rec,cha,i:
mo:=Moves(S,B):

if mo={} then
  RETURN(S):
fi:

cha:=mo[1]:
rec:=f(cha,B):
for i from 2 to nops(mo) do
 
  if EF(mo[i],B)>rec then
    cha:=mo[i]:
     rec:=f(cha,B):
  fi:
od:
cha:
end:


#SmartGame(S,B,f)
SmartGame:=proc(S,B,f) local L,S1,S2:
S1:=S:
L:=[S1]:
S2:=SmartOne(S1,B,f):
while S1<>S2 do
L:=[op(L),S2]:
S1:=S2:
S2:=SmartOne(S1,B,f):
od:
L:
end:


#EF2(S,B,k): the best move according to QD's but looking k moves ahead
EF2:=proc(S,B,k)

end:


#BestRand(S,B,K): the best of K random game
BestRand:=proc(S,B,K) local i,rec,cha,hope:

cha:=RG(S,B):
rec:=nops(cha[-1]):

for i from 1 to K do

 hope:=RG(S,B):
 
if nops(hope[-1])< rec then
   cha:=hope:
   rec:=nops(hope[-1]):
fi:

od:
cha:

end:


#BestRandStory(S,B,K): the best of K random game
BestRandStory:=proc(S,B,K) local i,rec,cha,hope:

cha:=RG(S,B):
rec:=nops(cha[-1]):

for i from 1 to K do

 hope:=RG(S,B):
 

if nops(hope[-1])< rec then
   cha:=hope:
   rec:=nops(hope[-1]):
print(`The current record is`, rec):
print(`The current champion is`):
lprint(cha):
fi:

od:
cha:

end:


#RectBoard(m,n): a rectangular m by n Peg Solitaire Board
RectBoard:=proc(m,n) local i,j:
{seq(seq([i,j],i=1..n),j=1..m)}:
end:

#RectBoardIP(m,n): the inital position of a rectangular m by n Peg Solitaire Board
RectBoardIP:=proc(m,n) :
 RectBoard(m,n) minus {[1,1]}:
end: