#Nathan Fox #Homework 5 #I give permission for this file to be posted online #Help procedure Help:=proc() : print(` RandDi(n,k) , SphereWithPaths(G,i,k) , Knk(n,k) `): print(` ChildrenKrook(L,n) , ChildrenMook(L,n) `): print(` MMChildren(n,P) , MCSolve(n,i,j,old) , MCSol(n) `): print(` PegSoliChildren(M) , PegJump(M,i,j,d) `): print(` PegSolve(M,win) , PegSolveStd(M) `): end: ##Auxiliary Procedures #RandDi(n,k): a random directed graph with n #vertices and (usually) outdegree k RandDi:=proc(n,k) local ra,i,j: ra:=rand(1..n): [seq({seq(ra(),i=1..k)} minus {j},j=1..n)]: end: #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 nonnegative 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: ##Problem 2 #SphereWithPaths(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 nonnegative integer k, 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. #The choice is random, but once it's made once, the same #choice will be made forever, because of option remember SphereWithPaths:=proc(G,i,k) local S,T,S2,sphere,L,j: option remember: if k=0 then RETURN({[i]}): fi: S:=SphereWithPaths(G,i,k-1): T:=table(): sphere:=Sphere(G,i,k): for j in sphere do T[j]:=[]; od: #print(sphere): for L in S do for j in G[L[k]] do if j in sphere then T[j]:=[op(T[j]), [op(L), j]]: fi: od: od: #print(op(T)): S2:={}: for j in sphere do: S2:=S2 union {T[j][rand(1..nops(T[j]))()]}: #print(S2): od: return S2: end: ##Problem 3 #Knk(n,k): generates the set of ways of placing k #non-attacking krooks on a k by n chess-board. #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. Output represented as #[a1,a2,...,a_k] where a1 is the column of the #krook at the first row etc. Knk:=proc(n,k) local S,L: option remember: if k=0 then RETURN({[]}): fi: S:=Knk(n,k-1): {seq(op(ChildrenKrook(L,n)), L in S)}: end: #ChildrenKrook(L,n): inputs a legal placement of #krooks on a nops(L) by n board and finds #all the legal extensions ChildrenKrook:=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 not true in {seq(evalb(abs(L[i]-s)=abs(k+1-i) and abs(L[i]-s)=1),i=1..k)} then S:=S union {[op(L), s]}: fi: od: S: end: #The (start of the) sequence #[seq(nops(Knk(n,n),n=1..infinity)] #is in Sloane? ##Problem 4 #Mnk(n,k,r): generates the set of ways of placing k #non-attacking mooks of order r on a k by n chess-board. #a mook is a hybrid of a chess King and a chess rook, #i.e. it is like a Queen that can only move diagonally #r units. Output represented as #[a1,a2,...,a_k] where a1 is the column of the #mook at the first row etc. Mnk:=proc(n,k,r) local S,L: option remember: if k=0 then RETURN({[]}): fi: S:=Mnk(n,k-1,r): {seq(op(ChildrenMook(L,n,r)), L in S)}: end: #ChildrenMook(L,n,r): inputs a legal placement of #mooks of order r on a nops(L) by n board and finds #all the legal extensions ChildrenMook:=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 not true in {seq(evalb(abs(L[i]-s)=abs(k+1-i) and abs(L[i]-s)<=r),i=1..k)} then S:=S union {[op(L), s]}: fi: od: S: end: #Sequences for r=0,1 are in Sloane ##Problem 5 #n missionaries and n cannibals, right now #you have P=[i,j,b] #i missionaries and j cannibals #on the left bank of the river, and hence #a-i and a-j respectively on the other bank #b=0 if boat is on the left bank #and b=1 if the boat is on the right bank MMChildren:=proc(n,P) local i,j,b,S: i:=P[1]: j:=P[2]: b:=P[3]: #if i>0 then j<=i #if n-i>0 then n-j<=n-i #i.e., if i0 and (i-1=0 or j<=i-1) and i-1<=j then S:=S union {[i-1,j,1]}: fi: #Move 2 missionaries if i>1 and (i-2=0 or j<=i-2) and i-2<=j then S:=S union {[i-2,j,1]}: fi: #Move 1 cannibal if j>0 and (i=n or i<=j-1) and (i=0 or j-1<=i) then S:=S union {[i,j-1,1]}: fi: #Move 2 cannibals if j>1 and (i=n or i<=j-2) and (i=0 or j-2<=i) then S:=S union {[i,j-2,1]}: fi: #Move 1 missionary and 1 cannibal if i>0 and j>0 and (i-1=0 or j-1<=i-1) and i-1<=j-1 then S:=S union {[i-1,j-1,1]}: fi: else #Move 1 missionary if iFAIL then return [[i,j,0], s, op(sln)]: fi: fi: od: od: return FAIL: end: #Solve for n & n MCSol:=proc(n) MCSolve(n,n,n,{}): end: ##Problem 6 #PegSoliChildren(M): inputs a k by n matrix M of zeroes #and ones, where a one is a peg, 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,T: k:=nops(M): n:=nops(M[1]): #Secret, extra-special data structure that #lets us avoid bounds checking T:=table(): T[-1]:=table(): T[0]:=table(): T[k+1]:=table(): T[k+2]:=table(): for i from -1 to n+2 do T[-1][i]:=0: T[0][i]:=0: T[k+1][i]:=0: T[k+2][i]:=0: od: for i from 1 to k do T[i]:=table(): T[i][-1]:=0: T[i][0]:=0: T[i][n+1]:=0: T[i][n+2]:=0: for j from 1 to n do T[i][j]:=M[i][j]: od: od: S:={}: for i from 1 to k do for j from 1 to n do if T[i][j]=0 then if T[i-1][j]=1 and T[i-2][j]=1 then S:=S union {PegJump(M,i,j,0)} fi: if T[i+1][j]=1 and T[i+2][j]=1 then S:=S union {PegJump(M,i,j,1)} fi: if T[i][j-1]=1 and T[i][j-2]=1 then S:=S union {PegJump(M,i,j,2)} fi: if T[i][j+1]=1 and T[i][j+2]=1 then S:=S union {PegJump(M,i,j,3)} fi: fi: od: od: S: end: #Auxiliary peg solitaire procedure #0=from above #1=from below #2=from left #3=from right PegJump:=proc(M,i,j,d) local ret: ret:=M: ret[i][j]:=1: if d=0 then ret[i-1][j]:=0: ret[i-2][j]:=0: elif d=1 then ret[i+1][j]:=0: ret[i+2][j]:=0: elif d=2 then ret[i][j-1]:=0: ret[i][j-2]:=0: elif d=3 then ret[i][j+1]:=0: ret[i][j+2]:=0: fi: ret: end: ##Problem 7 #PegSolve(M, win): Solves peg solitaire on a kxn board #returns a sequence of winning moves, or FAIL #if no solution exists #You win if you reach a winning position (in the win set) PegSolve:=proc(M,win) local S,m,sol: option remember: if M in win then return [M]: fi: S:=PegSoliChildren(M): for m in S do sol:=PegSolve(m, win): if sol<>FAIL then return [M, op(sol)]: fi: od: return FAIL: end: #PegSolveStd(M): Solves peg solitaire on a kxn board #returns a sequence of winning moves, or FAIL #if no solution exists #You win iff you convert all 0 to 1 and 1 to 0 in M PegSolveStd:=proc(M) local win,i,j: win:=M: for i from 1 to nops(M) do for j from 1 to nops(M[i]) do win[i][j]:=1-win[i][j]: od: od: PegSolve(M,{win}): end: #The four-by-four Peg Solitaire with a one hole at a #corner is not solvable