Setup

\(\(\( (*\ Copyright\ by\ Marco\ Bassetto, \ Roozbeh\ Hosseini, \ 
      Vadym\ Lepetyuk, \ 
      Christopher\ Phelan\ *) \)\(
\)\( (*\ \(This\ code\ can\ be\ freely\ distributed\ and\ modified\ for\ research\ purposes\ only\)\(,\)\ *) \)\(
\)\( (*\ 
      provided\ this\ copyright\ notice\ is\ included\ in\ the\ modified\ \(\(code\)\(.\)\)*) \)\(\ \)\(
\)\( (*\ 
      Proper\ credit\ should\ be\ given\ in\ all\ publications\ arising\ from\ *) \)\(
\)\( (*\ modifications\ of\ this\ code; \ 
      this\ should\ include\ a\ citation\ of\ *) \)\(
\)\( (*\ "Tax Riots"\ by\ Marco\ Bassetto\ and\ Christopher\ Phelan\ *) \)\)\)

Mathematica Setup

<< Graphics`Colors`
<< Graphics`Graphics`

Off[General::"spell"];
Off[General::"spell1"];
Off[Display::"pserr"];

If[$VersionNumber < 
        5.0, 
Total[x_]  := 
        Sum[x[[i]], {i, 1, Dimensions[x][[1]]}]]

SetOptions[Display, 
        ImageSize -> 360];

    SetOptions[Export, ImageSize -> 360];

$FormatType = TraditionalForm;

Model Setup

u[c_ ]  :=  
        ((c^(1 - σ))/(1 - σ));

a = 1;
σ = 2;
elow = 1;
ehigh = 3;
e2 = 2;

p = 1/2;

First Order Conditions

(* 
      first order condition with respect to c1high *) 
eq1[c1high_, c1low_, mu1_, m_, 
          lambda_]  =  u'[c1high] (1 + lambda)  -  
          mu1;

(* 
      first order condition with respect to c1low *) 
eq2[c1high_, c1low_, mu1_, m_, 
          lambda_]  =  u'[c1low] - 
          lambda (1 - p)/p u'[c1low + ehigh - elow] - 
          mu1;

eq3[c1high_, 
          c1low_, mu1_, m_, 
          lambda_] =  (1 - m) (c1high  - ehigh) +  
          m (c1low - elow);

(* 
      first order condition with respect to c2high *) 
eq4[c2high_, c2low_, mu2_, m_, 
          lambda_]  =  u'[c2high] (1 + lambda)  -  
          mu2;

(* 
      first order condition with respect to c2low *) 
eq5[c2high_, c2low_, mu2_, m_, 
          lambda_]  =   u'[
              c2low] (1 -  lambda (1 - p)/p)  -  
          mu2;

eq6[c2high_, 
          c2low_, mu2_, m_, lambda_] =  (1 - m) c2high  +  m c2low - 
          e2;

eqvec[c1high_, c1low_, mu1_, c2high_, c2low_, mu2_, m_, 
          lambda_] = 
{eq1[c1high, c1low, mu1, m, 
            lambda], 
eq2[c1high, c1low, mu1, m, 
            lambda], 
eq3[c1high, c1low, mu1, m, 
            lambda], 
eq4[c2high, c2low, mu2, m, 
            lambda], 
eq5[c2high, c2low, mu2, m, 
            lambda], 
eq6[c2high, c2low, mu2, m, 
            lambda]};

Private Information: Optimal Policy

Numerical solution of the FOCs

policyrule[m_?NumericQ, lambda_?NumericQ] := 
        FindRoot[
          eqvec[c1high, c1low, mu1, c2high, c2low, mu2, m, 
            lambda], 
{c1high, (1 - m) ehigh +  
              m elow}, {c1low, (1 - m) ehigh +  m elow}, {mu1, 
            0.1}, 
{c2high, e2}, {c2low, e2}, {mu2, 
            0.1}];

c1high[m_?NumericQ, lambda_?NumericQ] := 
      c1high /. policyrule[m, lambda]; 
    c1low[m_?NumericQ, lambda_?NumericQ] := c1low /. policyrule[m, lambda]; 
    c2high[m_?NumericQ, lambda_?NumericQ] := c2high /. policyrule[m, lambda]; 
    c2low[m_?NumericQ, lambda_?NumericQ] := 
      c2low /. policyrule[m, lambda];

Solution for lambda

Delta[m_, lambda_] := 
        u[c1high[m, lambda]] + u[c2high[m, lambda]] - 
          u[c1low[m, lambda] - elow + ehigh] - 
          u[c2low[m, lambda]];

Plot[Delta[p, lambda], {lambda, 0,  .8}, PlotRange -> All, 
        PlotStyle -> Red];

slambda = lambda /. FindRoot[Delta[p, lambda], {lambda, 0}]

Graphs

Plot[{c1high[m, slambda], c1low[m, slambda]}, {m, 
          0,  .99}, {PlotStyle -> {Blue, Red}, 
          PlotRange -> All}];

Plot[{c2high[m, slambda], c2low[m, slambda]}, {m, 
          0,  .99}, {PlotStyle -> {Blue, Red}, 
          PlotRange -> All}];

Plot[Delta[m, slambda], {m,  .01,  .99}, 
        PlotStyle -> Red];