#OK to post homework 
#Natalya Ter-Saakov, Feb 20, Assignment 9 
read "C9.txt":

#Problem 2 

#StatSymGames(n,K1,K2): inputs a positive integer n (the number of players),
# and positive integers K1 and K2,
# and generates K2 random SYMMETRIC n-player games (with payoffs between 0 and K1),
# and outputs the following list:
# evalf([Number of Games with Only Pure Nash Equlibria,
# Number of Games with Only Mixed Nash Equlibria,
# Number of Games with both pure and mixed Nash Equlibria,
# Number of Games where the Social Optium is NOT one of the NE]/K2)

StatSymGames:= proc(n,K1,K2) local i,game, nash, mixed, social, Pure, Mixed, Both, NotOpt:
 Pure:=0: Mixed:=0: Both:=0: NotOpt:=0:
 for i from 1 to K2 do
 game:=RGs(n,K1): mixed:=nops(MNE2(game)): nash:=NE(game): social:=SolOpt2(game):
 if nops(nash)=0 then
  Mixed+=1:
 elif nops(nash)=mixed then
  Pure+=1:
 elif nops(nash)<mixed then
  Both+=1:
 fi:
 if not(social[1] in nash) then
  NotOpt+=1:
 fi:
 od:
 evalf([Pure, Mixed, Both, NotOpt]/K2):
 end:

StatSymGames(2,10^10,1000);
# [0.5210000000, 0., 0.4790000000, 0.2050000000]

StatSymGames(3,10^10,1000);
# [0.2680000000, 0.07100000000, 0.6610000000, 0.2930000000]

StatSymGames(4,10^10,1000);
StatSymGames(5,10^10,1000);
# These will not finish running in time :(

#Problem 3
#The mixed Nash equilibrium in the Snowdrift game
# ([[[R,R],[S,T]],[[T,S],[P,P]]] with the assumption T > R > S > P is
 p1:=(S-P)/(S+T-R-P):
 p2:=(S-P)/(S+T-R-P): 
#The payoff functions are 
 P1:= ((R - S - T + P)*p2 + S - P)*p1 + (T - P)*p2 + P: 
 P2:= ((R - S - T + P)*p1 + S - P)*p2 + (T - P)*p1 + P:

simplify(P1);simplify(P2);
#Output:
P1 = (P*R-S*T)/(R-S-T+P)
P2 = (P*R-S*T)/(R-S-T+P)


#Problem 4 

with(combinat): P:=permute([t,r,s,p]);
assume(t>s and s>r and r>p);
for ord in P do:
 G:=[[[ord[1],ord[1]],[ord[2],ord[3]]],[[ord[3],ord[2]],[ord[4],ord[4]]]]:
 MNE2(G); 
od;

#The following 12 games had only pure Nash equilibria:

#Equilibria: {[[1, 0], [1, 0]]}
#Games: 
# [[[t,t],[r,s]],[[s,r],[p,p]]]
# [[[t,t],[r,p]],[[p,r],[s,s]]]
# [[[t,t],[s,r]],[[r,s],[p,p]]]
# [[[r,r],[t,s]],[[s,t],[p,p]]]
# [[[r,r],[t,p]],[[p,t],[s,s]]]
# [[[s,s],[t,p]],[[p,t],[s,s]]]

#Equilibria: {[[0, 1], [0, 1]]}
#Games: 
# [[[r,r],[p,t]],[[t,p],[s,s]]]
# [[[s,s],[p,t]],[[t,p],[r,r]]]
# [[[s,s],[p,r]],[[r,p],[t,t]]]
# [[[p,p],[r,s]],[[s,r],[t,t]]]
# [[[p,p],[s,t]],[[t,s],[r,r]]]
# [[[p,p],[s,r]],[[r,s],[t,t]]]

#The following 12 games have the following mixed Nash equilibria:
# [[[t,t],[s,p]],[[p,s],[r,r]]]                             

    /                                    
   { [[0, 1], [0, 1]], [[1, 0], [1, 0]], 
    \                                    

     [[     -s + r         -t + p    ]  [     -s + r         -t + p    ]]\ 
     [[- -------------, -------------], [- -------------, -------------]] }
     [[  p - r + s - t  p - r + s - t]  [  p - r + s - t  p - r + s - t]]/ 

# [[[t,t],[p,r]],[[r,p],[s,s]]] 

      /                                    
     { [[0, 1], [0, 1]], [[1, 0], [1, 0]], 
      \                                    

       [[    p - s         -t + r    ]  [    p - s         -t + r    ]]\ 
       [[-------------, -------------], [-------------, -------------]] }
       [[p + r - s - t  p + r - s - t]  [p + r - s - t  p + r - s - t]]/ 

