#Nathan Fox
#Homework 20
#I give permission for this file to be posted online

##Read old files
read(`C20.txt`):

#Help procedure
Help:=proc():
print(` GatherStat(n,K,L) , MaxLengthPartitions(n,L) `):
print(` nzpos(L) , pad(L,n,pos) , NE(A,B,K) , NE2(A,B,K) `):
print(` NE3(A,B,K) , LetsCooporate(A,B,i,j) `):
end:

##Problem 1
#GatherStat(n,K,L): inputs positive integers n, K, and L, and
#generates L times random n by n matrices A, whose entries are
#from 0 to K, and outputs a list whose (i+1)-th item is the number
#of these that yield i Nash Equilibria for (A,tra(A)). In
#particular the first entry is the number of these matrices that
#have no pure equilibria.
GatherStat:=proc(n,K,L) local ret,i,A,nnash:

ret:=[seq(0, i=1..n^2+1)]:

for i from 1 to L do
    A:=GenRanMat(n,n,K):
    nnash:=nops(PNE(A,tra(A))) + 1:
    ret[nnash]:=ret[nnash] + 1:
od:

ret:

end:

##Problem 2
#Here are some data we obtained
#GatherStat(2,0,1000); [0, 0, 0, 0, 1000]
#GatherStat(2,1,1000); [0, 0, 655, 227, 118]
#GatherStat(2,2,1000); [0, 138, 686, 149, 27]
#GatherStat(2,3,1000); [0, 204, 693, 88, 15]
#GatherStat(2,4,1000); [0, 342, 588, 63, 7]
#GatherStat(2,5,1000); [0, 368, 586, 44, 2]
#GatherStat(2,6,1000); [0, 417, 548, 33, 2]
#GatherStat(3,0,1000); [0, 0, 0, 0, 0, 0, 0, 0, 0, 1000]
#GatherStat(3,1,1000); [0, 0, 0, 136, 340, 276, 164, 70, 13, 1]
#GatherStat(3,2,1000); [0, 6, 105, 410, 317, 112, 44, 5, 1, 0]
#GatherStat(3,3,1000); [0, 15, 215, 481, 220, 54, 14, 1, 0, 0]
#GatherStat(3,4,1000); [0, 32, 314, 482, 143, 27, 2, 0, 0, 0]
#GatherStat(3,5,1000); [0, 62, 379, 442, 103, 11, 3, 0, 0, 0]
#GatherStat(3,6,1000); [0, 89, 436, 397, 73, 4, 1, 0, 0, 0]
#GatherStat(4,0,1000); [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1000]
#GatherStat(4,1,1000); [0, 0, 0, 0, 6, 73, 144, 201, 187, 162, 123, 62, 30, 10, 2, 0, 0]
#GatherStat(4,2,1000); [0, 0, 3, 24, 140, 273, 245, 187, 68, 46, 10, 3, 1, 0, 0, 0, 0]
#GatherStat(4,3,1000); [0, 1, 10, 164, 284, 283, 153, 70, 22, 11, 2, 0, 0, 0, 0, 0, 0]
#GatherStat(4,4,1000); [0, 0, 60, 200, 389, 225, 84, 29, 12, 1, 0, 0, 0, 0, 0, 0, 0]
#GatherStat(4,5,1000); [0, 4, 92, 320, 358, 172, 41, 8, 5, 0, 0, 0, 0, 0, 0, 0, 0]
#GatherStat(4,6,1000); [0, 3, 132, 338, 336, 153, 29, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0]

#Conjectures:
#The probability of n^2 Nash equilibria is 1/(K^(n^2-1))
#(this is easily seen to be true, since this case occurs if and
#only if there all entries in A are the same)
#The probability of 0 Nash equilibria is 0 (this is true because
#the game is symmetric)
#I have no clue about an estimate on the other probabilities,
#except for the fact that all of them approach 0 other than having
#one equilibrium, which approaches 1

##Problem 5
#(note the order in which I'm doing these problems)

#MaxLengthPartitions(n,L): inputs positive integers n and L and
#outputs a set of all ordered length L partitions of n (where 0
#can be a part)
MaxLengthPartitions:=proc(n,L) local ret,i,part:
option remember:

if L = 1 then
    return {[n]}:
fi:

ret:={}:

for i from 0 to n do
    for part in MaxLengthPartitions(n-i, L-1) do
        ret:=ret union {[i,op(part)]}:
    od:
od:

ret:

end:

#nzpos(L): set of nonzero positions in list L
nzpos:=proc(L) local ret,i:

ret:={}:

for i from 1 to nops(L) do
    if L[i] <> 0 then
        ret:=ret union {i}:
    fi:
od:

ret:

end:

#pad(L,n,pos): insert zeros into L so it becomes length n
#and has its original entries in positions specified by pos
pad:=proc(L,n,pos) local ret,i,j:

ret:=[seq(0,i=1..n)]:
j:=1:

for i from 1 to n do
    if i in pos then
        ret[i]:=L[j]:
        j:=j + 1:
    fi:
od:

ret:

end:

#NE(A,B,K): inputs matrices A, and B of the same size, and looks
#for not necessarily pure pairs [x,y] of Nash equilibria where y
#is the form [i[1]/K,i[2]/K, ..., i[n]/K] for i[1],i[2], .. i[n]
#between 0 and K and, of course i[1]+ ...+i[n]=K
NE:=proc(A,B,K) local nash,i,j,john,john2,m,n,ip,ip2,ipn,jp,jpn:

m:=nops(A):
n:=nops(A[1]):

nash:={}:

for jp in MaxLengthPartitions(K,n) do
    jpn:=[seq(j/K,j in jp)]:
    john:=BRrow(A,jpn):
    for ip2 in MaxLengthPartitions(K,nops(john)) do
        ip:=pad(ip2,m,john):
        ipn:=[seq(i/K,i in ip)]:
        john2:=BRcol(B,ipn):
        if nzpos(jp) = john2 then
            nash:={[ipn,jpn]}:
        fi:
    od:
od:

nash:

end:

##Problem 3
#NE2(A,B,K): inputs 2 by 2 matrices A, and B, and looks for not
#necessarily pure pairs [x,y] of Nash equilibria where y is the
#form [i/K,1-i/K] for i between 0 and K.
NE2:=proc(A,B,K)

NE(A,B,K):

end:

##Problem 4
#NE3(A,B,K): inputs 3 by 3 matrices A, and B, and looks for not
#necessarily pure pairs [x,y] of Nash equilibria where y is the
#form [i/K,j/K,k/K] for i,j,k between 0 and K and, of course
#i+j+k=K
NE3:=proc(A,B,K)

NE(A,B,K):

end:

##Problem 6
#LetsCooporate(A,B,i,j): that inputs matrices A and B of the
#same size, i, j such that [i,j] is a pure Nash equilibrium,
#and outputs the (possibly empty) set of pairs [r,s] such that 
#A[r][s]>A[i][j]   B[r][s]>B[i][j]
LetsCooperate:=proc(A,B,i,j) local ret,m,n,r,s:

ret:={}:
m:=nops(A):
n:=nops(A[1]):

for r from 1 to m do
    for s from 1 to n do
        if A[r][s] > A[i][j] and B[r][s] > B[i][j] then
            ret:=ret union {[r,s]}:
        fi:
    od:
od:

ret:

end: