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\ *) \)\)\)

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

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

u[c_ ]  =  2 (Sqrt[c]) ;

\(\(\(\(pibar\ \  = \  .02;\)\ \ \  (*\ 
      maximum\ fraction\ of\ audited\ households\ *) 

    \(mbar\  =  .5;\)\)\(\ \ \ \ \)\( (*\ 
      probability\ of\ low\ endowment\ *) \)\)\)

pi[m_]  =  
      If[m > pibar, (pibar/m), 1. ];      (* 
      audit probability for a household which reports low endowment *)

elow  =  1/2 ;     
ehigh  =  
        3/2 ;

SetOptions[Display, 
        ImageSize -> 360];

    SetOptions[Export, ImageSize -> 360];

\(\(\( (*\ 
      current\ directory\ is\ set\ to\ match\ the\ location\ of\ this\ notebook; \ 
      eps\ files\ are\ saved\ there\ *) \)\(
\)\(\(filename = ToFileName["FileName" /. 
            NotebookInformation[EvaluationNotebook[]]];\)

    \(SetDirectory[DirectoryName[filename]];\)\)\)\)

First Order Conditions

eq3[tauhigh_, taulow_, mu_, m_, 
        lambda_]  =  u'[ehigh - tauhigh] (1 + lambda)  -  
        mu

eq4[tauhigh_, taulow_, mu_, m_, lambda_]  =  
      mbar u'[elow - taulow]  -  
        lambda (1 - mbar) (1 - pi[m]) u'[ehigh - taulow]  -  
        mbar mu

eq5[tauhigh_, taulow_, mu_, m_, 
        lambda_]  =  (1 - 
              m) tauhigh  +  m taulow

Optimal Policy

Optimal policy

eqvec[tauhigh_, taulow_, mu_, m_, 
          lambda_] = 
{eq3[tauhigh, taulow, mu, m, 
            lambda], 
eq4[tauhigh, taulow, mu, m, 
            lambda], 
eq5[tauhigh, taulow, mu, m, 
            lambda]};

policyvec[m_, lambda_, tauhighstart_, taulowstart_, 
        mustart_] := (policyrule = 
          FindRoot[
            eqvec[tauhigh, taulow, mu, m, 
              lambda], 
{tauhigh, tauhighstart}, {taulow, 
              taulowstart}, {mu, mustart}]; 
{tauhigh, 
            taulow, mu} /. policyrule)

Delta[m_, lambda_, tauhighstart_, taulowstart_, 
        mustart_] := (pt = 
          policyvec[m, lambda, tauhighstart, taulowstart, 
            mustart]; 
tauhight = pt[[1]]; 
        taulowt = 
          pt[[2]]; 
u[
            ehigh - tauhight] - (1 - pi[m]) 
            u[ehigh - taulowt])

Private Information: Solution

Solution at mbar

dist = 1. ;
tauhight0 =  .924; taulowt0 =  .1; mut0 = 1.58;
lambdat =  .31285;
While[
      Abs[dist] >  .000001, 
(deltat = 
          Delta[mbar, lambdat, tauhight0, taulowt0, 
            mut0]; 
tauhight0 = pt[[1]]; 
        taulowt0 = pt[[2]]; 
        mut0 = pt[[3]]; 
dist = 
          deltat; 
Print[
          dist]; 
lambdat = lambdat - dist)]
tauhighmbar = pt[[1]]; taulowmbar = pt[[2]]; 
    mumbar = pt[[3]];

lambdat

Solution over the grid

gm =  .0005;

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

deltagrid  =  Table[0, {nm}];
tauhighgrid  =  Table[0, {nm}];
taulowgrid  =  Table[0, {nm}];
mugrid  =  Table[0, {nm}];

tauhight0 =  tauhighmbar;
taulowt0  =  taulowmbar;
mut0 =  mumbar;

For[im  =  nm, 
        im ≥ 
          1, im--, 
(deltagrid[[im]]  =  
            Delta[mgrid[[im]], lambdat, tauhight0, taulowt0, 
              mut0]; 
tauhight0  =  pt[[1]]; 
          taulowt0  =  pt[[2]];  
          mut0  =  
            pt[[3]]; 
tauhighgrid[[im]] =  
            pt[[1]];  
          taulowgrid[[im]]  =  
            pt[[2]]; 
mugrid[[im]]  =  
            pt[[3]])];

Private Information: Graphs

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

taulowg  =  
        ListPlot[
          Table[{mgrid[[im]], taulowgrid[[im]]}, {im, 1, 
              nm}], 
PlotJoined -> True, 
          PlotRange -> {{0, 1}, {-0.4, 0}}, 
          PlotStyle -> {Red, Thickness[ .01]}, 
          AxesOrigin -> {0, 0}];

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

Full Information: Solution

Solution over the grid

deltagridf  =  Table[0, {nm}];
tauhighgridf  =  Table[0, {nm}];
taulowgridf  =  Table[0, {nm}];
mugridf  =  Table[0, {nm}];

lambdat  =  0. ;

tauhight0  =   .924;  tau1lowt0 =  .1; tau0lowt0  =   .1;  
    mut0  =  1.58;

For[im = nm, 
        im ≥ 
          1, im--, 
(deltagridf[[im]]  =  
            Delta[mgrid[[im]], lambdat, tauhight0, taulowt0, 
              mut0]; 
tauhight0  =  pt[[1]]; 
          taulowt0  =  pt[[2]];   mut0  =  
            pt[[3]]; 
tauhighgridf[[im]] =  
            pt[[1]];  
          taulowgridf[[im]]  =  
            pt[[2]]; 
mugridf[[im]]  =  
            pt[[3]])];

Full Information: Graphs

deltafg  =  
        ListPlot[
          Table[{mgrid[[im]], deltagridf[[im]]}, {im, 1, 
              nm}], 
PlotJoined -> True, 
          PlotRange -> All, 
          PlotStyle -> {Blue, Thickness[ .01]}];

Show[deltag, deltafg];

taulowfg  =  
        ListPlot[
          Table[{mgrid[[im]], taulowgridf[[im]]}, {im, 1, 
              nm}], 
PlotJoined -> True, 
          PlotRange -> All, PlotStyle -> {Blue, Thickness[ .01]}, 
          PlotRange -> {{0, 1}, {- .7,  .5}}];

Show[
        taulowfg, taulowg, Graphics[Text["m", {1,  .05}]], 
        PlotRange -> All];

tauhighfg  =  
        ListPlot[
          Table[{mgrid[[im]], tauhighgridf[[im]]}, {im, 1, 
              nm}], 
PlotRange -> All, 
          PlotJoined -> True, PlotRange -> All, 
          PlotStyle -> {Blue, Thickness[ .01]}];

Show[
        tauhighfg, tauhighg, Graphics[Text["m", {1,  .05}]], 
        AxesOrigin ->  {0, 0}];