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 + ψ)) ;

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

mlow  = 0.01 ;     (* 
      low bound of probability of low productivity *) 
mhigh  = 0.9999 ;     (* 
      upper bound of probability of low productivity *)

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

First Order Conditions

(* 
      first order condition with respect to chigh *) 
eq1[chigh_, clow_, lhigh_, llow_, mu_, m_, 
          lambda_]  =  u'[chigh] (1 + lambda)  -  
          mu;

(* 
      first order condition with respect to lhigh *) 
eq2[chigh_, clow_, lhigh_, llow_, mu_, m_, 
          lambda_]  =  v'[
              lhigh] (1 + lambda)  - γh mu;

(* 
      first order condition with respect to clow *) 
eq3[chigh_, clow_, lhigh_, llow_, mu_, m_, 
          lambda_]  =   u'[
              clow] (1 -  lambda (1 - m)/m)  -  
          mu;

(* 
      first order condition with respect to llow *) 
eq4[chigh_, clow_, lhigh_, llow_, mu_, m_, 
          lambda_]  =  v'[llow] - 
          lambda (1 - m)/
              m ( γl/γh) v'[ γl/γh llow] -  γl mu;

eq5[chigh_, clow_, 
          lhigh_, llow_, mu_, m_, 
          lambda_] =  (1 - m) (chigh  - γh lhigh) +  
          m (clow - γl llow);

eqvec[chigh_, clow_, lhigh_, llow_, mu_, m_, 
          lambda_] = 
{eq1[chigh, clow, lhigh, llow, mu, m, 
            lambda], 
eq2[chigh, clow, lhigh, llow, mu, m, 
            lambda], 
eq3[chigh, clow, lhigh, llow, mu, m, 
            lambda], 
eq4[chigh, clow, lhigh, llow, mu, m, 
            lambda], 
eq5[chigh, clow, lhigh, llow, mu, m, 
            lambda]};

Private Information: Optimal Policy

Analytical solution for the FOCs

mu[m_, 
          lambda_] = (((1 - m) (1 + lambda)^(1/σ) + 
                  m Max[0, 
                        1 - lambda ((1 - m)/
                                m)]^(1/σ))/((1 - 
                        m) γh^(1 + 1/ψ) (1 + 
                          lambda)^(-1/ψ) + 
                  m γl^(1 + 1/ψ) (1 - 
                          lambda ((1 - m)/
                                m) (γ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[m > (lambda/(1 + lambda)), (((mu[m, lambda]/(1 - lambda (( 1 - m)/m))))^(-(1/σ))) , 0];
llow[m_, 
          lambda_] := (γl mu[m, 
                  lambda]/(1 - 
                    lambda ((1 - m)/
                          m) (γ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]];

IC[lambda_Real] := 
        NIntegrate[
          Delta[m, lambda] (1 - m), {m, mlow, lambda/(1 + lambda), 
            mhigh}, AccuracyGoal -> 5];

Doublecheck of the analytical solution

eqvec[chigh[m, lambda], clow[m, lambda], lhigh[m, lambda], 
        llow[m, lambda], mu[m, lambda], m, lambda] /. {m -> 0.3, 
        lambda -> 0.01}

Solution for lambda

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

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

Graphs

Plot[{chigh[m, slambda], clow[m, slambda]}, {m, mlow, 
          mhigh}, {PlotStyle -> {Blue, Red}, 
          PlotRange -> All}];

Plot[{lhigh[m, slambda], llow[m, slambda]}, {m, mlow, 
          mhigh}, {PlotStyle -> {Blue, Red}, 
          PlotRange -> All}];

Welfare

(*welfare at the ex ante solution*) 
NIntegrate[(1 - m) (u[chigh[m, slambda]] - v[lhigh[m, slambda]]) + 
        m (u[clow[m, slambda]] - v[llow[m, slambda]]), {m, mlow, 
        (slambda/(1 + slambda)), mhigh}, 
      AccuracyGoal -> 6]

NIntegrate[(1 - 
              m) (u[chigh[m, 0]] - v[lhigh[m, 0]]) + 
        m (u[clow[m, 0]] - v[llow[m, 0]]), {m, mlow, mhigh}, 
      AccuracyGoal -> 6]

Delta[ .9999, slambda]

Plot[Delta[m, slambda], {m, mlow, mhigh}, 
        PlotStyle -> Red];