# You can post my homework online. read `/home/vverna/programs/em13/C5.mpl`: Help := proc(): print(` SphereWithPaths(G, i, k) KrookChildren(L, n) Knk(n, k) MookChildren(L, n) Mnk(n, k)`): end: # SphereWithPaths(G, i, k) # Inputs a Graph, a vertex i and a nonnegative integer k. # Outputs the list of paths of length k that can be reached from i, removing duplicate paths leading to the same final node. SphereWithPaths := proc(G, i, k) local S, path, result, node, newpath, seen_nodes: option remember: if k = 0 then return {[i]}: fi: S := SphereWithPaths(G, i, k-1): result := {}: # keeps track of the end verticies, so we don't end up listing duplicates twice. seen_nodes := {}: for path in S do: for node in G[path[nops(path)]] do: if not node in path and not node in seen_nodes then seen_nodes := {op(seen_nodes), node}: newpath := [op(path), node]: result := {op(result), newpath}: fi: od: od: return result: end: # KrookChildren(L, n): inputs a legal placement of krooks on a nops(L) by n board # and finds all the legal extensions. # For example, # KrookChildren([2,5,1], 6) should give # {[2,5,1,3], [2,5,1,4], [2,5,1,6]} KrookChildren := proc(L, n) local i, S, col, rows: option remember: rows := nops(L): S:= {}: for col from 1 to n do: # if I don't intersect with something vertically, and am not next to something. if not col in L and {true, seq(evalb(abs(rows + 1 - i) > 1 or abs(col - L[i]) > 1), i=1..rows )} = {true} then S := S union {[ op(L), col]}: fi: od: return S: end: # Knk(n, k): the set of ways of placing k non-attacking krooks on an k x n chess board. # A placement is represented as [a1, a2, ..., ak] where ai is the column of krook on row i. Knk := proc(n, k) local S, L: option remember: if k = 0 then return {[]}: fi: S := Knk(n, k-1): return {seq(op(KrookChildren(L, n)), L in S)}: end: # The sequence is Hertzsprung's problem. # MookChildren(L, n, r): inputs a legal placement of mooks on a nops(L) by n board # and finds all the legal extensions. # For example, # MookChildren([2,5,1], 6, 1) should give # {[2,5,1,3], [2,5,1,4], [2,5,1,6]} # MookChildren([2,5,1], 6, 6) should give # {[2,5,1,4], [2,5,1,6]} MookChildren := proc(L, n, r) local i, S, col, rows: option remember: rows := nops(L): S:= {}: for col from 1 to n do: # if I don't intersect with something vertically, and am not next to something. if not col in L and {false, seq(evalb(abs(rows + 1 - i) = abs(col - L[i]) and abs(col - L[i]) <= r ), i=1..rows)} = {false} then S := S union {[ op(L), col]}: fi: od: return S: end: # Mnk(n, k, r): the set of ways of placing k non-attacking r-mooks on an k x n chess board. # A placement is represented as [a1, a2, ..., ak] where ai is the column of mook on row i. Mnk := proc(n, k, r) local S, L: option remember: if k = 0 then return {[]}: fi: S := Mnk(n, k-1, r): return {seq(op(MookChildren(L, n, r)), L in S)}: end: # PegSoliChildren - inputs M a peg solitaire board as a list of lists. # outputs the set of all positions reachable from M with one less peg. PegSoliChildren := proc(M) local row, col, result, N: result := {}: for row in 1..nops(M) do: for col in 1..nops(M) do: # we have a peg if M[row][col] = 1 then # we have a peg to the right and an empty space two spaces to the right. if col+2 <= nops(M[row]) and M[row][col+1] = 1 and M[row][col+2] = 0 then N := M: N[row][col] := 0: N[row][col+1] := 0: N[row][col+2] := 1: result := {op(result), N}: fi: # we have a peg to the left and an empty space two spaces to the left. if col-2 > 0 and M[row][col-1] = 1 and M[row][col-2] = 0 then N := M: N[row][col] := 0: N[row][col-1] := 0: N[row][col-2] := 1: result := {op(result), N}: fi: # we have a peg to the top and an empty space two spaces to the top. if row+2 <= nops(M) and M[row+1][col] = 1 and M[row+2][col] = 0 then N := M: N[row][col] := 0: N[row+1][col] := 0: N[row+2][col] := 1: result := {op(result), N}: fi: # we have a peg to the bottom and an empty space two spaces to the bottom. if row-2 > 0 and M[row-1][col] = 1 and M[row-2][col] = 0 then N := M: N[row][col] := 0: N[row-1][col] := 0: N[row-2][col] := 1: result := {op(result), N}: fi: fi: od: od: return result: end: # Solving Peg Solitaire on 4x4 SolvePeg := proc(M) local total, i, j, child, children: option remember: children := PegSoliChildren(M): if children = {} then total := add(add(M[i][j], j=1..nops(M[i])), i=1..nops(M)): return evalb(total = 1): fi: for child in children do: if SolvePeg(child) then return true: fi: od: return false: end: # calling this on M:= [[1,1,1,0], [1,1,1,1], [1,1,1,1], [1,1,1,1]] says that this is an unsolvable po sition