④［リスク支配］ゲーム理論をClaudeとMathematicaで勉強

複数のナッシュ均衡があった時、リスクが低い方は「リスクを支配する」という…　よくわからないな…　例題をMathematicaで解いてみる。

---

利得行列を

      a      b
a   3,3  0,0
b   0,0  1,1

だとすると、どう見てもナッシュ均衡は3,3か1,1の２つになる。
しかし、リスクが低い＝リターンが大きいのは3,3の方だ。
これをリスク支配と言うらしい。ふむ。

---

では次の例題。

これは直感的には分からない…

そこで、ClaudeとMathematicaに依頼。

以下のジレンマをMathematicanoで表現します。
利得行列は
　　a      　b
a 　5,2 　0,0
b 　0,0 　3,6
です。ナッシュ均衡が複数の場合、リスクの少ない方を選択してください。

Claudeに聞くプロンプト

もはや呪文なんですけど…　実行

(*利得行列の定義*)
payoffMatrix = {{{5.0, 2.0}, {0.0, 0.0}}, {{0.0, 0.0}, {3.0, 6.0}}};

(*プレイヤーの戦略*)
strategies = {"a", "b"};

(*純粋戦略ナッシュ均衡を見つける関数*)
findPureNashEquilibria[matrix_] := 
  Module[{n = Length[matrix], equilibria = {}}, 
   For[i = 1, i <= n, i++, 
    For[j = 1, j <= n, j++, 
     If[And[matrix[[i, j, 1]] == Max[matrix[[All, j, 1]]], 
       matrix[[i, j, 2]] == Max[matrix[[i, All, 2]]]], 
      AppendTo[equilibria, {i, j}]]]];
   equilibria];

(*混合戦略ナッシュ均衡を計算する関数*)
findMixedNashEquilibrium[matrix_] := 
  Module[{p, q},(*プレイヤー1の混合戦略 p を求める*)
   q = NSolve[{q*(matrix[[1, 1, 2]] - matrix[[2, 1, 2]]) + (1 - 
            q)*(matrix[[1, 2, 2]] - matrix[[2, 2, 2]]) == 0, 
       0 <= q <= 1}, q, Reals][[1, 1, 2]];
   (*プレイヤー2の混合戦略 q を求める*)
   p = NSolve[{p*(matrix[[1, 1, 1]] - matrix[[1, 2, 1]]) + (1 - 
            p)*(matrix[[2, 1, 1]] - matrix[[2, 2, 1]]) == 0, 
       0 <= p <= 1}, p, Reals][[1, 1, 2]];
   {p, q}];

(*リスクを評価する関数*)
evaluateRisk[strategy_, matrix_] := 
  Module[{worstCase}, worstCase = Min[matrix[[strategy, All, 1]]];
   -worstCase  (*リスクは最悪の結果のマイナス*)];

(*純粋戦略ナッシュ均衡の計算*)
pureNashEquilibria = findPureNashEquilibria[payoffMatrix];

(*結果の表示*)
Print["純粋戦略ナッシュ均衡:"];
For[k = 1, k <= Length[pureNashEquilibria], k++, 
  Print["プレイヤー1: ", strategies[[pureNashEquilibria[[k, 1]]]], 
   ", プレイヤー2: ", strategies[[pureNashEquilibria[[k, 2]]]]]];

(*複数の均衡がある場合、リスクの少ない方を選択*)
If[Length[pureNashEquilibria] > 1, 
  Print["\n複数の均衡が存在します。リスク評価を行います:"];
  risks = 
   Table[{strategies[[eq[[1]]]], strategies[[eq[[2]]]], 
     evaluateRisk[eq[[1]], payoffMatrix]}, {eq, pureNashEquilibria}];
  sortedRisks = SortBy[risks, Last];
  Print["最もリスクの低い均衡: ", "プレイヤー1: ", sortedRisks[[1, 1]], ", プレイヤー2: ",
    sortedRisks[[1, 2]]];, 
  If[Length[pureNashEquilibria] == 1, Print["\n唯一の純粋戦略ナッシュ均衡が存在します。"],
    Print["\n純粋戦略ナッシュ均衡は存在しません。混合戦略を計算します。"];
   {p1, p2} = findMixedNashEquilibrium[payoffMatrix];
   Print["混合戦略ナッシュ均衡:"];
   Print["プレイヤー1がaを選ぶ確率: ", N[p1, 4]];
   Print["プレイヤー2がaを選ぶ確率: ", N[p2, 4]];]];

(*利得行列のビジュアル表現*)
visualizePayoffMatrix[matrix_, strats_] := 
  Module[{gridData, styled}, 
   gridData = {{"", 
      Column[{Style["プレイヤー2", Bold], 
        Style["\[DownArrow]", Small]}]}, {Column[{Style["プレイヤー1", 
         Bold], Style["\[RightArrow]", Small]}], 
      Grid[Table[{Style[strats[[i]], Bold], 
         "(" <> ToString[matrix[[i, j, 1]]] <> ", " <> 
          ToString[matrix[[i, j, 2]]] <> ")"}, {i, 
         Length[strats]}, {j, Length[strats]}]]}};
   styled = 
    Grid[gridData, Alignment -> {Center, Center}, 
     Dividers -> {{2 -> True}, {2 -> True}}, 
     Background -> {{Gray}, {Gray}}, 
     ItemStyle -> {{Automatic, Bold}, {Bold, Automatic}}];
   Print["\n利得行列のビジュアル表現:"];
   Print[styled];];

visualizePayoffMatrix[payoffMatrix, strategies]

純粋戦略ナッシュ均衡:
プレイヤー1: a, プレイヤー2: a
プレイヤー1: b, プレイヤー2: b

複数の均衡が存在します。リスク評価を行います:
最もリスクの低い均衡: プレイヤー1: a, プレイヤー2: a

Mathematicaの回答

なるほど、左上の(5,2)の方が良いらしい。