#OK to post homework
#Blair Seidler, 1/30/22, Assignment 2


#              *** NOTE TO ANYONE READING THIS CODE ***
#
# I decided to modify BR1, BR2, BR1v, and BR2v so they will accept games which
# have the row and column labels intact. Therefore the inputs to my procedures
# are not just bi-matrices as specified in the assignment, but games in the format
# [[bi-matrix],[row labels],[col labels]] as returned by GameDB() and
# Rand2PlayerGame(a,b,K).
#
# Therefore if you run PureNashEqui(GameDB()[1]), it will return
# {[Fink, Fink]} instead of {[2,2]}

with(combinat):

Help:=proc():
print(` IsNash(G,a1,a2), PureNashEqui(G)`):
end:

#2. 
(*
for i to 5 do
    a := Rand2PlayerGame(5, 5, 5);
    BR1v(a);
    BR2v(a);
end do;

 a := [[[[4, 4], [0, 4], [1, 1], [1, 4], [4, 0]], 

   [[4, 2], [0, 4], [1, 1], [3, 3], [2, 4]], 

   [[3, 3], [4, 2], [3, 2], [3, 0], [2, 1]], 

   [[5, 3], [1, 1], [2, 3], [1, 5], [3, 5]], 

   [[1, 3], [3, 4], [4, 4], [3, 0], [4, 5]]], [1, 2, 3, 4, 5], 

   [1, 2, 3, 4, 5]]
               [{4}, {3}, {5}, {2, 3, 5}, {1, 5}]
             [{1, 2, 4}, {2, 5}, {1}, {4, 5}, {5}]


 a := [[[[5, 3], [5, 5], [4, 2], [0, 0], [5, 5]], 

   [[4, 2], [0, 0], [1, 2], [3, 2], [2, 3]], 

   [[5, 0], [0, 4], [5, 3], [0, 3], [1, 1]], 

   [[5, 2], [1, 5], [3, 1], [0, 5], [0, 4]], 

   [[1, 0], [5, 3], [1, 0], [5, 3], [1, 4]]], [1, 2, 3, 4, 5], 

   [1, 2, 3, 4, 5]]
               [{1, 3, 4}, {1, 5}, {3}, {5}, {1}]
                [{2, 5}, {5}, {2}, {2, 4}, {5}]


 a := [[[[1, 2], [4, 4], [2, 3], [0, 4], [4, 5]], 

   [[3, 4], [0, 5], [1, 0], [0, 5], [2, 4]], 

   [[1, 3], [5, 2], [4, 0], [3, 4], [0, 2]], 

   [[1, 5], [4, 5], [1, 4], [2, 0], [0, 3]], 

   [[1, 1], [1, 0], [5, 5], [5, 1], [0, 3]]], [1, 2, 3, 4, 5], 

   [1, 2, 3, 4, 5]]
                   [{2}, {3}, {5}, {5}, {1}]
                [{5}, {2, 4}, {4}, {1, 2}, {3}]


 a := [[[[0, 3], [5, 0], [5, 0], [3, 4], [0, 5]], 

   [[2, 1], [0, 2], [3, 3], [3, 5], [2, 1]], 

   [[1, 1], [0, 5], [5, 1], [1, 2], [4, 5]], 

   [[0, 0], [3, 5], [1, 2], [0, 5], [0, 3]], 

   [[0, 2], [2, 5], [3, 2], [1, 1], [0, 5]]], [1, 2, 3, 4, 5], 

   [1, 2, 3, 4, 5]]
                [{2}, {1}, {1, 3}, {1, 2}, {3}]
               [{5}, {4}, {2, 5}, {2, 4}, {2, 5}]


 a := [[[[5, 2], [1, 0], [3, 1], [3, 3], [3, 2]], 

   [[0, 3], [0, 4], [4, 0], [3, 1], [3, 0]], 

   [[0, 3], [1, 5], [3, 2], [3, 5], [3, 5]], 

   [[3, 5], [3, 3], [0, 1], [0, 4], [1, 0]], 

   [[1, 0], [3, 3], [5, 0], [4, 5], [5, 2]]], [1, 2, 3, 4, 5], 

   [1, 2, 3, 4, 5]]
                  [{1}, {4, 5}, {5}, {5}, {5}]
                [{4}, {2}, {2, 4, 5}, {1}, {4}]

*)

#3. done

#4.
IsNash:= proc(G,a1,a2): evalb((a2 in BR2(G,a1)) and (a1 in BR1(G,a2))): end:

#5.
PureNashEqui:=proc(G) local row,col,nash:
nash:={}:
for row from 1 to nops(G[2]) do
  for col from 1 to nops(G[3]) do
    if IsNash(G,row,col) then
      nash:=nash union {[G[2][row],G[3][col]]}:
    fi:
  od:
od:
nash:
end:

(* experimental output:
for i to 5 do
    a := Rand2PlayerGame(10, 12, 10);
    PureNashEqui(a);
end do;
a := [[[[6, 1], [8, 7], [10, 9], [5, 3], [1, 10], [1, 10], 

  [10, 7], [1, 5], [7, 4], [8, 9], [7, 4], [1, 6]], [[4, 7], 

  [9, 3], [7, 8], [1, 7], [4, 4], [10, 8], [9, 8], [7, 9], 

  [9, 7], [8, 2], [3, 5], [2, 6]], [[7, 10], [2, 3], [4, 10], 

  [7, 7], [10, 4], [4, 10], [9, 7], [6, 0], [0, 10], [9, 2], 

  [0, 1], [2, 9]], [[9, 4], [0, 0], [8, 0], [4, 2], [7, 0], 

  [1, 6], [4, 2], [9, 0], [2, 10], [6, 9], [2, 9], [1, 6]], [

  [5, 9], [2, 9], [7, 8], [9, 4], [5, 4], [3, 2], [3, 3], 

  [10, 0], [3, 0], [10, 8], [0, 6], [5, 3]], [[6, 4], [4, 3], 

  [8, 5], [2, 1], [3, 9], [9, 2], [5, 2], [9, 9], [6, 4], [7, 7], 

  [1, 0], [2, 2]], [[3, 9], [9, 9], [2, 10], [6, 4], [3, 1], 

  [8, 2], [10, 1], [7, 10], [5, 3], [1, 0], [3, 6], [6, 9]], [

  [8, 4], [10, 8], [9, 5], [7, 5], [9, 10], [0, 2], [4, 6], 

  [4, 5], [2, 3], [5, 2], [6, 0], [5, 4]], [[0, 4], [6, 8], 

  [6, 3], [3, 10], [1, 7], [7, 8], [5, 7], [9, 6], [7, 10], 

  [2, 10], [4, 10], [7, 0]], [[0, 8], [10, 2], [0, 0], [5, 0], 

  [3, 6], [1, 5], [10, 9], [10, 4], [6, 1], [10, 1], [10, 7], 

  [7, 0]]], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 

  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]]

                           {[10, 7]}



a := [[[[0, 6], [3, 3], [9, 10], [4, 2], [9, 2], [0, 2], [5, 5], 

  [1, 3], [2, 6], [0, 3], [6, 9], [10, 10]], [[6, 0], [4, 2], 

  [1, 6], [5, 9], [7, 5], [2, 3], [3, 0], [7, 2], [6, 2], [3, 4], 

  [5, 6], [6, 4]], [[4, 1], [0, 3], [8, 2], [7, 0], [3, 6], 

  [8, 0], [10, 6], [8, 7], [4, 8], [7, 8], [10, 7], [0, 9]], [

  [6, 6], [5, 3], [6, 4], [7, 5], [9, 0], [5, 0], [1, 9], [1, 4], 

  [6, 3], [7, 3], [0, 4], [3, 10]], [[4, 7], [1, 3], [7, 9], 

  [5, 8], [6, 0], [5, 7], [3, 0], [0, 0], [0, 8], [3, 7], 

  [3, 10], [9, 7]], [[8, 9], [2, 4], [10, 8], [4, 5], [2, 4], 

  [1, 9], [3, 6], [9, 6], [8, 3], [5, 5], [7, 6], [0, 8]], [

  [10, 0], [1, 9], [5, 2], [1, 9], [9, 1], [8, 4], [3, 1], 

  [8, 7], [0, 0], [7, 9], [3, 5], [1, 3]], [[4, 4], [8, 7], 

  [10, 9], [7, 3], [0, 1], [1, 7], [7, 2], [7, 7], [10, 10], 

  [2, 4], [7, 10], [7, 6]], [[5, 3], [7, 4], [6, 5], [10, 5], 

  [9, 4], [0, 8], [8, 2], [8, 10], [2, 8], [10, 6], [10, 9], 

  [3, 6]], [[10, 6], [6, 5], [10, 9], [9, 10], [6, 4], [7, 4], 

  [10, 8], [3, 6], [9, 3], [8, 5], [4, 0], [10, 8]]], 

  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 

  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]]

                       {[1, 12], [8, 9]}



a := [[[[6, 6], [6, 3], [7, 9], [6, 5], [2, 8], [6, 10], [1, 8], 

  [3, 0], [0, 7], [4, 0], [2, 8], [9, 0]], [[0, 2], [6, 8], 

  [9, 6], [0, 6], [8, 1], [10, 5], [2, 3], [3, 7], [2, 9], 

  [7, 1], [10, 4], [9, 7]], [[2, 0], [5, 1], [1, 4], [5, 6], 

  [6, 9], [6, 6], [8, 10], [8, 10], [4, 9], [2, 3], [10, 0], 

  [3, 0]], [[4, 3], [1, 4], [4, 3], [6, 10], [5, 4], [10, 5], 

  [2, 2], [0, 4], [9, 1], [5, 2], [0, 1], [7, 7]], [[1, 2], 

  [2, 6], [5, 2], [5, 1], [1, 1], [9, 0], [7, 3], [4, 8], [9, 5], 

  [7, 7], [9, 3], [0, 2]], [[1, 0], [5, 10], [5, 5], [9, 7], 

  [6, 9], [9, 10], [8, 6], [4, 9], [4, 5], [2, 5], [5, 4], [10, 4]

  ], [[1, 5], [7, 3], [0, 2], [8, 8], [3, 5], [3, 4], [6, 2], 

  [9, 6], [1, 2], [5, 1], [3, 3], [6, 4]], [[5, 1], [6, 5], 

  [5, 7], [3, 9], [6, 2], [5, 2], [9, 7], [3, 5], [5, 4], 

  [10, 2], [7, 0], [10, 3]], [[8, 7], [1, 3], [2, 6], [10, 2], 

  [7, 0], [2, 4], [9, 1], [1, 0], [2, 1], [1, 1], [1, 4], [5, 9]], 

  [[8, 0], [10, 8], [7, 5], [5, 10], [6, 1], [4, 4], [5, 0], 

  [0, 3], [8, 5], [1, 9], [2, 9], [7, 5]]], 

  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 

  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]]

                               {}



a := [[[[10, 10], [2, 4], [8, 2], [4, 1], [2, 8], [7, 10], 

  [4, 4], [4, 7], [6, 6], [1, 1], [8, 7], [7, 3]], [[4, 9], 

  [4, 3], [9, 8], [7, 7], [2, 5], [7, 0], [2, 6], [4, 3], [6, 9], 

  [10, 1], [9, 6], [9, 4]], [[6, 2], [7, 9], [4, 9], [5, 6], 

  [4, 2], [2, 1], [5, 10], [1, 3], [7, 9], [6, 10], [4, 2], [8, 7]

  ], [[9, 4], [5, 0], [5, 2], [9, 8], [5, 1], [9, 9], [4, 10], 

  [3, 5], [10, 3], [0, 5], [4, 0], [10, 3]], [[8, 0], [7, 9], 

  [1, 8], [3, 2], [1, 6], [0, 6], [6, 9], [7, 3], [0, 8], [1, 2], 

  [0, 8], [1, 1]], [[1, 6], [6, 1], [7, 10], [1, 6], [9, 8], 

  [1, 2], [7, 2], [4, 7], [7, 6], [7, 10], [4, 10], [10, 10]], [

  [9, 6], [1, 7], [5, 2], [6, 9], [9, 1], [7, 7], [10, 0], 

  [3, 4], [6, 3], [9, 3], [0, 5], [9, 5]], [[0, 4], [1, 7], 

  [9, 2], [9, 4], [0, 7], [6, 2], [2, 8], [2, 3], [2, 6], [5, 4], 

  [6, 0], [10, 4]], [[10, 1], [2, 7], [1, 8], [1, 2], [6, 8], 

  [0, 4], [5, 10], [8, 3], [6, 7], [4, 7], [9, 9], [0, 1]], [

  [1, 2], [0, 4], [10, 4], [1, 2], [7, 0], [5, 4], [6, 0], 

  [2, 3], [7, 8], [9, 4], [1, 1], [2, 7]]], 

  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 

  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]]

                   {[1, 1], [5, 2], [6, 12]}



a := [[[[0, 7], [10, 1], [2, 4], [7, 7], [10, 5], [5, 7], [0, 5], 

  [0, 0], [7, 5], [4, 8], [7, 10], [10, 4]], [[5, 8], [3, 9], 

  [4, 0], [7, 2], [4, 4], [0, 0], [0, 8], [5, 5], [1, 7], 

  [7, 10], [8, 5], [1, 6]], [[4, 10], [5, 2], [9, 3], [10, 3], 

  [5, 0], [1, 4], [10, 8], [2, 4], [1, 10], [2, 8], [6, 5], [1, 9]

  ], [[9, 8], [8, 9], [6, 7], [3, 4], [3, 7], [4, 4], [6, 9], 

  [6, 4], [8, 4], [0, 10], [4, 10], [1, 9]], [[6, 0], [0, 7], 

  [4, 3], [6, 3], [0, 7], [9, 9], [10, 4], [7, 9], [2, 2], 

  [8, 7], [3, 2], [0, 0]], [[5, 0], [0, 9], [5, 6], [5, 2], 

  [9, 1], [1, 5], [4, 9], [8, 1], [6, 4], [9, 2], [1, 4], [8, 2]], 

  [[8, 5], [8, 2], [3, 10], [10, 1], [9, 2], [3, 8], [8, 6], 

  [7, 7], [8, 9], [1, 1], [3, 2], [4, 9]], [[10, 5], [1, 4], 

  [2, 6], [9, 9], [3, 10], [0, 10], [9, 7], [3, 3], [1, 9], 

  [2, 10], [3, 5], [3, 0]], [[1, 2], [1, 6], [6, 10], [10, 8], 

  [5, 1], [0, 9], [5, 4], [2, 9], [8, 4], [0, 1], [5, 9], [1, 3]], 

  [[9, 3], [6, 2], [8, 1], [9, 7], [2, 0], [2, 9], [3, 7], 

  [1, 0], [5, 8], [2, 0], [8, 8], [6, 1]]], 

  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 

  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]]

                            {[5, 6]}

*)
#### Included from C2.txt ####
#C2.txt: Maple Code for Lecture 2 of Math640 (Spring 2022)

Help2:=proc(): print(` GameDB(), Rand2PlayerGame(a,b,K), IsStictDom(v1,v2), FindR(G), FindC(G), ShrinkGame(G), ReducedGame(G) , MyMaxIndex(L), LoadedCoin(p), BR1(G,a2), BR2(G,a1), BR1v(G), BR2v(G)  `):end:



###PREPARED BEFORE CLASS

#GameDB(): A list of length 5 consisiting of a a "data base"  of famous gamess (and less famous ones): 
#Prisoner's dillema, Boattle of the Sexes,  Matching pennies, Figure 1.1.1. in Gibbons, Figure 1.1.4 in Gibbons
#For example, to see the Prisoner's dillema, type
#GameDB()[1])
GameDB:=proc():
[

[ [ [[-1,-1],[-9,0]], [[0,-9],[-6,-6]]], [`Mum`, `Fink`], [`Mum`, `Fink`]],

[ [ [[2,1],[0,0]], [[0,0],[1,2]]], [`Box`, `Opera`],[`Box`, `Opera`]],

[ [ [[-1,1],[1,-1]], [[1,-1],[-1,1]]], [`Odd`, `Even`], [`Odd`, `Even`]],

[ [ [ [1,0],[1,2],[0,1]], [ [0,3],[0,1],[2,0]]],[`Up`, `Down`], [`Left`, `Middle`, `Right`]],

[[ [ [0,4],[4,0],[5,3]],[ [4,0],[0,4],[5,3]], [ [3,5],[3,5],[6,6]]], [`T`, `M`, `B`],[`L`,`C`,`R`]],
[
[
[[0,0],[-1,1],[1,-1]],
[[1,-1],[0,0],[-1,1]],
[[-1,1],[1,-1],[0,0]]
],
[`Scissors`, `Rock`, `Paper`],
[`Scissors`, `Rock`, `Paper`]
]

]:
end:



PrintGame:=proc(G) local i:
matrix(
[
[" ", op(G[3])],
seq([G[2][i],op(G[1][i])],i=1..nops(G[2]))
]):

end:



#Rand2PlayerGame(a,b,K): A random 2-player (static) game where the Row player has a strategies (Row 1, .., Row a), the Column player has b strategies (Col. 1, ..., Crol. b)
#and the pay-offs are from 0 to K. For example, to see a random game where Player Row has four strategy choices, and Player Column has five strategy choices
#and the pay-offs are integers from 0 to 20 type:
#matrix(Rand2PlayerGame(4,5,20));
Rand2PlayerGame:=proc(a,b,K)  local ra,i,j:
ra:=rand(0..K):

[ [seq([seq([ra(),ra()],j=1..b)],i=1..a)],[seq(i,i=1..a)],[seq(j,j=1..b)]]:

end:

#IsStictDom(v1,v2): Given two lists of numbers is v1[i]<=v2[i] for all i. For example
#IsStrictDom([1,3,2],[2,4,3]); should return true but IsDom([1,3,2],[2,4,1]); should return false
IsStrictDom:=proc(v1,v2) local i:

for i from 1 to nops(v1) do
 if v1[i]>=v2[i] then
  RETURN(false):
 fi:
od:
true:
end:


#FindR(G): Finds a strictly dominated row stategy
FindR:=proc(G) local G1,RowS,i1,i2,j,v1,v2:
G1:=G[1]:
RowS:=G[2]:

for i1 from 1 to nops(RowS) do
for i2 from i1+1 to nops(RowS) do
  v1:=[seq(G1[i1][j][1],j=1..nops(G1[i1]))]:
  v2:=[seq(G1[i2][j][1],j=1..nops(G1[i2]))]:
  if IsStrictDom(v1,v2) then
   RETURN(i1):
  elif IsStrictDom(v2,v1) then
   RETURN(i2):
  fi:
od:
od:
FAIL:
end:


#FindC(G): Finds a strictly dominated row stategy
FindC:=proc(G) local G1,ColS,j1,j2,i,v1,v2:
G1:=G[1]:
ColS:=G[3]:

for j1 from 1 to nops(ColS) do
for j2 from j1+1 to nops(ColS) do
  v1:=[seq(G1[i][j1][2],i=1..nops(G1))]:
  v2:=[seq(G1[i][j2][2],i=1..nops(G1))]:
  if IsStrictDom(v1,v2) then
   RETURN(j1):
  elif IsStrictDom(v2,v1) then
   RETURN(j2):
  fi:
od:
od:
FAIL:
end:


#ShrinkGame(G): Given a game G, tries to shrink it, if it can't it returs it
ShrinkGame:=proc(G) local i,j,G1,RowS,ColS,i1:

G1:=G[1]:
RowS:=G[2];
ColS:=G[3]:

i:=FindR(G):

if i<>FAIL then
 RETURN([
[op(1..i-1,G1),op(i+1..nops(G1),G1)], 
[op(1..i-1,RowS),op(i+1..nops(RowS),RowS)],ColS
]):
fi:

j:=FindC(G):

if j<>FAIL then

 RETURN([
[seq( [op(1.. j-1,G1[i1]),op(j+1..nops(G1[i1]),G1[i1])],i1=1..nops(G1))],RowS, [op(1..j-1,ColS),op(j+1..nops(ColS),ColS)]]):
fi:

FAIL:

end:

#ReducedGame(G): The reduced game of G after all the possible Elimination of dominated  strategy
ReducedGame:=proc(G) local G1,G2:
G1:=G:
G2:=ShrinkGame(G1):

while G2<>FAIL do
G1:=G2:
G2:=ShrinkGame(G1):
od:
G1:
end:




####END PREPARED BEFORE CLASS

#DONE DURING CLASS WITH STUDENTS' HELP

#MyMaxIndex(L): [Suggested by Victoria Chayes]. 
#Inputs a list L of numbers, output the SET of places (indices) where it is maximum. For example
#MyMaxIndex([5,6,7,7,1,7]); should give {3,4,6}
MyMaxIndex:=proc(L) local i,m,S:
m:=max(L):
S:={}:
for i from 1 to nops(L) do
 if L[i]=m then
    S:=S union {i}:
 fi:
od:
S:
end:



#BR1(G,a2): Inputs a game G and a member a2 of A2 outputs the SUBSET of A1 that consists of the best response  
BR1:=proc(G,a2) local a1:
MyMaxIndex([seq(G[1][a1][a2][1],a1=1..nops(G[1]))]):
end:


#BR2(G,a1): Inputs a game G and a member a1 of A1 outputs the SUBSET of A2 that consists of the best response  
BR2:=proc(G,a1) local a2:
MyMaxIndex([seq(G[1][a1][a2][2],a2=1..nops(G[1][a1]))]):
end:

#BR1v(G): The list of size A2 with all the set of best responses
#
BR1v:=proc(G) local a2: [seq(BR1(G[1],a2),a2=1..nops(G[1][1]))]:end:
BR2v:=proc(G) local a1: [seq(BR2(G[1],a1),a1=1..nops(G[1]))]:end:

#end DURING CLASS WITH STUDENTS' HELP

#Dne after class

#LoadedCoin(p): outputs 1 or 2 with probability p and 1-p respecively. Try:
#[seq(LoadedCon(1/3)),i=1..300)];
LoadedCoin:=proc(p) local m,n,ra:
m:=numer(p):
n:=denom(p):

ra:=rand(1..n)():

if ra<=m then
 1:
else
 2:
fi:

end: