US income tax in pictures

Some visualizing and summarizing of Chris Peel's excellent deep dive into US income tax schedules and effective tax rates.

Load and organize data

(* Replace with the correct file path! Data can be found at https://raw.githubusercontent.com/chrisvwx/taxFoo.jl/main/incomeTax/mfj.csv *)labeled =Import ["/Users/swaldman/Documents/BaseFolders/mchange-llc-fl/Interfluidity/income-tax-surface/mfj-with-std-deduction.csv"];

data=labeled[[2;;,2;;]];

transposedLabeled=Transpose[labeled];

For surface graphs

(* genSurface expects a CSV whose rows are years, columns are income as 10^x where x begins at 3 and rises by ticks of 0.1, whose first row and column are labels that are stripped *)
genSurface[data_]:=Module[{dim,ticksYear,ticksIncome,ticksRate},
dim=Dimensions[data];
ticksYear=Select[Table[{Round[x],Round[1861+x]},{x,1,dim[[1]]}],(Mod[#[[2]],10]==0)&];
ticksIncome=Select[Table[{Round[x],"$"<>ToString[NumberForm[Round[(10^((((x+29)/10))))],DigitBlock->3]]},{x,1,dim[[2]]}],(Mod[#[[1]],10]==1)&];
ticksRate=Table[{x,TextString[x]<>"%"},{x,0,100,10}];
DiscretePlot3D[data[[i,j]],{i,1,dim[[1]]},{j,1,dim[[2]]},Joined->True,AxesLabel->Map[Style[#,FontWeight->Bold]&,{"Year","Income","Rate"}],ColorFunction->"SouthwestColors",Ticks->{ticksYear,ticksIncome,ticksRate},AxesEdge->{Automatic,{1,-1},Automatic},ImageSize->Full]
]

Generate surface graph

graph =genSurface[data] (* see genSurface.nb *)

CloudDeploy[graph,Permissions->"Public"]

Generate variability table

indexInTranposedLabeledForYear[year_]:=year-1860

variabilityTableRow[i_, fromYear_]:=Module[{fromIndex=indexInTranposedLabeledForYear[fromYear],dataVec,min,max},
dataVec = transposedLabeled[[i,fromIndex;;]];
min=Min[dataVec];
max=Max[dataVec];
{transposedLabeled[[i,1]],min,max,max-min,StandardDeviation[dataVec]}
]

variabilityTable[fromYear_] := Module[{len},len=Length[transposedLabeled];Table[variabilityTableRow[i,fromYear],{i,2,len}]
]

variabilityTable[1945]//TableForm

Generate cross-section graphs

crossSectionGraph[startYear_,endYear_]:=Module[{startIndex=startYear-1860,endIndex=endYear-1860},ListPlot[Reverse[Map[Style[#,Thick]&,{Legended[transposedLabeled[[12,startIndex;;endIndex]],"$10K"],
Legended[transposedLabeled[[20,startIndex;;endIndex]],"$63K"],Legended[transposedLabeled[[22,startIndex;;endIndex]],"$100K"],
Legended[transposedLabeled[[25,startIndex;;endIndex]],"$200K"],
Legended[transposedLabeled[[29,startIndex;;endIndex]],"$500K"],
Legended[transposedLabeled[[32,startIndex;;endIndex]],"$1M"],Legended[transposedLabeled[[42,startIndex;;endIndex]],"$10M"],Legended[transposedLabeled[[52,startIndex;;endIndex]],"$100M"]}]],Joined->True,PlotLegends->None,Frame->True,DataRange->{startYear,endYear},PlotRange->{0,100},Background->Black, FrameStyle->LightGray,PlotLabel->Style["US Effective Income Tax Rates, " <> TextString[startYear]<>" to "<>TextString[endYear],White,FontFamily->"American Typewriter", FontSize->24,FontTracking->"Extended"], ImageSize->1024]
]

crossSectionGraph[1862,2024]

crossSectionGraph[1945,2024]

crossSectionGraph[1962,1972]

crossSectionGraph[1965,1980]

crossSectionGraph[1980,1988]

crossSectionGraph[1980,2000]

crossSectionGraph[2000,2024]