Game theory packages

Question

Is there any game theory package around? I mean supporting functions which take a game in matrix form and tell you all about nash equilibra, best strategies, ect

Answer 1

I have this hope that Mathematica 10 will make the efforts in my NashEquilibriaIn33Games Demonstration seem extremely primitive and that it will directly implement a good chunk of game theory. I think it's time for Wolfram Research to take the leap into this now well-established area of Math/Econ/Biology, etc. The work being done in algorithmic game theory perhaps creates some additional motivation. There's stuff now in Graph and DiscreteMarkovProcess that might well provide some new support for such an initiative. I would love being able to write Nash[some representation of a strategic form game,Method->"LemkeHowson"] or Nash[some visual depiction of an extensive form game,"SubgamePerfect"->True].

In the mean time, here is some code that will help find pure (but only pure) strategy Nash Equilibrium in n-player games. I have little doubt that both of these methods can be substantially improved, but perhaps they will provide a start.

g4 = ReplacePart[
RandomInteger[{-100, 100}, {5, 5, 7, 8, 4}], {3, 4, 5, 6} -> {100, 
 100, 100,100}](* four player game with at least one manually inserted \
Nash equilibrium just so we can make sure it works*);

nashPos[g_] := 
 Select[Position[g, _, {ArrayDepth[g] - 1}, Heads -> False], 
 pos \[Function] 
 And @@ Table[
 Extract[g, Append[pos, player]] >= 
  Max[Extract[g, 
    Table[Append[ReplacePart[pos, player -> choice], 
      player], {choice, 
      Range[Dimensions[g][[player]]]}]]], {player, 
  Range[ArrayDepth[g] - 1]}]]

eliminate[g_, {startingAugmentedStrategyCombinations_, ns_}] := 
Module[{candidate = First[startingAugmentedStrategyCombinations],
 complementaryPattern, augmentedComplementaryStrategyCombinations,
 scores,best,bestQList,eliminateStrategyCombinations,
 eliminateAugmentedStrategyCombinations,strategyCombinationEliminationPatternList, 
 scoreAugmentationPositions, nsAug, newNS, eliminationPatterns, 
newAugmentedStrategyCombinations},
complementaryPattern = 
ReplacePart[candidate, Last[candidate] -> _];
augmentedComplementaryStrategyCombinations = 
Cases[Position[g, _, {ArrayDepth[g]}, Heads -> False], 
complementaryPattern];
scores = Extract[g, augmentedComplementaryStrategyCombinations];
best = Max[scores];
bestQList = Map[score \[Function] Equal[score, best], scores];
eliminateStrategyCombinations = 
Map[asc \[Function] ReplacePart[asc, -1 -> _], 
Pick[augmentedComplementaryStrategyCombinations, bestQList, 
 False]];
eliminateAugmentedStrategyCombinations = 
Pick[augmentedComplementaryStrategyCombinations, bestQList, True];
scoreAugmentationPositions = 
Map[asc \[Function] Most[asc], 
Pick[augmentedComplementaryStrategyCombinations, bestQList, True]];
nsAug = 
SparseArray[Thread[Rule[scoreAugmentationPositions, 1]], 
Dimensions[ns]];
newNS = Normal[nsAug] + ns;
eliminationPatterns = 
Alternatives @@ 
Join[eliminateStrategyCombinations, 
 eliminateAugmentedStrategyCombinations];
newAugmentedStrategyCombinations = 
DeleteCases[startingAugmentedStrategyCombinations, 
Alternatives @@ eliminationPatterns];
{newAugmentedStrategyCombinations, Normal[nsAug] + ns}

]

nashPos2[g_] := 
Position[NestWhile[
eliminate[g, #] &, {Position[g, _, {ArrayDepth[g]}, 
  Heads -> False], SparseArray[{}, Most@Dimensions[g]]}, 
x \[Function] Length[x[[1]]] > 0, 1, 1500][[2]], 
ArrayDepth[g] - 1]

Answer 2

Have you looked at demonstrations.wolfram.com/NashEquilibriaIn33Games and the linked sources?

It relies on formulae and solution methods from Hal Varian's 1996 book "Computational Economics and Finance: Modeling and Analysis with Mathematica" (which I have had on my Amazon wish list for years but have never gotten around to buying.)

The sample notebooks from Varian's book can be found in the Wolfram Library Archive.

The Wolfram demonstrations site includes other examples that may be of use.