# [[[t,t],[p,s]],[[s,p],[r,r]]] 

      /                                    
     { [[0, 1], [0, 1]], [[1, 0], [1, 0]], 
      \                                    

       [[   -r + p         -t + s    ]  [   -r + p         -t + s    ]]\ 
       [[-------------, -------------], [-------------, -------------]] }
       [[p - r + s - t  p - r + s - t]  [p - r + s - t  p - r + s - t]]/ 

# [[[r,r],[s,t]],[[t,s],[p,p]]] 

      /                                    
     { [[0, 1], [1, 0]], [[1, 0], [0, 1]], 
      \                                    

       [[    p - s         -t + r    ]  [    p - s         -t + r    ]]\ 
       [[-------------, -------------], [-------------, -------------]] }
       [[p + r - s - t  p + r - s - t]  [p + r - s - t  p + r - s - t]]/ 

# [[[r,r],[s,p]],[[p,s],[t,t]]] 

      /                                    
     { [[0, 1], [0, 1]], [[1, 0], [1, 0]], 
      \                                    

       [[   -t + s         -r + p    ]  [   -t + s         -r + p    ]]\ 
       [[-------------, -------------], [-------------, -------------]] }
       [[p - r + s - t  p - r + s - t]  [p - r + s - t  p - r + s - t]]/ 

# [[[r,r],[p,s]],[[s,p],[t,t]]] 

    /                                    
   { [[0, 1], [0, 1]], [[1, 0], [1, 0]], 
    \                                    

     [[   -t + p           -s + r    ]  [   -t + p           -s + r    ]]\ 
     [[-------------, - -------------], [-------------, - -------------]] }
     [[p - r + s - t    p - r + s - t]  [p - r + s - t    p - r + s - t]]/ 

# [[[s,s],[t,r]],[[r,t],[p,p]]] 

    /                                    
   { [[0, 1], [1, 0]], [[1, 0], [0, 1]], 
    \                                    

     [[   -t + p           -s + r    ]  [   -t + p           -s + r    ]]\ 
     [[-------------, - -------------], [-------------, - -------------]] }
     [[p - r + s - t    p - r + s - t]  [p - r + s - t    p - r + s - t]]/ 

# [[[s,s],[r,t]],[[t,r],[p,p]]] 
                
      /                                    
     { [[0, 1], [1, 0]], [[1, 0], [0, 1]], 
      \                                    

       [[   -r + p         -t + s    ]  [   -r + p         -t + s    ]]\ 
       [[-------------, -------------], [-------------, -------------]] }
       [[p - r + s - t  p - r + s - t]  [p - r + s - t  p - r + s - t]]/ 

# [[[s,s],[r,p]],[[p,r],[t,t]]] 

      /                                    
     { [[0, 1], [0, 1]], [[1, 0], [1, 0]], 
      \                                    

       [[   -t + r          p - s    ]  [   -t + r          p - s    ]]\ 
       [[-------------, -------------], [-------------, -------------]] }
       [[p + r - s - t  p + r - s - t]  [p + r - s - t  p + r - s - t]]/ 

# [[[p,p],[t,r]],[[r,t],[s,s]]] 

      /                                    
     { [[0, 1], [1, 0]], [[1, 0], [0, 1]], 
      \                                    

       [[   -t + s         -r + p    ]  [   -t + s         -r + p    ]]\ 
       [[-------------, -------------], [-------------, -------------]] }
       [[p - r + s - t  p - r + s - t]  [p - r + s - t  p - r + s - t]]/ 

# [[[p,p],[t,s]],[[s,t],[r,r]]] 

      /                                    
     { [[0, 1], [1, 0]], [[1, 0], [0, 1]], 
      \                                    

       [[   -t + r          p - s    ]  [   -t + r          p - s    ]]\ 
       [[-------------, -------------], [-------------, -------------]] }
       [[p + r - s - t  p + r - s - t]  [p + r - s - t  p + r - s - t]]/ 

# [[[p,p],[r,t]],[[t,r],[s,s]]] 

    /                                    
   { [[0, 1], [1, 0]], [[1, 0], [0, 1]], 
    \                                    

     [[     -s + r         -t + p    ]  [     -s + r         -t + p    ]]\ 
     [[- -------------, -------------], [- -------------, -------------]] }
     [[  p - r + s - t  p - r + s - t]  [  p - r + s - t  p - r + s - t]]/ 



#Problem 5 
Q:=permute([a,b,c,d,e,f,g,h,i]); 
assume(i>h and h>g and g>f and f>e and e>d and d>c and c>b and b>a);
for ord in Q do:
 G:=[[[ord[1],ord[1]],[ord[2],ord[3]],[ord[4],ord[5]]],
     [[ord[3],ord[2]],[ord[6],ord[6]],[ord[7],ord[8]]],
     [[ord[5],ord[4]],[ord[8],ord[7]],[ord[9],ord[9]]]]:
 MNE2(G); 
od;

#This will work, but will print over half a million lines.