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 - σ)) ;

v[l_ ]  := 
        ((l^(1 + ψ))/(1 + ψ)) ;

σ = 2;
ψ =  .1;
γh = 2;
γl = 1;

p  = 1/2 ;

lambdahigh = 
        If[σ < 
            1, (p/(1 - 
                    p)) (γh/γl)^(1 + ψ), (p/(1 - p))] ;  (* 
      upper bound on the multiplier on implementability constraint;  
      after that,  Delta goes to infty *)

Private Information: Optimal Policy

Analytical solution for the FOCs

mu[m_, 
          lambda_] = (((1 - m) (1 + lambda)^(1/σ) + 
                  m Max[0, 
                        1 - lambda ((1 - p)/
                                p)]^(1/σ))/((1 - 
                        m) γh^(1 + 1/ψ) (1 + 
                          lambda)^(-1/ψ) + 
                  m γl^(1 + 1/ψ) (1 - 
                          lambda ((1 - p)/
                                p) (γl/γh)^(1 + ψ))^(-1/ψ)))^(σ ψ/(ψ + σ));
lhigh[m_, 
          lambda_] = (γh mu[m, 
                  lambda]/(1 + 
                    lambda))^(1/ψ);
chigh[m_, 
          lambda_] := (((mu[m, lambda]/(1 + lambda)))^(-(1/σ))) ;
clow[m_, lambda_] := 
        If[p > (lambda/(1 + lambda)), (((mu[m, lambda]/(1 - lambda (( 1 - p)/p))))^(-(1/σ))) , 0];
llow[m_, 
          lambda_] := (γl mu[m, 
                  lambda]/(1 - 
                    lambda ((1 - p)/
                          p) (γl/γh)^(1 + ψ)))^(1/ψ);

Delta[m_, lambda_] := 
        u[chigh[m, lambda]] - v[lhigh[m, lambda]] - u[clow[m, lambda]] + 
          v[(γl/γh) llow[m, lambda]];

Solution for lambda

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

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

Graphs

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

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

Welfare

(*welfare at the ex ante solution*) 
(1 - p) (u[chigh[p, slambda]] - v[lhigh[p, slambda]]) + 
      p (u[clow[p, slambda]] - v[llow[p, slambda]])

(1 - p) (u[chigh[p, 0]] - 
              v[lhigh[p, 0]]) + p (u[clow[p, 0]] - v[llow[p, 0]]) // 
      N

Delta[ .9999, slambda]

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