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_ ]  :=  -Exp[-σ c]/σ;    (* utility function :  consumption *)

v[l_ ]  := Exp[ψ l]/ψ;

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

mbar =  .5;

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 - mbar)/mbar)  -  
          mu;

(* 
      first order condition with respect to llow *) 
eq4[chigh_, clow_, lhigh_, llow_, mu_, m_, 
          lambda_]  =  v'[llow] - 
          lambda (1 - mbar)/
              mbar ( γ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);

Private Information: Optimal Policy

Optimal Policy

Optimal policy

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]};

policyvec[m_, lambda_, chighstart_, clowstart_, lhighstart_,  
        llowstart_, 
        mustart_] := (policyrule = 
          FindRoot[
            eqvec[chigh, clow, lhigh, llow, mu, m, 
              lambda], 
{chigh, chighstart}, {clow, 
              clowstart}, {lhigh, lhighstart}, {llow, llowstart}, {mu, 
              mustart}]; 
{chigh, clow, lhigh, llow, mu} /. 
          policyrule)

Delta[m_, lambda_, chighstart_, clowstart_, lhighstart_, llowstart_, 
        mustart_] := (pt = 
          policyvec[m, lambda, chighstart, clowstart, lhighstart, llowstart, 
            mustart]; 
chight = pt[[1]]; 
        clowt = pt[[2]]; lhight = pt[[3]]; 
        llowt = pt[[4]]; 
u[chight] - v[lhight] - 
          u[clowt] + v[γl llowt/γh])

Solution at mbar

dist = 1. ;
chight0 = 1; clowt0 =  .5; lhight0 = 1; llowt0 =  .5; 
    mut0 = 1;
lambdat =  .1
While[
      Abs[dist] >  .000001, 
(deltat = 
          Delta[mbar, lambdat, chight0, clowt0, lhight0, llowt0, 
            mut0]; 
chight0 = pt[[1]]; 
        clowt0 = pt[[2]]; lhight0 = pt[[3]]; llowt0 = pt[[4]]; 
        mut0 = pt[[5]]; 
dist = 
          deltat; 
Print[
          dist]; 
lambdat = 
          lambdat -  .02  dist)]
chighmbar = pt[[1]]; clowmbar = pt[[2]]; 
    lhighmbar = pt[[3]]; llowmbar = pt[[4]]; 
    mumbar = pt[[5]];

lambdat

Solution at m>0

gm =  .0005;

mgrid  =  Table[m, {m, 0, 1, gm}]; nm  =  Length[mgrid]

deltagrid  =  Table[0, {nm}];
chighgrid  =  Table[0, {nm}];
clowgrid  =  Table[0, {nm}];
lhighgrid  =  Table[0, {nm}];
llowgrid  =  Table[0, {nm}];
mugrid  =  Table[0, {nm}];

chight0 =  chighmbar;
clowt0  =  clowmbar;
lhight0 =  lhighmbar;
llowt0  =  llowmbar;
mut0 =  mumbar;

For[im  =  nm, 
        im ≥ 
          1, im--, 
(deltagrid[[im]]  =  
            Delta[mgrid[[im]], lambdat, chight0, clowt0, lhight0, llowt0, 
              mut0]; 
chight0  =  pt[[1]]; 
          clowt0  =  pt[[2]];  lhight0 = pt[[3]]; 
          llowt0 = pt[[4]]; 
          mut0  =  pt[[5]]; 
chighgrid[[im]] =  
            pt[[1]];  clowgrid[[im]]  =  pt[[2]]; 
          lhighgrid[[im]] =  pt[[3]];  
          llowgrid[[im]]  =  
            pt[[4]]; 
mugrid[[im]]  =  
            pt[[5]])];

Graphs

chighg  =  
        ListPlot[
          Table[{mgrid[[im]], chighgrid[[im]]}, {im, 1, 
              nm}], 
PlotJoined -> True, 
          PlotStyle -> {Red, Thickness[ .01]}];

clowg  =  
        ListPlot[
          Table[{mgrid[[im]], clowgrid[[im]]}, {im, 1, 
              nm}], 
PlotJoined -> True, 
          PlotStyle -> {Blue, Thickness[ .01]}];

Show[chighg, clowg];

lhighg  =  
        ListPlot[
          Table[{mgrid[[im]], lhighgrid[[im]]}, {im, 
              1, nm}], 
PlotJoined -> True, 
          PlotStyle -> {Red, Thickness[ .01]}];

llowg  =  
        ListPlot[
          Table[{mgrid[[im]], llowgrid[[im]]}, {im, 
              1, nm}], 
PlotJoined -> True, 
          PlotStyle -> {Blue, Thickness[ .01]}];

Show[lhighg, llowg];

Delta

deltag  =  
        ListPlot[
          Table[{mgrid[[im]], deltagrid[[im]]}, {im, 1, 
              nm}], 
PlotJoined -> True, 
          PlotRange -> All, 
          PlotStyle -> {Red, Thickness[ .01]}];