Supply chain game.  There are 2 suppliers in sequence feeding into a consumer with value v.  They both bid to produce their components and if their bids sum to less than v, they both get what they bid.  If it's more than v, they both get nothing.  This is isomorphic to a standard bargaining problem where the buyer and seller each say a price and if they overlap, they transact and get whatever surplus, and if they don't overlap, they both get nothing.

Libraries and Constants and stuff

\(\(Switch["windows", 
"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["Equilibria.m"]

Get["psHash.m"];

psHashDomain = domain[psHash];

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

(* 
      Supply chain game with 2 suppliers in sequence ...  *) 
payoff[myCost_, myBid_, otherBids_List] := 
      If[myBid + Plus @@ otherBids ≤ v, myBid - myCost, 
        0]

minType = 0;
maxType = 1;

bidRange[myCost_:  0] := {myCost, v}
minAction[myCost_:  0] := 
      First[bidRange[myCost]]
maxAction[myCost_:  0] := Last[bidRange[myCost]]

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]

responseToLinear[c_]:=Which[
        0 ≤ c ≤ (1/3), (5/6), 
        (1/3) ≤ c ≤ 1, (2/3) + (c/2)]

responseToPaper[
        c_]:=Which[
0.` ≤ c ≤ 
          0.33541019662496846`, 0.5822949016875159` + 
          0.5` c, 
0.33541019662496846` ≤ 
          c ≤ 0.4736067977499787`, 
        0.7499999999999999`, 
0.4736067977499787` ≤ c ≤ 
          0.4736067977499792`, 0.5131966011250105` + 0.5` c, 
        0.4736067977499792` ≤ c ≤ 0.47360679774998093`, 
        0.75`, 
0.47360679774998093` ≤ 
          c ≤ 
          1, 0.5131966011250105` + 
          0.5` c]   (* 
        when v = 1.5527864045000421 *)

Experiments

v = 1.5527864045000421;
s = {paperStrategy[v]};
While[
      True, 
CheckAbort[
        While[True, 
          ps[makeTypeActionPairs[1/256, 1/128, s, 0/256, 256/256], s]], 
        Print["Showing best response at ", 
          ToDate[AbsoluteTime[]]]; 
showBestResponse[s, 
          confidence ->  .95, 
          compareFuncs -> {responseToPaper}]]]

DeleteFile["E:\\equilibria\\psHash.m"]; 
    Save["E:\\equilibria\\psHash.m", psHash]

Scratch

Options[avgPayoffRange] = {confidence ->  .99, 
          time -> 10};
avgPayoffRange[myCost_, myBid_, otherBidFunc_, opts___] := 
      Module[{opt}, 
opt[x_] := x /. {opts} /. 
            Options[avgPayoffRange]; 
meanCI[
          opt[confidence], 
          Sequence @@ 
            avgPayoffStats[myCost, myBid, otherBidFunc, 
              opt[time]]]]

Needs["Graphics`Graphics`"]

Histogram[First[psHash @@ #] & /@ domain[psHash], 
        FrequencyData -> True];

nashStrategy[v_][c_] := Max[v/2, c]

paperStrategy[c_] := 
      Min[v, c + 1/2*If[v - c > 1, v - c - 1/2, (v - c)/2]]

truthTelling[c_] := c

test[c_] := Max[v - 1/2 - v/3, 1/3*v + 1/2*c]

s2[v_][c_] := c/2 + v/3

s = {s2[v]};

Plot[{test[c], linearStrategy2[v][c]}, {c, 0, 1}, 
      PlotRange -> All, 
      PlotStyle -> {RGBColor[1, 0, 0], RGBColor[0, 1, 0]}]