#OK to post homework
#Blair Seidler, 4/17/22, Assignment 23
with(combinat):

Help:=proc():
print(`WikiCent(n), `):
end:

#2. Read the wikipedia article on the Centipede game and write a procedure WikiCent(n)
# That generalizes the four-stage game given there with payoffs (1,0),(0,2),(3,1),(2,4) at the
# bottom and to the extereme right (3,3) but please change the (3,3) to (3.1,3.1)
# to a 2n-stage game with payoffs, at the bottom
# (1,0),(0,2),(3,1),(2,4),(5,3),(4,6) ...., (2n-2,2n)
# and to the extereme right (2n-1+ 0.1,2n-1+0.1)
# It should be expressed in our data-structure like in Els() above. Name the n non-leaves on the
# top row in order, followed by the leaf at the extreme right, followed by the leaves at the bottom.
# The second part should be the reward table (but with our convention that the pair of rewards is [a,b],
# where a is the reward of the player currently at that vertex and b the reward of the other player.
# Regardless whether they happen to be Player I or Player II.
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]],seq([2*n+i+1,[i,i-min(i,2)]],i=1..2*n)}:
G,P:
end:


#3. By going back to at least your four grandparents (but the further back the better!) describe your
# own family "tree" (it is not really a tree, but a directed graph). Express it in our notation as a
# directed graph, followed by the "dictionary" the list of names such that L[i] is the name in real life of the vertex named i. For example for Dr. Z.'s immediate family it is
(*
[{3,4},{3,4},{5},{},{},{1},{1},{6},{6},{7},{7},{11},{11},{12},{12},{13},{13},{15},{15},{8},
{8},{20},{20},{22},{22},{24},{24},{9},{9},{28},{28},{30},{30},{32},{32},{34},{34},{36},{36},
{38},{38},{40},{40},{42},{42},{44}]
[BlairSeidler,JenniferBroekman,KatherineBroekman,MargaretBroekman,LiamDenney,
DavidSeidler,AnitaEdelman,JohnSeidler,BettyTiffany,JosephEdelman,
DorisRichstein,IsadorRichstein,BessieLevison,DavidReichstein,EstherStreicher,
JacobRachstein,RichisKorn,IsaacStreicher,NNHerda,AlexanderSeidler,
IsabelleRiker,WilhelmSeidler,AmaliaDeizsler,HeinrichSeidler,MarthaHappel,
JohannSeidler,WilhelminaSchmidt,BuellTiffany,HildaJenkins,EmeryTiffany,
LouiseNoble,JohnSTiffany,HarrietWhitney,JohnTiffany3,SallyBigelow
JohnTiffany2,RutheyClapp,JohnTiffany1,DeliveranceParmiter,JamesTiffany,
BethiahDOE,HumphryTiffany,ElizabethDOE,HenryTiffany2,ElizabethDOE,
HenryTiffany1]

> GenS([{3, 4}, {3, 4}, {5}, {}, {}, {1}, {1}, {6}, {6}, {7}, {7}, {11}, {11}, {12}, {12}, {13}, {13}, {15},
  {15}, {8}, {8}, {20}, {20}, {22}, {22}, {24}, {24}, {9}, {9}, {28}, {28}, {30}, {30}, {32}, {32}, {34},
  {34}, {36}, {36}, {38}, {38}, {40}, {40}, {42}, {42}, {44}]);

[{4, 5}, {3}, {1, 2}, {6, 7}, {8, 9, 10, 11}, 
  {12, 13, 20, 21, 28, 29}, {14, 15, 16, 17, 22, 23, 30, 31}, 
  {18, 19, 24, 25, 32, 33}, {26, 27, 34, 35}, {36, 37}, {38, 39}, 
  {40, 41}, {42, 43}, {44, 45}, {46}]

>nops(%);
                               15

> LaGn([{3, 4}, {3, 4}, {5}, {}, {}, {1}, {1}, {6}, {6}, {7}, {7}, {11}, {11}, {12}, {12}, {13}, {13}, {15},
  {15}, {8}, {8}, {20}, {20}, {22}, {22}, {24}, {24}, {9}, {9}, {28}, {28}, {30}, {30}, {32}, {32}, {34},
  {34}, {36}, {36}, {38}, {38}, {40}, {40}, {42}, {42}, {44}]);

[1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 
  1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 
  1, 0, 0, 1]


This is 15 generations, 12 above me and two below. The DOE's are the wives of ancestors
in the 17th century whose maiden names are unknown.

There are more family lines available, but I think the Tiffany line is the longest for which
I have information. The last name listed is my great^10-grandfather along my paternal
grandmother's male ancestral line. He was born in England around 1575. He is a "winner" according
to LaGn (as are my wife and I).

Information on my mother-in-law's website.
Reference: https://dutchgenie.net/family/family-d-o/index.htm
*)

#4. Prove that we all each other's cousins!
(*

Well, if you believe both Genesis and the accuracy of the numbering of years on the Jewish
calendar, Adam and Eve were around 5782 years ago. If we all descended from them, we are
all nth cousins (k times removed) based on how many generations have passed since then.
If we suppose 20 years between generations (probably close enough), we should all be
approximately 289th cousins.

Probably closer to the truth is that Homo Sapiens emerged in Africa somewhere around 300,000
years ago. If you supposed that we all have a common pair of ancestors around that time, then
we are all about 15,000th cousins. But there may have been some cross-breeding between related
primate species, so it isn't entirely clear that such a pair of ancestors exists.

If you go back far enough, though, we are probably all descended from the same mated pair of
some mammal. But mammals diverged from other vertebrates over 300 million years ago, and I'm
not going to pretend to be able to guess what the average generation lengths are for some
sketchy chain of various species of mammal.
*)

Help23:=proc(): print(` GenS(G) `): 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,L,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},{},{},{}];
         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:




Els:=proc():
[{2, 6}, {3, 7}, {4, 8}, {5, 9}, {}, {}, {}, {}, {}], {[5, [4, 3]], [6, [2, -1]
], [7, [2, 1]], [8, [4, 1]], [9, [3, 6]]}:
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: