Given a 2-player game of incomplete information (with a payoff function of a certain form) and a piecewise-linear strategy (mapping from type to action), find a best-response strategy.
TODO: check literature on Cournot adjustment and tatonnement (see p23 of Fudenberg&Tirole)

Libraries and Constants

\(\(Switch["unix", 
"unix", $Path = 
          Join[$Path, {Environment["HOME"] <> "/lib/", 
              Environment["HOME"] <> "/equilibria/"}], 
"windows", $Path = 
          Join[$Path, {"E:\lib\", "E:\equilibria\"}], 
"home", $Path = 
          Join[$Path, {"C:\windows\desktop\"}]];\)\)

Get["Util.m"]

First-price sealed-bid auction example

s1 = 0; s2 = 1; s3 = -1; s4 = 1; s5 = 1; s6 = -1; 
    s7 = 0;  
minType = 0;
maxType = 1; 
minAction = 0;
maxAction = 1;

Supply-chain bargaining game example

v = 1/5*(10 - 5^(1/2));
s1 = 0; s2 = 1; s3 = 1; s4 := v; s5 = -1; s6 = 1; 
    s7 = 0; 
minType = 0;
maxType = 1; 
minAction = 0;
maxAction := v

Parameterized payoff function and agent-type distribution

(* 
      The cdf of the common - 
        knowledge distribution from which types are drawn .   Currently must be uniform,  ie,  
      CDF must be of the form ax + b. *) 
F[
        type_] := (type - minType)/(maxType - minType)

Functions

Converting strategies between functions and their matrix representations

conditionToRange::usage = "Converts a<=x<=b to {a,b}.  Used by \
strategyToMatrix.";
SetAttributes[conditionToRange, 
        HoldFirst];
conditionToRange[
        left_ <= var_Symbol <= right_] := (If[
          TrueQ[left > 
              right], 
Print["WARNING (conditionToRange): \
possibly invalid range ", {left, right}]]; 
{left, 
          right})

fToAB::usage = "Converts a*x+b to {a,b}.  Used by strategyToMatrix.\
";
fToAB[var_Symbol][f_] := 
      Module[{l}, 
l = 
          CoefficientList[f, var]; 
If[Length[l] > 2, 
          Print["ERROR (fToAB): nonlinear function:\n", 
            f]]; 
PadLeft[Reverse[l], 2]]

strategyToMatrix::usage = "Assumes that the strategy is expressed \
with a Which and all the conditions are of the form min≤x\
≤max and all the then-parts are linear in the type.  Each Which \
pair (a<=x<=b, q*x+r) gets turned into a row in the strategy matrix \
({a,b,q,r}).";
strategyToMatrix[s_] := 
      Module[{t, ifs, thens}, 
{ifs, thens} = 
          Transpose[
            DeleteCases[
              Partition[s[t] /. Which -> List, 
                2], {False, _}]]; 
Flatten /@ 
          Transpose[{conditionToRange /@ ifs, 
              fToAB[t] /@ thens}]]

rangeToCondition::usage = "Converts {a,b} to a<=x<=b.  Used by \
matrixToStrategy.";
rangeToCondition[var_Symbol][{min_, max_}] := 
      min ≤ var ≤ max

abToF::usage = "Converts {a,b} to ax+b.  Used by \
matrixToStrategy.";
abToF[var_Symbol][{a_, b_}] := a*var + b

matrixToStrategy::usage = "Returns a lambda function mapping type \
to action.";
matrixToStrategy[m_] := 
      Module[{ifs, thens, type}, 
{ifs, thens} = 
          Transpose[Partition[#, 2] & /@ m]; 
Function[
          type, Evaluate[
            Which @@ Flatten[
                Transpose[{rangeToCondition[type] /@ ifs, 
                    abToF[type] /@ thens}]]]]]

pBetw::usage = "Uses CDF F (globally defined) to find the \
probability that a random agent type is between a and b.  Used by ep \
(expected payoff).";
pBetw[a_, b_] := 
      Max[0, Max[0, Min[1, F[b]]] - Max[0, Min[1, F[a]]]]

(* 
      Calculation for oppTypeBound. *) 
Module[{s2, action, s3, m, t, c, 
          bound}, 
Solve[
            s2*action + s3*(m*t + c) == bound, t][[1, 1, 
            2]]];

oppTypeBound::usage = "Takes my action, a bound (either s1 or s4 \
from the payoff parameterization), and constants m and c from the opponent \
strategy matrix.  Returns the corresponding bound on the opponent's type.  \
Used by ep (expected payoff) and ep candidates.  O(1).";
oppTypeBound[action_, bound_, m_, 
        c_] := (bound - action*s2 - c*s3)/(m*s3)

prob::usage = "Takes action, a range from the strategy matrix \
(a,b), and coefficients from the strategy matrix (m,c), and returns the \
probability that the opponent's type is in the range [a,b] and that we'll get \
the non-zero payoff with the opponent doing action m*itsType+c.  ({a,b,m,c} \
is one row from the strategy matrix.)  Used by ep.  O(3).";
prob[action_][{a_, b_, m_, c_}] := 
      Which[
s3*m > 0, 
        pBetw[Max[a, oppTypeBound[action, s1, m, c]], 
          Min[b, oppTypeBound[action, s4, m, c]]], 
s3*m < 
          0, pBetw[Max[a, oppTypeBound[action, s4, m, c]], 
          Min[b, oppTypeBound[action, s1, m, c]]], 
s3*
            m == 0, 
        If[s1 ≤ s2*action + s3*c ≤ s4, 1, 0]*
          pBetw[a, b]]

ep::usage = "ep gives the expected payoff given my type and action \
and given my oppenent's strategy matrix sm.  Used by neededCandidate and \
bestBRC.  O(3 * num pieces in strategy) = O(3n).";
ep[type_, action_, sm_] := (s5*type + s6*action + s7)*
        Plus @@ (prob[action] /@ sm)

f::usage = "A convenience function for actionBoundariesSub; what \
you get when you set oppTypeBound equal to x with y as the bound and solve \
for my action.  O(1).";
f[a_, b_, m_, c_, x_, y_] := (y - x*s3*m - s3*c)/s2

\( (*\ TODO : \ 
        an\ easier\ way\ to\ get\ these\ would\ be\ to\ set\ all\ the\ epCandidates\ equal\ to\ each\ other\ pair - 
          wise\ and\ solve\ for\ \(\(action\)\(.\)\)\ *) 
\(actionBoundariesSub::usage = "Takes a row from the strategy matrix and returns a list of implied critical points based on boundary conditions. TODO: eliminate boundaries where the derivative (or derivatives of all the candidates) is negative.  TODO: also eliminate boundaries  O(12).";\)\)
actionBoundariesSub[{a_, b_, m_, c_}] := 
      Select[{f[a, b, m, c, a, s1], f[a, b, m, c, b, s1], 
          f[a, b, m, c, a, s4], 
          f[a, b, m, c, b, s4], (s1 - s3*c)/s2, (s4 - s3*c)/s2}, 
        minAction ≤ # ≤ maxAction &]

actionBoundaries::usage = "Takes a strategy matrix and returns all \
the critical points based on boundary conditions.  Used by neededCandidate \
and brCandidates.  O(n log n).";
actionBoundaries[sm_] := 
      Union[{minAction, maxAction}, 
        Join @@ (actionBoundariesSub /@ sm)]

probCandidatesRow::usage = "A helper function for epCandidates; \
does what epCandidates does but for just one row of the strategy matrix and \
only for the prob portion of the expected payoff function. O(3).";
probCandidatesRow[action_][{a_, b_, m_, c_}] := 
      Which[
s3*m > 
          0, {
0, 
F[b] - 
            F[a], 
F[oppTypeBound[action, s4, m, c]] - 
            F[a], 
F[b] - 
            F[oppTypeBound[action, s1, m, c]], 
F[
              oppTypeBound[action, s4, m, c]] - 
            F[oppTypeBound[action, s1, m, c]]}, 
s3*m < 
          0, {
0, 
F[b] - 
            F[a], 
F[oppTypeBound[action, s1, m, c]] - 
            F[a], 
F[b] - 
            F[oppTypeBound[action, s4, m, c]], 
F[
              oppTypeBound[action, s1, m, c]] - 
            F[oppTypeBound[action, s4, m, c]]}, 
s3*
            m == 0, {0, F[b] - F[a]}]

\( (*\ TODO : \ 
        avoid\ using\ Simplify\ *) 
\(samePolynomial::usage = "Says if 2 polynomials in var are the same.  O(3).";\)\)
samePolynomial[var_Symbol, polynomial1_, polynomial2_] := 
      If[Collect[polynomial1, var, Simplify] == 
          Collect[polynomial2, var, Simplify], True, 
        False,   
False]

neededCandidate::usage = "Takes an expected payoff function \
candidate (a function of type and action -- type and action need to be \
symbols so we can evaluate the ep candidate at specific representative \
actions and see if we get the same function of type as the real ep) and \
determines whether it is needed by seeing if it matches the actual expected \
payoff function at any of a set of representative actions.  We get the \
representative actions by taking one point in each of the intervals implied \
by actionBoundaries.  We're conservative in that if we can't tell if the \
candidate is equal to ep, we assume it is and say the candidate is needed \
(TODO: trying the liberal approach now which I think is ok since we use \
Collect before comparing; see samePolynomial).  [note that the expected \
payoff candidates are polynomials that the true expected payoff is piecewise \
composed of; TODO: move this explanation to somewhere more appropriate]  Used \
by epCandidatesGeneric.  O(n log n + 2*8n + 3*8n + 8n)";
neededCandidate[type_Symbol, action_Symbol, sm_][epc_] := 
      Module[{repActions}, 
repActions = ((#1 + #2)/
                  2 &) @@@ 
            Partition[actionBoundaries[sm], 2, 
              1]; 
Or @@ (samePolynomial[
                  type, (epc /. action -> #), ep[type, #, sm]] & /@ 
              repActions)]

epCandidatesGeneric::usage = "epCandidates in terms of generic \
symbols type and action, as opposed to epCandidates.  Used by epCandidates.  \
O(5^n)  TODO: oops, don't add these indiscriminantly";
epCandidatesGeneric[type_Symbol, action_Symbol, sm_] := 
      Select[(s5*type + s6*action + s7)*(Plus @@@ 
              Distribute[probCandidatesRow[action] /@ sm, List]), 
        neededCandidate[type, action, sm]]

epCandidates::usage = "The expected payoff function has a bunch of \
cases and maxes and mins which means we can't differentiate it, but by \
case-ifying the maxes and mins we can turn it into a big Which statement with \
all the then-parts differentiable.  This function gives a list of the \
differentiable then-parts.  Used in brCandidates and typeBoundaries.";
epCandidates[type_, action_, sm_] := 
      Module[{t, 
          a}, 
epCandidatesGeneric[t, a, 
            sm] /. {t -> type, a -> action}]

maxima::usage = "Returns a list of maxima of f[x] -- TODO: \
currently only works for degree <=2 polynomials, which is all we need for \
piecewise-linear strategies.  TODO: give it the domain and have it check \
boundary conditions and return the actual max.  Used by \
brCandidates.";
\(maxima[f_, x_] := 
      Module[{sol}, 
sol = 
          Check[Solve[D[f, x] == 0, 
              x], \((Print["ERROR in maxima"]; {})\)]; 
If[
          sol === {} || sol === {{}} || 
            D[f, {x, 2}] ≥ 
              0, {}, {sol[\([1, 1, 2]\)]}]]\)

brCandidates::usage = "Best response candidates -- mappings from \
type to action.  Gives all possible maxima of the expected payoff function, \
by setting the derivative with respect to my action to zero, plus all the \
actionBoundaries. The non-boundary critical points will be functions of our \
type.  Used by bestResponseMatrix.";
brCandidates[type_, sm_] := 
      Module[{action}, 
Union[actionBoundaries[sm], 
          Union @@ (maxima[#, action] & /@ 
                epCandidates[type, action, sm])]]

solveForOld[var_][{left_, right_}] := 
      Module[{sol}, 
sol = 
          Check[Solve[left == right, 
              var], (Print["ERROR in solveFor[", var, "][{", 
                left, ",", 
                right, "}]"]; {})]; 
If[
          sol === {} || sol === {{}}, 
          Return[{}]]; 
#[[1, 2]] & /@ 
          sol]

\( (*\ TODO : \ 
        Collect\ instead\ of\ Simplify\ *) 
\(solveFor::usage = "Takes an expression in var, sets it equal to 0, and solves for var, returning a list of the solutions.  Used by typeBoundaries.";\)\)
\(\(solveFor[var_]\)[expr_ /; Head[expr] =!= List] := 
      Module[{e, sol}, 
e = 
          Identity[Simplify[expr]]; 
sol = 
          Check[Solve[e == 0, var], 
If[
              N[Chop[Coefficient[e, var, 2]]] == 
                0. , 
Check[
                Solve[Chop[e] == 0, 
                  var], 
Print["ERROR 1 in solveFor[", 
                  var, "][", 
                  Chop[e], "]"]; 
Exit[]], 
Print["ERROR 2 in solveFor[", var, "][", 
                e, "]"]; 
Exit[]]]; 
If[sol === {} || sol === {{}}, 
          Return[{}]]; 
\(#[\([1, 2]\)] &\) /@ 
          sol]\)

typeBoundaries::usage = "Takes our type, and a list of \
best-response candidates which are functions of our type. Our best-response \
function is the 'piecewise-max' of all those functions (ie, f[type]= argmax \
action in {brc1[type],brc2[type],...} of ep[type,action]).  \
TypeBoundaries[t,brclist,sm] takes the list of best response candidate \
functions and the strategy matrix we're responding to and finds all the \
values of type for which the best action function might change.  This will \
happen when the expected payoff for one action function becomes greater than \
another.  So we take each action function (best response candidate) and get \
the expected payoff for it, which is a function of t (TODO: currently using \
all epCandidates so that we have simple functions of t without the maxes and \
mins but we might be able to find the actual expected payoff as a simple \
function of t -- no, probably doch not).  Then we pair each of those with \
each other, set them equal, and solve for t (TODO: a more efficient way).  \
Used by bestResponseMatrix.";
\(typeBoundaries[t_, brclist_, sm_] := 
      Module[{l, i, x}, 
l = 
          brclist; 
l = 
          Join @@ \((\(epCandidates[t, #, sm] &\) /@ 
                l)\); 
 (*\ \(l = \(ep[t, #, sm] &\) /@ 
                l;\)\ *) \ \  (*\ 
          TODO : \ will\ this\ work\ ok?\ 
                seems\ no\ *) 
Print["[typeBoundaries: ", Length[
            l], " epCandidates before pairing with themselves]"]; 
l = \(Simplify[#, 
                minType ≤ t ≤ maxType] &\) /@ 
            l; 
l = 
          Union[l]; 
Print["[typeBoundaries: ", 
          Length[l], " (squared is ", 
          Length[l]^2, ") after simplifying and unioning]"]; 
l = 
          Distribute[{l, l}, List]; 
l = \((#1 - #2 &)\) @@@ 
            l; 
Print["[typeBoundaries: just converted all ", Length[l], " pairs to differences]"]; 
l = 
          Select[Union[
              l], \(! FreeQ[#, 
                  t]\) &]; 
Print["[typeBoundaries: ", 
          Length[l], " left after unioning them and removing 0-degree polynomials]"]; 
 (*\ \(l = Simplify /@ l;\)\ *) \ \  (*\ 
          takes\ way\ too\ long\ *) 
 (*\ \(l = 
              Union[l];\)\ *) 
Print["[typeBoundaries: just generated ", 
          Length[l], " pairings of epCandidates]"]; 
Print["[typeBoundaries: setting each pair equal and solving for t...]"]; 
 (*
\(For[i = 1, 
              i ≤ Length[l], \(i++\), 
If[
                Mod[i, 20] == 0, 
                pout[i, ":
", 
                  l[\([i]\)], "
"]]; 
l[\([i]\)] = \(solveFor[t]\)[l[\([i]\)]]];\)
*) 
l = 
          solveFor[t] /@ 
            l; 
Print["[typeBoundaries: just solved the epCandidate pairings for t]"]; 
l = 
          Sort[Union[{minType, maxType}, 
              Select[Join @@ 
                  l, \((Im[#] == 0 && 
                      minType ≤ # ≤ maxType)\) &]], 
            Less]; 
Print["[typeBoundaries: settled on ", Length[l], " typeBoundaries]"]; 
l]\)

\( (*\ TODO : \ 
        make\ tiebreaker\ default\ to\ picking\ the\ best - 
          response\ candidate\ that' s\ equal\ to\ the\ opponent' 
            s\ strategy\ *) 
\(bestBRC::usage = "bestBRC[t,brclist,sm] takes a type and a list of best response candidates (functions of t) and returns the function that maximizes expected payoff for that type.  Note that with a greater-than in the sort function, ties are broken in favor of higher actions.  Used by bestResponseMatrix.";\)\)
bestBRC[t_, var_, brclist_, sm_, tiebreaker_:  Less] := 
      argMax[ep[t, (# /. var -> t), sm] &, 
        Sort[brclist, 
          tiebreaker[(#1 /. var -> t), (#2 /. 
                  var -> t)] &]]

midPoint[{a_, b_}] := (a + b)/2

mergeRanges::usage = "Takes \
a list of {{a,b},x} pairs and any time there are 2 successive ones with the \
same x, merges them, ie, {{a,b},x},{{b,c},x} becomes {{a,c},x}.";
mergeRanges[{{{a_, b_}, x_}, {{c_, d_}, y_}, tail___}] := 
      If[Simplify[x] == Simplify[y] && b == c, 
        mergeRanges[{{{a, d}, x}, tail}], 
Prepend[
          mergeRanges[{{{c, d}, y}, tail}], {{a, b}, 
            x}]]
mergeRanges[{{range_, val_}}] := {{range, val}}

mergeRangesSlow[l_] := 
      l //. {begin___, {{a_, b_}, x_}, {{b_, c_}, x_}, 
            end___} -> {begin, {{a, c}, x}, end}

typeRangeAndActionToStrategyRow[type_][{{t1_, t2_}, a_}] := {t1, 
        t2, D[a, type], (a /. type -> 0)}

\(bestResponseMatrix[sm_, tiebreaker_:  Less] := 
      Module[{brclist, tblist, pointsAndRanges, t, l, i, n, start, 
          startmem}, 
brclist = 
          brCandidates[t, sm]; \ \  (*\ 
          list\ of\ best - 
            response\ candidates\ as\ funcs\ of\ t\ *) 
tblist = 
          typeBoundaries[t, brclist, 
            sm]; 
pointsAndRanges = \({midPoint[#], #} &\) /@ 
            Partition[tblist, 2, 
              1]; 
Print["[bestResponseMatrix: Finding BR for ", Length[pointsAndRanges], " types]"]; 
n = 
          Length[pointsAndRanges]; 
l = 
          Table[0, {n}]; 
For[i = 1, 
          i ≤ n, \(i++\), 
start = 
            TimeUsed[]; 
startmem = 
            MemoryInUse[]; 
l[\([i]\)] = \(Simplify[{#[\([2]\)], bestBRC[#[\([1]\)], t, brclist, sm, tiebreaker]}] &\)[
              pointsAndRanges[\([i]\)]]; 
If[
            i == 50 || i == 70 || i == 100 || 
              i == 500 || 
              Mod[i, 1000] == 0, 
Print[
              i, ": found best response for {type,range} in ", 
              seconds2str[TimeUsed[] - start], " and ", 
              MemoryInUse[] - 
                startmem, " bytes"]];
]; 
 (*\(l = \({#[\([2]\)], 
                    bestBRC[#[\([1]\)], t, brclist, sm, tiebreaker]} &\) /@ 
                pointsAndRanges;\)*) 
Print["{range,BR} pairs: ", l]; 
typeRangeAndActionToStrategyRow[t] /@ 
          mergeRangesSlow[l]]\)

bestResponse::usage = "Takes a strategy -- a function mapping type \
to action -- that is piecewise-linear and returns a best-response strategy \
(which will also be piecewise-linear (TODO prove)).";
bestResponse[strategy_, tiebreaker_:  Less] := 
      matrixToStrategy[
        bestResponseMatrix[strategyToMatrix[strategy], 
          tiebreaker]]

SCRATCH

paperStrategy[v_][c_] := 
      Which[0 ≤ c ≤ v - 1, 1/2*c + v/2 - 1/4, 
        v - 1 ≤ c ≤ 1, 
        3/4*c + v/4]
fixedPriceStrategy[p_, v_][c_] := 
      Which[0 ≤ c ≤ p, p, 
        p ≤ c ≤ 1, v]
linearStrategy[v_][c_] := 
      Which[0 ≤ c ≤ 1, 
        c/2 + v/3]
linearStrategy2[v_][c_] := 
      Which[0 ≤ c ≤ 2/3*v - 1, 2/3*v - 1/2, 
        2/3*v - 1 ≤ c ≤ 1, 
        c/2 + v/3]
testStrategy[v_][c_] := 
      Which[0 ≤ c ≤ 1, (v + c)/
          2]
truthTellingStrategy[c_] := 
      Which[0 ≤ c ≤ 1, c]

v = (10 - (Sqrt[5]))/5. ;

v = 2;

bestResponse[linearStrategy[v]]

bestResponse[linearStrategy[v]]

bestResponse[paperStrategy[v]]

bestResponse[%]

ToDate[AbsoluteTime[]]

bestResponse[%92]

ToDate[AbsoluteTime[]]