sharedGoodAuction = {{0, 1/2, 1}, {0, -1/4, -1/2}, {0, 0, 
            0}, {1/2, 1/4, 0}, {0, 0, 0}, {0, 0}, -1};

vickreyAuction = {{0, 1/2, 1}, {0, 0, 0}, {0, 0, 
            0}, {0, -1/2, -1}, {0, 0, 0}, {0, 
            0}, -1};

k = 
        2/7;

    vv := {{0, (1 - k)/2, 1 - k}, {k, k/2, 0}, {-k, -k/2, 
            0}, {0, -(1 - k)/2, -(1 - k)}, {0, 0, 0}, {0, 
            0}, -1};

fpsb = {{0, 1/2, 1}, {0, -1/2, -1}, {0, 0, 0}, {0, 0, 0}, {0, 
            0, 0}, {0, 0}, -1};

allPayAuction = {{0, 1/2, 1}, {-1, -1, -1}, {0, 0, 
            0}, {0, 0, 0}, {0, 0, 0}, {0, 0}, -1};

v = (10 - 
              5^(1/2))/5;

    scAuction := {{-1, -1, 0}, {1, 1, 0}, {0, 0, 0}, {0, 0, 0}, {0, 
            0, 0}, {v, v}, 1};

cost = 1;
jointBuy := {{0, 1}, {0, -1/2}, {0, 0}, {0, 
            1/2}, {0, -cost/2}, {cost}, 1};

swinkelsGame = {{0, 1/2, 
            1}, {0, -1/2, -1}, {0, -2, -4}, {0, 0, 0}, {0, 2, 
            4}, {0, 0}, -1};

concessionGame = {{0, 0, 0}, {-1, -1, -1}, {0, 0, 0}, {0, 
            0, 0}, {0, 1/2, 1}, {0, 0}, -1};

bargSeller = {{-1, 0}, {1/2, 0}, {0, 0}, {1/2, 0}, {0, 
            0}, {0}, -1};
bargBuyer = {{0, 1}, {0, -1/2}, {0, 0}, {0, -1/2}, {0, 
            0}, {0}, -1};

uniformTypes = {{0, 1}, {1}};

truthfulBidding = {{}, {1}, {0}};

debug[x___] := If[False, Print[x]]

\(\(\( (*\ 
      Make\ 0*Infinity\ evaluate\ to\ 0. \ \ Thanks\ to\ Daniel\ Lichtblau\ of\ \(\(WRI\)\(.\)\)\ *) \)\(
\)\(\(Unprotect[
        DirectedInfinity];\)

    DirectedInfinity /: Unevaluated[0*DirectedInfinity[_]] := 0

    DirectedInfinity /: Unevaluated[0*DirectedInfinity[]] := 0\)\)\)

Unprotect[Min, Max];     
Min[x_, -Infinity] := -Infinity
Min[x_, +Infinity] := x     
Max[x_, -Infinity] := x
Max[x_, +Infinity] := +Infinity
Protect[Min, Max];

(* 
      The cdf given a piecewise uniform pdf. *) 
F[-Infinity] = 0;

    F[+Infinity] = 1;

    F[x_] := 
      Sum[If[d[[i]] ≤ x < d[[i + 1]], 1, 
            0]*(f[[i]]*(x - d[[i]]) + 
              Sum[f[[j]]*(d[[j + 1]] - d[[j]]), {j, 1, 
                  i - 1}]), {i, 1, Length[d] - 1}]

argMax::usage = "argMax[f, domain] returns the element of domain \
for which f of
  that element is maximal -- breaks ties in favor of first \
occurrence.";
SetAttributes[argMax, HoldFirst];
argMax[f_, dom_List] := 
      Fold[If[f[#1] ≥ f[#2], #1, #2] &, First[dom], 
        Rest[dom]]

cons[a_, l_] := Prepend[l, a]

arbAux[{a_}] := {a}
arbAux[{{c1_, m_, b_}, {c2_, r___}, r2___}] := 
      Which[
{r} == {}, 
        cons[{c1, m, b}, arbAux[{{c2, m, b}, r2}]], 
True, 
        cons[{c1, m, b}, arbAux[{{c2, r}, r2}]]]

arb[c_, m_, b_, d_] := 
      Module[{x}, 
        x = arbAux[
            Sort[Join[Transpose[{cons[-Infinity, c], m, b}], 
                Transpose[{Complement[d, c]}]], 
              First[#1] < First[#2] &]]; 
cons[
          Rest[First /@ x], Transpose[Rest /@ x]]]

rrb[{}, m_, b_] := {{}, m, 
        b}

    rrb[{c1_, c___}, {m1_, m1_, m___}, {b1_, b1_, b___}] := 
      rrb[{c}, {m1, m}, {b1, b}]

    rrb[{c1_, c___}, {m1_, m___}, {b1_, b___}] := 
      MapThread[cons, {{c1, m1, b1}, rrb[{c}, {m}, {b}]}]

mm[a_, b_, x_] := Min[b, Max[a, x]]

x0[i_, j_, 
        a_] := (p6[[i]] - p7*b[[j]] - a)/(p7*
            m[[j]])

y0[i_, j_, 
        a_] := (p6[[i + 1]] - p7*b[[j]] - a)/(p7*
            m[[j]])

x[i_, j_, a_] := 
      If[p7*m[[j]] > 0, x0[i, j, a], y0[i, j, a]]

y[i_, j_, a_] := 
      If[p7*m[[j]] > 0, y0[i, j, a], x0[i, j, a]]

OLD = 0 ;

p[i_, j_, 
        a_] := (F[mm[c[[j]], c[[j + 1]], y[i, j, a]]] - 
            F[mm[c[[j]], c[[j + 1]], x[i, j, a]]])*
        If[OLD == 0, 
          1, (F[c[[j + 1]]] - F[c[[j]]])]

xy[i_, j_, a_] := 
      1/2*(mm[c[[j]], c[[j + 1]], x[i, j, a]] + 
            mm[c[[j]], c[[j + 1]], y[i, j, a]])

eu[t_, a_] := 
      Sum[If[p7*m[[j]] == 0, 
          If[If[OddQ[i], 
              p6[[i]] - p7*b[[j]] < a < 
                p6[[i + 1]] - p7*b[[j]], 
              p6[[i]] - p7*b[[j]] ≤ a ≤ 
                p6[[i + 1]] - p7*b[[j]]], 
            Evaluate[(p1[[i]]*t + p2[[i]]*a + 
                    1/2*(c[[j]] + c[[j + 1]])*(p3[[i]] + 
                          p4[[i]]*m[[j]]) + 
                    p4[[i]]*b[[j]] + 
                    p5[[i]])*(F[c[[j + 1]]] - F[c[[j]]])], 
            0], If[c[[j]] == -Infinity || 
              c[[j + 1]] == Infinity, 
            0, (p1[[i]]*t + 
                  p2[[i]]*a + (p3[[i]] + p4[[i]]*m[[j]])*
                    xy[i, j, a] + p4[[i]]*b[[j]] + p5[[i]])*
              p[i, j, a]]], {i, 1, Length[p1]}, {j, 1, Length[m]}]

abounds[] := 
      Union[Flatten[{Table[
              p6[[i]] - p7*(m[[j]]*c[[j]] + b[[j]]), {i, 
                2, Length[p1]}, {j, 2, Length[m]}], 
            Table[p6[[i]] - 
                p7*(m[[j]]*c[[j + 1]] + b[[j]]), {i, 2, 
                Length[p1]}, {j, 1, Length[m] - 1}]}]]

maxima::usage = "Returns a list of (1 or 0) maxima of f[x] if it's \
a deg <= 2 polynomial.";
maxima[f_, x_] := 
      Module[{sol}, 
sol = 
          Check[Solve[D[f, x] == 0, 
              x], (Print["ERROR in maxima: ", f]; 
              Abort[])]; 
If[
          sol === {} || sol === {{}} || 
            D[f, {x, 2}] ≥ 
              0, {}, {sol[[1, 1, 2]]}]]

solveFor[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]

(* 
      MidPoints .  Take a 1  
        D list of boundary points and return points between the boundaries,  
      including one just before the first boundary and just after the last. *) 
mp[{}] = {0};

    mp[l_] := (First[#] + Last[#])/2 & /@ 
        Partition[Join[{First[l] - 1}, l, {Last[l] + 1}], 2, 
          1]

bat[t0_, au_] := 
      First@argMax[(#[[2]] /. t -> t0) &, au]

bat[t0_, a_] := 
      argMax[Simplify[eu[t0, # /. t -> t0]] &, a]

\(\(\( (*\ Best\ Response\ give\ game\ params, \ type\ dist, \ 
      and\ strategy\ \(\({c, m, 
            b}\)\(.\)\)\ *) \)\(
\)\(\(br[{p1a_, p2a_, 
            p3a_, p4a_, p5a_, p6a_, p7a_}, {d0_, f0_}]\)[{c0_, m0_, b0_}] := 
      Module[{ab, au1, u2, a2, au2, au, ca, cu, pairs, tb, actions, 
          i}, 
debug["DEBUG: b0: ", 
          b0]; 
p1 = p1a; p2 = p2a; p3 = p3a; p4 = p4a; 
        p5 = p5a; 
p6 = 
          Join[{\(-Infinity\)}, 
            p6a, {\(+Infinity\)}]; 
p7 = 
          p7a; 
d = 
          Join[{\(-Infinity\)}, d0, {\(+Infinity\)}]; 
f = 
          Join[{0}, f0, {0}]; 
{c, m, b} = 
          arb[c0, m0, b0, d0]; 
debug["DEBUG: arb[", 
          c0, ", ", m0, ", ", b0, ", ", d0, "] = ", 
          arb[c0, m0, b0, d0]]; 
c = 
          Join[{\(-Infinity\)}, c, {\(+Infinity\)}]; 
ab = 
          Sort[Union@Join[{\(-Infinity\)}, abounds[], {Infinity}], 
            Less]; 
debug["DEBUG: {c,m,b,p1,p6,p7} = ", {c, m, b, p1, p6, p7}]; 
debug["DEBUG: ab = ", 
          ab]; 
debug["DEBUG: ab assumptions: ", \((First[#] < a < Last[#] &)\) /@ 
            Partition[ab, 2, 1]]; 
 (*\ 
          action - 
            utility\ pairs\ at\ action\ boundaries\ *) 
au1 = \({#, eu[t, #]} &\) /@ 
            Select[ab, \(-Infinity\) < # < 
                  Infinity &]; 
debug["DEBUG: au pairs for abounds: ", 
          au1]; 
 (*\ \(debug["DEBUG: eu[t,2/3v-1/2] = ", eu[t, 2/3  v - 1/2]];\)\ *) 
 (*\ 
          best\ auction - 
            utility\ pairs\ between\ action\ boundaries\ *) 
u2 = \(Refine[
                FullSimplify[
                  eu[t, a] /. DirectedInfinity[i_] -> i*10^100, 
                  First[#] < a < Last[#] && \(-10^100\) < a < 10^100], 
                First[#] < a < Last[#] && \(-10^100\) < a < 10^100] &\) /@ 
            Partition[ab, 2, 
              1]; 
a2 = \((\(maxima[#, a] &\) /@ 
              
              u2)\); 
debug["DEBUG: au pairs between abounds: ", Transpose[{a2, u2}]]; 
au2 = 
          Flatten /@ 
            Select[Transpose[{a2, u2}], 
              Length@First[#] ≠ 
                  0 &]; 
 (*\ \(debug["DEBUG: au1 = ", 
              au1, " -- au2 = ", 
              au2];\)\ *) 
au2 = \((\({First[#], 
                  Last[#] /. a -> First[#]} &\) /@ 
              au2)\); 
au = 
          Join[au1, 
            au2]; 
debug["Best Response Candidates (action-utility pairs): ", au]; {ca, cu} = 
          Transpose[au]; 
pairs = 
          Union@\((Sort /@ 
                Select[Distribute[{ca, ca}, List], 
                  First[#] =!= 
                      Last[#] &])\); 
debug["DEBUG: type pairs: ", pairs]; 
tb = 
          Sort[Union[Take[c, {2, \(-2\)}], 
              Select[Flatten[solveFor[t] /@ pairs], Im[#] == 0 &]], 
            Less]; \ \  (*\ 
          don' t\ think\ we\ need\ c\ there\ *) 
actions = \((\(bat[#, ca] &\) /@ 
              mp[tb])\); 
debug["DEBUG: bat[1/6,ca] = ", bat[1/6, 
            ca]]; 
debug["DEBUG: {tb,actions,mp[tb]}: ", {tb, actions, mp[tb]}]; 
rrb[
          tb, \(D[#, t] &\) /@ actions, 
          actions /. t -> 0]
]\)\)\)

abr[{u1_, 
            u2_}, {t1_, t2_}][{s1_, s2_}] := {br[u1, t2][
          s2], br[u2, t1][s1]}