# Joey Reichert
# 640:640 Spring 2013
# February 7, 2013
# hw5.txt
# I give permission to post

Help:=proc() : print(`SphereWithPaths(G,i,k); Knk(n,k); Mnk(n,k,r); PegSoliChildren(M); PegSoli(M);`): end:


# Problem #2
# By modifying procedure Sphere(G,i,k) of C5.txt, 
# write a procedure SphereWithPaths(G,i,k) that 
# outputs a set of paths of minimal length k 
# starting at i, where a path is given a list of 
# vertices, but in case of multiple paths of 
# length k ending at a given vertex, you only have 
# one of them. For example 
# SphereWithPaths([{2,3},{4},{4},{}],1,2) ; 
# may output {[1,2,4]} or {[1,3,4]} 
# (which one being a random choice of the machine)

SphereWithPaths:=proc(G,i,k) local S,j,SFinal,ra:

SFinal:={}:

for j from 0 to k do:
 S:=Sphere(G,i,j):
 #print(S):
 if nops(S) > 1 then
  ra:=rand(1..nops(S)):
  #print("here");
  #print(ra());
  #print(op(S[1]));
  #print(op(S[2]));
  S:={op(S[ra()])}:
  #print(S):
 fi:
 
 SFinal:=SFinal union S:

od:

SFinal:

end:

# Used to test rand() function
#test:=proc(G) local ra:
#ra:=rand(1..4):
#
#G[ra()];
#
#end:

# Problem #3
# A krook is a hybrid of a chess King and a 
# chess rook, i.e. it is like a Queen that 
# can only move diagonally one unit. Modify 
# program Qnk(n,k) to write a program, Knk(n,k) 
# to generate the set of ways of placing k 
# non-attacking krooks on a k by n chess-board. 
# Is the (start of the) sequence 
# [seq(nops(Knk(n,n),n=1..infinity)] in Sloane?

Knk:=proc(n,k) local S,L:
option remember:

if k=0 then
  RETURN({[]}):
fi:

S:=Knk(n,k-1):

{seq(op(ChildrenKnk(L,n)), L in S)}:

end:

#ChildrenKnk(L,n): inputs a legal placement of
#krooks on a nops(L) by n board and finds
#all the legal extensions
ChildrenKnk:=proc(L,n) local i,S,s,k:
k:=nops(L):

S:={}:

for s from 1 to n do
 if not s in L and
 {false,seq(evalb(abs(L[i]-s)=i),i=1..k)}={false} then
  S:=S union {[op(L), s]}:
 fi:
od:

S:
end:

# [seq(nops(Knk(n,n)),n=1..infinity)] = [1,0,0,0,...]
# This is surely wrong, because I can easily find an example
# To show KnK(4,4) is at least equal to 1!


# Problem #4
# A mook of order r is a hybrid of a chess King 
# and a chess rook, i.e. it is like a Queen that 
# can only move diagonally up to r units. In 
# particular a mook of order 1 is a krook. 
# Modify program Knk(n,k) to write a program, 
# Mnk(n,k,r) to generate the set of ways of placing 
# k non-attacking mooks of order r on a k by n 
# chess-board. (Of course Mnk(n,k,1) is the same 
# as Knk(n,k) and Mnk(n,k,k) is the same as Qnk(n,k), 
# please check!). 
# For what values of r are the (starts of the) sequences 
# [seq(nops(Mnk(n,n,r),n=1..infinity)] in Sloane?

Mnk:=proc(n,k,r) local S,L:
option remember:

if k=0 then
  RETURN({[]}):
fi:

S:=Mnk(n,k-1,r):

{seq(op(ChildrenMnk(L,n,r)), L in S)}:

end:

#ChildrenMnk(L,n,r): inputs a legal placement of
#krooks on a nops(L) by n board and finds
#all the legal extensions
ChildrenMnk:=proc(L,n,r) local i,S,s,k:
k:=nops(L):

S:={}:

for s from 1 to n do
 if not s in L and
 {false,seq(evalb(abs(L[i]-s)=(r+1-i)),i=1..k)}={false} then
  S:=S union {[op(L), s]}:
 fi:
od:

S:
end:

# As Mnk(n,k,1) is indeed equivalent to Knk(n,k), and Knk(n,k)
# has a bug present somewhere, Mnk(n,k,r) must also have a bug.
# I'll update this if I do find it.



# Problem #6
# Consider peg-solitaire but played on a k by n board,
# where a position is represented as a 0-1 matrix,
# and we use the data structure of lists-of lists
# (a list of length k where each entry is a list of
# length n, so M[i][j]=1 iff the spot at the i-th row
# and j-th column has a peg). Write a program
# PegSoliChildren(M) that inputs such a position and
# outputs the set of all the positions (with the number
# of 1's reduced by 1) that are legally reachable from it. 

PegSoliChildren:=proc(M) local k,n,i,j,S,Mtemp:

# I think I swapped n and k, but it will not affect the results
n:=nops(M):
k:=nops(M[1]):

S:={}:

for j from 1 to k do
 for i from 1 to n do
  if M[i][j] = 1 then
   if i+2<=n and M[i+1][j] = 1 and M[i+2][j] = 0 then
    Mtemp:=M:
    Mtemp[i][j]:=0:
    Mtemp[i+1][j]:=0:
    Mtemp[i+2][j]:=1:
    S:=S union {Mtemp}:
   fi:
   if i-2>=1 and M[i-1][j] = 1 and M[i-2][j] = 0 then
    Mtemp:=M:
    Mtemp[i][j]:=0:
    Mtemp[i-1][j]:=0:
    Mtemp[i-2][j]:=1:
    S:=S union {Mtemp}:
   fi:
   if j+2<=k and M[i][j+1] = 1 and M[i][j+2] = 0 then
    Mtemp:=M:
    Mtemp[i][j]:=0:
    Mtemp[i][j+1]:=0:
    Mtemp[i][j+2]:=1:
    S:=S union {Mtemp}:
   fi:
   if j-2>=1 and M[i][j-1] = 1 and M[i][j-2] = 0 then
    Mtemp:=M:
    Mtemp[i][j]:=0:
    Mtemp[i][j-1]:=0:
    Mtemp[i][j-2]:=1:
    S:=S union {Mtemp}:
   fi:
  fi:
 od:
od:

S:

end:

# Problem 7
# [small challenge] Is the four-by-four Peg Solitaire 
# with a one hole at a corner solvable?

# M:=[[1,1,1,0],[1,1,1,1],[1,1,1,1],[1,1,1,1]]:
PegSoli:=proc(M) local all,children,i,SUM:

all:={}:

children:=PegSoliChildren(M):
if children = {} then
 return {M}:
fi:

for i from 1 to nops(children) do
 all:=all union PegSoli(children[i]):
od:

if M = [[1,1,1,0],[1,1,1,1],[1,1,1,1],[1,1,1,1]] then
 for i from 1 to nops(all) do
  print(all[i]);
  SUM:=add(add(all[i][j][k],k=1..nops(all[i][j])),j=1..nops(all[i])):
  if SUM = 1 then
   print("TRUE"):
  fi:
 od:
fi:

return all:

end:

# As SUM is never equal to 1, it seems that
# there is no way to play four by four peg
# solitaire to compleition. To check this, my
# PegSoli(M) also outputs each possible all[i]
# (that is, the final outcomes), and it seems
# that there is indeed no possible solution


### OLD STUFF ###

#Sphere(G,i,k): inputs a directed graph G
#(represented as a list of sets where G[i]
#is the set of outgoing neighbors of vertex i)
#and a vertex i (an integer between 1 and nops(G))
#and a non-neg. integer k, outputs the
#set of all vertices for which you can walk
#from i to it with k steps but no less
Sphere:=proc(G,i,k) local S,s,k1:
option remember:

if k=0 then
 RETURN({i}):
fi:

S:=Sphere(G,i,k-1):

 
{seq(op(G[s]),s in S)}
minus
{ seq(op(Sphere(G,i,k1)),k1=0..k-1)}:

end:


#Children(L,n): inputs a legal placement of
#queens on a nops(L) by n board and finds
#all the legal extensions
#For example,
#Children([2,5,1],6);
#should give
#{[2,5,1,4],[2,5,1,6]}
Children:=proc(L,n) local i,S,s,k:
k:=nops(L):

S:={}:

 for s from 1 to n do
   if not s in L and
  {false,
    seq(evalb(abs(L[i]-s)=abs(k+1-i)), i=1..k)}={false} then
    S:=S union {[ op(L), s] }:
   fi:
 od:
S:
end:



#Qnk(n,k): the set of ways of placing k-non-attacking
#queens on a k by n chess-board, represented as
#[a1,a2,,,,, a_k] where a1 is the column of the
#queen at the first row etc.
Qnk:=proc(n,k) local S,L:
option remember:

if k=0 then
  RETURN({[]}):
fi:

S:=Qnk(n,k-1):

{seq(op(Children(L,n)), L in S)}:



end:



### END OLD STUFF ###