Basics of Theory of Games

maxmin and minimax: Value of 2-person zero-sum games

rawmin[A_List] := Apply[Min, A, 1];

colmax[A_List] := Apply[Max, Transpose[A], 1];

maxmin[A_List] := Apply[Min, A, 1] // Max;

minmax[A_List] := Apply[Max, Transpose[A], 1] // Min;

A1 = {{6, 7, 2, 0}, {0, 5, 3, 1}, {8, 9, 4, 2}, {0, 2, 1, 2}};

maxmin[A1]

minmax[A1]

maxmin[A1] == minmax[A1]

\(\(eqposition[A_] := 
      Module[{t, s}, 
		t = Position[rawmin[A], maxmin[A]] // Flatten; 

        		s = Position[colmax[A], minmax[A]] // Flatten; 
		
        If[maxmin[A] == minmax[A], t = t; s = s, t = {}; s = {}]; 
		
        Flatten[Table[{t[\([i]\)], s[\([j]\)]}, {i, 1, Length[t]}, {j, 1, 
              Length[s]}], 1]
	]; \)\)

eqposition[A1]

In fact, componet (3,4) is the equilibrium strategy.

B = {{6, 7, 2, 0}, {0, 5, 3, 1}, {8, 1, 4, 2}, {0, 2, 1, 2}};

A1 - B

The only difference between A1 and B is the value of  (4,1) component.

maxmin[B] == minmax[B]

maxmin[B]

minmax[B]

eqposition[B]

A 2-person zero-sum game with B has no solution in "pure" strategies.

randgame[n_] := 
      Table[Floor[(n + 1) Random[]], {i, 1, n}, {j, 1, n}]

maxminvsminmax[A_] := maxmin[A] - minmax[A]

B2 = randgame[3]; maxminvsminmax[B2]

\(\(findgame[n_] := 
      Module[{A}, 
	A = randgame[n]; 
	
        If[maxmin[A] == minmax[A], 
          Print[A // MatrixForm, "equilibrium at ", eqposition[A]], 
          Print[A // MatrixForm, " no equilibrium"]]]; \)\)

findgame[4]

Table[findgame[3], {10}]

\(\(eqcount[n_] := 
      Module[{A, x}, 
	A = randgame[n]; 
	
        x = If[maxmin[A] == minmax[A], 
			1, 
			0
		]; 
		x

        	]; \)\)

eqcount[3]

N[Plus@@Table[eqcount[4], {100}]/100, 4]

Extensions of the concept of strategies: form pure to mixed

A2 = {{0, 150}, {100, 0}};

maxmin[A2] ==  minmax[A2]

A game with A2 has no solution.

exp[p_, q_, A_] := {p, 1 - p} . A . {q, 1 - q} // Expand

exp[p, q, A2]

exp[0.5, 0.5, A2]

exp[p, 1, A2]

exp[p, 0, A2]

pf[p_, A_] := Min[exp[p, 1, A], exp[p, 0, A]];

graphp = Plot[pf[p, A2], {p, 0, 1}]

exp[0, q, A2]

exp[1, q, A2]

qf[q_, A_] := Max[exp[1, q, A], exp[0, q, A]];

graphq = Plot[qf[q, A2], {q, 0, 1}]

Show[graphp, graphq]

Solve[{D[exp[p, q, A2], p] == 0, D[exp[p, q, A2], q] == 0}, {p, q}]

We obtained the solution in mixed stratety, {{2/5,3/5},{3/5,2/5}}.

A3=(({{0, 0, 3}, {3, 0, 3}, {1, 3, 0}}));

A3

v[p1_, p2_, p3_, q1_, q2_, q3_] := {p1, p2, p3} . A3 . {q1, q2, q3}

v[p1, p2, p3, q1, q2, q3]

\(\(lag[p1_, p2_, p3_, q1_, q2_, q3_, l_, m_] := 
      v[p1, p2, p3, q1, q2, q3] + 
		l\ \((1 - p1 - p2 - p3)\)\  + \ 
        m\ \((1 - q1 - q2 - q3)\); \)\)

jacob[f_List, x_List] := Outer[D, f, x];

eqs = 
      jacob[{lag[p1, p2, p3, q1, q2, q3, l, m]}, {p1, p2, p3, q1, q2, q3, l, 
              m}] == 0 // Expand

sol = Solve[eqs, {p1, p2, p3, q1, q2, q3, l, m}]

v[p1, p2, p3, q1, q2, q3] /. sol