#OK to post homework
#Blair Seidler, 5/1/22, Assignment 26
with(combinat):

Help:=proc():
print(`SGwyt(a,b), FindUP(L),  `):
end:

#3. Write a procedure SGwyt(a,b) that finds the Sprague-Grundy value of the position [a,b] in
# Wythoff's game whose rules are the same as 2-pile Nim, except that one can also remove the SAME
# number of pennies from both piles.
SGwyt:=proc(a,b) local i,C,c:
option remember:
C:={seq([a-i,b-i],i=1..min(a,b))} union {seq([a-i,b],i=1..a)} union {seq([a,b-i],i=1..b)}:
mex({seq(SGwyt(op(c)),c in C)}):
end:


#4. Write a procedure FindUP(L) that inputs a list L and outputs a pair of lists L1,L2 such that
# (conjecturally) L=[op(L1),op(L2)^infinity]
# i.e., after an initial segment L1, it starts being periodic of period nops(L2)
FindUP:=proc(L) local i,n,T,P:
n:=nops(L):
for i from 1 to trunc(n/2) do
  T:=[op(i..n,L)]:
  P:=FindPer(T):
  if type(P,list) then RETURN([[op(1..i-1,L)],P]): fi:
od:
FAIL:
end:

#5. By using FindUP(L) and SGwyt(a,b), find(if possible) conjectured ultimate periodic descriptions
# of [seq(SGwyt(i,b)-b,b=0..infinity)] for i=0,1,2,3 (the further the better!)
FindConjPer:=proc(n) local i,b,P:
for i from 0 to n do
  P:=FindUP([seq(SGwyt(i, b) - b, b = 0 .. 10+10*i^2)]):
  print(P):
  printf("n=%d, Initial segment: %d, Period: %d\n",i,nops(P[1]),nops(P[2])):
end do;
end:

(* Output

                           [[], [0]]
n=0, Initial segment: 0, Period: 1


                        [[], [1, 1, -2]]
n=1, Initial segment: 0, Period: 3


                       [[], [2, -1, -1]]
n=2, Initial segment: 0, Period: 3


      [[3, 3, 3, 3, -2, -5, -5, 2], [2, 3, -2, -4, 3, -2]]
n=3, Initial segment: 8, Period: 6


          [[4, 4, 1, -1, 3, 1, 3, -7, -7], 
           [-1, 3, 1, -1, 3, 1, -5, 3, 1, -1, -5, 1]]
n=4, Initial segment: 9, Period: 12


[[5, 2, 2, -3, 2, 3, 4, -6, -6, -2, 2, 3, -3, 2, 3, -2, 2, -6, 
  -2, 2, 3, -2, 2, 3, -2, 2, -6], [-2, 2, 3, -2, 2, 3, -2, 2, -6, 
  -2, 2, 3, -2, 2, 3, -2, 2, 3, -7, 2, 3, -2, 2, -7]]
n=5, Initial segment: 27, Period: 24


[[6, 6, 6, -2, 5, 5, -3, -3, -3, 4, -10, -9, 4, 4, 4, -3, 4, -3, 
  -3, -8, 4, 4, 4, 4, -3, 4, 4, -8, 4, 2, -8, -8, 4, 4, 4, -7, -3
  ], [4, 4, 4, 4, 4, -8, -8, 4, 4, 4, -8, -8]]
n=6, Initial segment: 37, Period: 12


[[7, 7, 4, 6, -4, -4, -2, -2, -5, 5, 5, 2, 5, -11, -4, 4, 5, -5, 
  4, -3, 5, -10, -4, 5, 5, 5, 5, -3, 5, -9, -4, -4, 5, -10, 5, 5, 
  5, -3, 5, -3, -8, 5, -4, 4, 5, -10, -4, 4, -3, 5, 5, -3, -8, 5, 
  -4, -3, 5, 5, 5, 5, -3, 5, -9, -3, -8, 2, 4, 4, 5, -10, 5, 5, 
  -3, -8, 5, -3, -8, 5, -4, 4, 5, -3, 5, 5, -3, 5, -9, -3, -8, 2, 
  -4, 3], [5, 5, 5, 5, -3, -8, 5, -3, -8, 5, 5, 5, 5, -10, -4, 4, 
  -3, 5, -9, -1, -8, 2, 4, -3]]
n=7, Initial segment: 92, Period: 24


[[8, 5, 5, 7, -3, -3, -1, -4, -4, 6, 6, 6, 6, -13, -5, -1, -4, 2, 
  5, 5, 6, 6, 6, -12, -11, -4, -4, 5, -3, 5, 5, -11, -3, 5, -4, 
  6, 6, -4, 6, 6, -3, -10, -6, -4, -4, -2, 5, 5, 5, 6, -4, -1, 
  -3, -5, 5, 3, -9, 6, -4, -3, 5, 6, -5, -1, -3, -5, 5, 5, -4, 5, 
  -4, -3, 5, 5, -5, 5, -3, 6, 6, -4, -4, -11, -3, 3, 5, 6, -5, 5, 
  -3, 5, 5, -4, -4, -11, -4, 6, 6, 6, -5, -1, -3, -5], [6, -4, 
  -4, 5, 5, -3, 4, 6, -5, 5, -3, 5, 5, 5, -9, -11, -4, 6, 6, 6, 
  -5, -10, -3, -3]]
n=8, Initial segment: 102, Period: 24


[[9, 9, 9, 9, 4, 2, 7, 7, 7, 7, 7, -5, 7, -8, -13, -15, -14, -14, 
  -14, 3, 7, 7, 7, -5, -4, 6, -3, 6, -7, -3, -6, 3, 6, 6, 6, -3, 
  -11, -7, -3, 7, 7, 2, -5, 5, -3, 5, 6, -11, -4, -7, 3, -6, 5, 
  2, -5, 5, -5, 7, 7, 2, -6, -3, -3, 5, 5, -3, 6, -11, -5, 6, -3, 
  2, -6, -3, -3, 6, 6, -3, 7, -3, -3, 5, 6, -3, -6, 7, -3, 6, 6, 
  6, -11, -7, -3, -6, -3, 2, -6, 7, 3, 6, 6, -3, 7, -7, 6, -6, 
  -3, -5, 5, 7, -10, -4, 5, -5, 6, 3, -5, 6, -3, 2, -6, 7, -10, 
  -4, 5, 2, 4], [-3, -6, -4, 6, -5, 5, 7, -3, 6, 6, -5, -5, 6, 
  -6, -6, -3, 4, -6, 7, -3, 6, 6, 2, -6]]
n=9, Initial segment: 127, Period: 24


[[10, 10, 7, 5, 9, 7, -6, 8, 8, 8, 4, 7, -5, -7, -12, -12, -15, 
  -13, -13, 4, 8, 5, 5, -3, -5, -3, 3, 4, 6, 4, 6, -6, -8, -12, 
  7, 4, 4, -5, 7, -1, -5, 7, -12, 3, 6, 6, 7, -3, -6, -12, -3, 5, 
  6, 6, 6, 6, -13, 8, 8, 3, -5, -12, -8, -11, 6, -8, 7, 7, 7, -2, 
  -7, 6, -4, 6, 6, -11, -5, -8, 4, -7, 6, 6, 7, 7, 4, 8, -8, -11, 
  -5, -8, 4, -6, 6, -2, 6, -3, -12, 5, -3, 5, 7, 7, 4, -6, -3, 6, 
  6, 6, -12, -6, 5, 6, -13, -8, 7, -6, 6, 7, 7, -3, 7, -3, -8, 
  -13, 6, 6, 7, -7, 6, 6, -11, 6, -4, 8, -8, 7, -13, -8, 6, -7, 
  -4, -2, 6, -3, 5, 5, -8, -1, -5, 6, 4, -6, 6, 6, -7, 6, -5, 8, 
  5, 7, 7, -8, 6, -7, -12, 6, 6, -3, 5, -12, -8, -11, 7, 7, -4, 
  -6, 6, 6, 7, 7, -5, -3, -8, 7, 7, -8, 6, 7, -12, -2, 6, -3, 5, 
  -12, 7, -11, 7, -8, 4, -6, 6, 6, -7, 6, -5, 8, -8, 7, 7, 7, 7, 
  -7, -12, -2, 6, -3, 5, -12, -8, -11, 7, 7, -4, 3], [6, 6, -7, 
  6, -5, 8, -8, 7, 7, -8, 6, 7, -12, -2, 6, -3, 5, -12, -8, -11, 
  7, 7, 4, -6]]
n=10, Initial segment: 224, Period: 24

*)

#6. [Optional challenge, 10 dollars to be divided anont all correct solutions] What is SGwyt(5,10100)
(*
Well, (10^100-27) mod 24=13, so we are looking at the 13th number in the repeating part of the
sequence above, which is -2.

That means that SGwyt(5, 10^100) - 10^100 = -2, so we have SGwyt(5, 10^100) = 10^100 - 2

*)


#C26.txt

#SGnim(L): inputs a Nim position with k=nops(L) piles with L[i] pennies in pile i
#finds its S-G  value
SGnim:=proc(L) local k,i,j,C,c:
option remember:
k:=nops(L):
#C is the set of children of L
C:={seq(seq([ op(1..i-1,L), j  ,  op(i+1..k,L)],j=0..L[i]-1),i=1..k)}   :
mex({seq(SGnim(c),c in C)}):
end:

#IsPer1(L,p): Is the list L periodic of period p
IsPer1:=proc(L,p) local i:
for i from 1 to nops(L)-p do
 if L[i]<>L[i+p] then
  RETURN(false):
fi:
od:
true:
end:

#FindPer(L): finds the smallest period or return FAIL
FindPer:=proc(L) local p:
for p from 1 to trunc(nops(L)/2) do
if IsPer1(L,p) then
   RETURN([op(1..p,L)]):
fi:
od:
FAIL:
end:

#NimSum(a,b): A better recursive description of a and b
NimSum:=proc(a,b)
option remember:
if a=0 and b=0 then
 RETURN(0):
fi:

if a mod 2 =0 and b mod 2=0 then
RETURN(2*NimSum(a/2,b/2)):

elif a mod 2 =1 and b mod 2=0 then
2*NimSum((a-1)/2,b/2)+1:

elif a mod 2 =0 and b mod 2=1 then
2*NimSum(a/2,(b-1)/2)+1:
else

2*NimSum((a-1)/2,(b-1)/2):
fi:


end:


#C25.txt: Maple code for Lecture 25 of Experimental Mathematics (Game Theory) taught by Dr. Z.

Help25:=proc(): print(` CP(G1,G2) , SG(G) `):end:

#CP(G1,G2): the Cartesian product of the games G1 and G2 given in our data-structure, followed by the "dictionary"
#n1:=nops(G1): n2:=nops(G2): G1xG2 would have n1*n2 vetrtices

CP:=proc(G1,G2) local n1,n2,i1,i2,S1,S2,s1,s2,V,T,ID,s,G,S,i:
n1:=nops(G1):
n2:=nops(G2):
#T[i1,i2]: The set of legal moves [j1,j2] reachable from [i1,i2]
for i1 from 1 to n1 do
 for i2 from 1 to n2 do
   S1:=G1[i1]:
   S2:=G2[i2]:
  T[i1,i2]:={seq([i1,s2],s2 in S2)} union {seq([s1,i2],s1 in S1)}:
od:
od:
V:=[seq(seq([i1,i2],i2=1..n2),i1=1..n1)]:
for i1 from 1 to nops(V) do
 ID[V[i1]]:=i1:
od:
#[2,3]->{[1,3],[0,3],[2,2],[2,1],[2,0]}:
G:=[]:
 for i from 1 to nops(V) do
  S:=T[op(V[i])]:
 G:=[op(G), {seq(ID[s],s in S)}]:
od:
G:
end:



#Added after class
#SG(G): The Sprague-Grundy function of a combinatorial game G, given as a directed graph (w/o cycles) in our convention where the vertices are called 1,...,n, (n=nops(G)) and
#G[i] is the set of vertices reachable from i in one legal move.
SG:=proc(G) local n,L,T,i,j,s:
n:=nops(G):
L:=GenS(G):
for i in L[1] do
 T[i]:=0:
od:

for j from 2 to nops(L) do
  for i in L[j] do
   T[i]:=mex({seq(T[s], s in G[i])}):
 od:
od:

[seq(T[i],i=1..n)]:
end:


#OLD STUFF
#C24.txt: April 18, 2022
Help24:=proc(): print(`GenSn(G), WikiCent(n), LaC(G,R), WikiCent1(n)  `):
print(`LabelP(L), Sparta(), Sandy() `):
end:

#Added April 21, 2022 (before class)
Sandy:=proc():[{2,3},{3},{}],[Sandy,Dicky,Lucy]:end:


#Added April 21, 2022 (before class)
#Sparta(): The family "tree" of Anaxendridas, King of Sparta
Sparta:=proc():
[{2,3},{5},{4},{5},{}],[Anaxandridas,Leonidas,Cleomenes,Gorgo,Pleistarchus]:
end:


#LabelP(L): inputs a list of pairs [[a_i,b_i]], outputs [b_j,a_j] where b_j is
#is the largest b_i
LabelP:=proc(L) local i:
i:=max[index]([seq(L[i][2],i=1..nops(L))]):
[L[i][2],L[i][1]]:
end:

#LaC(G,R): Inputs a directed graph G, and R, a set of pairs [sink, [a,b]]
#outputs the list of labels of all the vertices
LaC:=proc(G,R) local n,L,T,i,j,r,k:
n:=nops(G):

L:=GenS(G):
 if {seq(r[1],r in R)}<>L[1] then
  RETURN(FAIL):
 fi:
for r in R do
  T[r[1]]:=r[2]:
od:

for j from 2 to nops(L) do
  for i in L[j] do
    T[i]:=LabelP([seq(T[k], k in G[i])]):
  od:
od:
[seq(T[i],i=1..n)]:
end:



#WikiCent(n): The centipede game 2*n non-leaf vertices and 2*n+1 leaves wich that 1 goes 2 and 2*n+2,
#2 goes to 3 and 2*n+3, ..., 2*n goes to 2*n+1 and 4*n+1, and the reward pairs for
#vertex 2*n+1 is [2*n-1+0.1,2*n-1+0.1], the reward pair of vertex 2*n+2 is [0,1], and the reward
#pair for vertex [2*n+3+i] (i=0..2*n-2) is [i,i+2]
WikiCent:=proc(n) local i,G,P:
G:=[seq({i+1,i+2*n+1},i=1..2*n),seq({},i=1..2*n+1)]:
P:={[2*n+1,[2*n-1+ 0.1,2*n-1+0.1]],[2*n+2,[0,1]],seq([2*n+3+i,[i,i+2]],i=0..2*n-2)}:
G,P:
end:


#WikiCent1(n): Same as WikiCent(n) but with ONE edge removed
WikiCent1:=proc(n) local i,G,P:
G:=[seq({i+1,i+2*n+1},i=1..2*n-1),{2*n+1},seq({},i=1..2*n+1)]:
P:={[2*n+1,[2*n-1+ 0.1,2*n-1+0.1]],[2*n+2,[0,1]],seq([2*n+3+i,[i,i+2]],i=0..2*n-2)}:
G,P:
end:




#GenSn(G): Inputs a directed graph (w/o cycles) and outputs a list of "generations"
#L[1] : the set of vertices that are sinks (no childre), and L[i] the set of vertices
#all whose children are in L[1] union L[i-1]
GenSn:=proc(G) local n,T,i,j,NYD,AD,j1,ma,AP:
#New version checking for bad input

AP:={seq(op(G[i]),i=1..nops(G))}:

ma:=max(AP):
if ma>nops(G) then
 RETURN(FAIL):
fi:


n:=nops(G):
NYD:={seq(i,i=1..n)}:
T[1]:={}:
 for i from 1 to n do
  if G[i]={} then
    T[1]:=T[1] union {i}:
  fi:
 od:
NYD:=NYD minus T[1]:
AD:=T[1]:
for j from 2 while NYD<>{} do
 T[j]:={}:
  for i in NYD do
   if G[i] minus AD={} then
     T[j]:=T[j] union {i}:
   fi:
  od:
AD:=AD union T[j]:
NYD:=NYD minus T[j]:
od:
[seq(T[j1],j1=1..j-1)]:
end:




####
Help23:=proc(): print(` GenS(G), Els() `): end:

#GenS(G): Inputs a directed graph (w/o cycles) and outputs a list of "generations"
#L[1] : the set of vertices that are sinks (no childre), and L[i] the set of vertices
#all whose children are in L[1] union L[i-1]
GenS:=proc(G) local n,T,i,j,NYD,AD,j1:
n:=nops(G):
NYD:={seq(i,i=1..n)}:
T[1]:={}:
 for i from 1 to n do
  if G[i]={} then
    T[1]:=T[1] union {i}:
  fi:
 od:
NYD:=NYD minus T[1]:
AD:=T[1]:
for j from 2 while NYD<>{} do
 T[j]:={}:
  for i in NYD do
   if G[i] minus AD={} then
     T[j]:=T[j] union {i}:
   fi:
  od:
AD:=AD union T[j]:
NYD:=NYD minus T[j]:
od:
[seq(T[j1],j1=1..j-1)]:
end:




#DZ:=[{3,4,5},{3,4,5},{6},{},{},{}];

#GenS(DZ);
#                    [{4, 5, 6}, {3}, {1, 2}]

#LaGn(G): Same as LaG(G) from C22.txt, but hopefully better (at least more adaptable for the Centipede games)
LaGn:=proc(G) local n,L,T,i,j,s:
n:=nops(G):
L:=GenS(G):
for i in L[1] do
 T[i]:=0:
od:

for j from 2 to nops(L) do
  for i in L[j] do
     if member(0,{seq(T[s], s in G[i])}) then
      T[i]:=1:
      else
       T[i]:=0:
      fi:
 od:
od:
[seq(T[i],i=1..n)]:
end:




#The Elster graph
Els:=proc():
[{2, 6}, {3, 7}, {4, 8}, {5, 9}, {}, {}, {}, {}, {}], {[5, [3, 4]], [6, [-1, 2]
], [7, [1, 2]], [8, [1, 4]], [9, [6, 3]]}:
end:


Els1:=proc():
[{2, 6}, {3, 7}, {4, 8}, {9}, {}, {}, {}, {}, {}], {[5, [3, 4]], [6, [-1, 2]
], [7, [1, 2]], [8, [1, 4]], [9, [6, 3]]}:
end:


###STUFF FROM C22.txt

#C22.txt: April 11, 2022
Help22:=proc(): print(`mex(S), ai(i), aiC(i), RDG(n,p), Parents(G), OneStep0(G,AL,T)  , OneStep1(G,AL,T), OneStep(G,AL,T), LaG(G)    `):
end:

#mex(S): inputs a set of NON-NEGATIVE integers and outputs the smallest
#non-neg. intger NOT in the set S, i.e. min({0,1,2,3,...} minus S)
mex:=proc(S) local i:
for i from 0 while member(i,S) do od:
i:
end:

#ai(i): the a-component in the losing position for Wythoff's game [a_i,i+a_i]
ai:=proc(i) local j:
option remember:
 if i=0 then
   RETURN(0):
else
mex({seq(ai(j),j=0..i-1),seq(ai(j)+j,j=0..i-1)}):
fi:
end:

#aiC(i) : Faster way to compute ai(i) using Wythof's formula trunc(phi*i):
aiC:=proc(i)
trunc((1+sqrt(5))/2*i):
end:

#RDG(n,p): inputs a pos. integer n and a RATIONAL number p=a/b between 0 and 1
#and outputs a random directed graph w/o cycles such tha the prob. of
#an edge is p
RDG:=proc(n,p) local a,b,L,i,j,S,ra:
a:=numer(p):
b:=denom(p):

ra:=rand(1..b):

L:=[]:

for i from 1 to n do
 S:={}:
  for j from i+1 to n do
    if ra()<=a then
     S:=S union {j}:
    fi:
  od:
L:=[op(L),S]:
od:

L:
end:

#Parents(G): inputs a directed graph on {1,...,n} where n:=nops(G) such that G[i] is  the set of children of i (the set of outgoing neihbors)
#outputs the list whose i-th component is the set of "parents" of i, i.e. those j such that i belongs to G[j]. For example
#Parents([{2,3},{3},{}]); should be [{},{1},{1,2}]
Parents:=proc(G) local n,i,j,P:
option remember:
n:=nops(G):

#We initialize all the parents-sets to be empty
for j from 1 to n do
P[j]:={}:
od:

for i from 1 to n do
 for j in G[i] do
  P[j]:=P[j] union {i}:
 od:
od:

#For each vertex i (we look for its children) and append i to the set of parents of each such child

[seq(P[j],j=1..n)]:

end:



#OneStep0(G,AL,T): Given a graph G, with a set of already labelled vertices AL and a table T of lables
#performs one step in the labelling algorithm, the implication that if a vertex is labeled 0 then all its parents are labeled 1
#(since there exists is a legal move that will make the opponent lose)
OneStep0:=proc(G,AL,T) local AL1,n,T1,i,j,P:
AL1:=AL:
n:=nops(G):
P:=Parents(G):
T1:=T:
for i in AL do
 if T1[i]=0 then
  for j in P[i] do
  T1:=[op(1..j-1,T1),1,op(j+1..n,T1)]:
    AL1:=AL1 union {j}:
  od:
 fi:
od:

RETURN(G,AL1,T1):
end:


#OneStep1(G,AL,T): Given a graph G, with a set of already labelled vertices AL and a table T of lables
#performs one step in the labelling algorithm, that if all the children of a vertex are already labeld 1 then
#it is labeled 0 (since whatever the player can do it would be winning for the opponent)
OneStep1:=proc(G,AL,T) local n,T1,i,j:

n:=nops(G):
T1:=T:

 for i from 1 to n do
 if not member(i,AL) then
   if G[i] minus AL={} and {seq(T1[j],j in G[i])}={1} then
  T1:=[op(1..i-1,T1),0,op(i+1..n,T1)]:
     RETURN(G,AL union {i},T1):
   fi:
  fi:
 od:
G,AL,T1:
end:

#OneStep(G,AL,T): Given a graph G, with a set of already labelled vertices AL and a table T of lables
#performs one step in the labelling algorithm, that if all the children of a vertex are already labeld 1 then
#it is labeled 0 (since whatever the player can do it would be winning for the opponent)

OneStep:=proc(G,AL,T) local n,Hope:
n:=nops(G):
if nops(AL)=n then
 RETURN(G,AL,op(T)):
fi:

Hope:=OneStep0(G,AL,T):
if nops(Hope[2])>nops(AL) then
  RETURN(Hope):
fi:


Hope:=OneStep1(G,AL,T):
if nops(Hope[2])>nops(AL) then
  RETURN(Hope):
fi:

FAIL:

end:


#LaG(G)
LaG:=proc(G) local n,i,AL,T,Hope:
n:=nops(G):

T:=[(-1)$n]:

AL:={}:

for i from 1 to n do
 if G[i]={}  then
 T:=[op(1..i-1,T),0,op(i+1..n,T)]:
  AL:=AL union {i}:
 fi:
od:

Hope:=G,AL,T:
while nops(Hope[2])<n do
Hope:=OneStep(Hope):
od:

[seq(Hope[3][i],i=1..n)]:
end:
   










Help25hw:=proc(): print(`BestPrune(G,R), RandCent(n,p,K), FindParadox(n,p,K,K1), ExC()`):end:


####From Natasha's homework
#Problem 1
#BestPrune(G,R): nputs a directed graph G followed by the set of Rewards {[i,[a,b]], i is a sink} and tries to see whether there exists an edge whose deletion will make the label of vertex 1 (the pay-offs) better for BOTH players.

BestPrune:= proc(G,R) local n, i, j, curBest, Gtry, bestEdge, updated, current:
n:=nops(G):
curBest:=LaC(G,R)[1]:
updated:=false:
for i from 1 to n do
	for j in G[i] do
		Gtry:=G:
		Gtry[i]:=Gtry[i] minus {j}:
		current:=LaC(Gtry,R):
		if current<>FAIL then
		current:=current[1]:
		if (current[1]>curBest[1] and current[2]>curBest[2]) then 
			curBest:=current:
			bestEdge:=[i,j]:
			updated:=true:
		fi:
		fi:
	od:
od:
if updated then return(bestEdge): fi:
FAIL:
end:

BestPrune(Els()):
#[4,5]
BestPrune(WikiCent(20)):
#[40,81]

#Problem 2

#RandCent(n,p,K): generates a random centipded pair G,R, where G is RDG(n,p) and the payoffs for the sinks of G are random integers from 0 to K

RandCent:=proc(n,p,K) local G, R,k,i:
G:=RDG(n,p): 
R:={}: 
k:=rand(K+1):
for i from 1 to n do
	if G[i]={} then
		R:=R union {[i,[k(),k()]]}:
	fi:
od:
G,R:
end:

#Problem 3

#FindParadox(n,p,K,K1): tries K1 times to generate RandCent(n,p,K) and stops as soon as it finds something that is not FAIL. If it can't find anything, it should return FAIL.

FindParadox:=proc(n,p,K,K1) local i, game, pruned:
for i from 1 to K1 do
	game:=RandCent(n,p,K):
	pruned:=BestPrune(game):
	if pruned<>FAIL then return(game, pruned) fi:
od:
FAIL:
end:

ExC:=proc():
[{4, 5, 7, 10, 11, 14, 15, 16, 18, 22, 24, 25, 26, 27, 28, 29, 30}, {4, 5, 8, 10, 16, 17, 19, 20, 21, 22, 25, 30}, {5, 8, 9, 10, 15, 18, 21, 24, 27, 28, 30}, {8, 10, 11, 14, 15, 17, 18, 19, 21, 23, 24, 25, 26, 28, 29}, {7, 9, 10, 11, 15, 17, 18, 20, 21, 22, 23, 24, 29}, {8, 14, 17, 18, 19, 23, 25, 27, 29}, {8, 9, 10, 15, 16, 17, 20, 21, 22, 24, 25, 27, 28, 30}, {9, 11, 12, 14, 15, 17, 21, 22, 23, 25, 26, 27, 30}, {11, 14, 15, 18, 19, 20, 22, 25, 26, 27}, {11, 12, 13, 14, 16, 17, 25, 27, 29, 30}, {17, 18, 19, 20, 21, 22, 23, 24, 27, 28, 30}, {13, 14, 19, 20, 21, 22, 23, 24, 25, 30}, {14, 19, 23, 24, 25, 26, 27, 30}, {15, 17, 20, 21, 25, 26, 28, 29, 30}, {17, 18, 22, 25, 26, 30}, {17, 18, 21, 23, 24, 26, 27, 30}, {21, 23, 24, 25, 27, 28}, {22, 23, 25, 27, 29}, {23, 24, 28, 29, 30}, {21, 23, 24, 26, 29, 30}, {25, 27, 29}, {23, 25, 27, 28}, {26, 27, 28, 30}, {25, 26, 27, 28, 29, 30}, {27, 29, 30}, {27, 28}, {28, 29}, {29}, {}, {}], {[29, [2, 46]], [30, [47, 46]]}:
end:
####EndFrom Natasha's homework