Covid19 slope

Covid19-slope.nb

worlddata = 
  Import["https://covid.ourworldindata.org/data/owid-covid-data.csv"];

font = "Helvetica Neue";
slopeangle = Pi/6;
pos0 = {0, 0};
radius = Log[10]/Pi;
slopepos[val_, h_] := 
 pos0 + {Cos[slopeangle]*val + 
    h*Sin[slopeangle], (-Sin[slopeangle])*val + h*Cos[slopeangle]}
line[x_, val_] := 
  With[{angle = (val/Log[10])*Pi}, {{x[[1]] + 
      radius*Cos[-angle + Pi/2 - slopeangle], 
     x[[2]] + radius*Sin[-angle + Pi/2 - slopeangle]}, {x[[1]] - 
      radius*Cos[-angle + Pi/2 - slopeangle], 
     x[[2]] - radius*Sin[-angle + Pi/2 - slopeangle]}}];
tag = {0.001, 0.01, 0.1, 1, 10};
tagtext = {0.001, 0.01, 0.1, 1, 10};
tagoff = 0.5;
slope = Show[
   Graphics[
    Table[Text[Style[tagtext[[i]], 8, Black, FontFamily -> font], 
      slopepos[Log[tag[[i]]], -tagoff]], {i, 1, Length[tag]}]], 
   Graphics[
    Text[Style[0, 8, Black, FontFamily -> font], 
     slopepos[Log[minvalue], 0] + {-2, -0.4}]], 
   Graphics[
    Line[{slopepos[Log[minvalue], 0], slopepos[Log[2*10], 0]}]], 
   Graphics[
    Line[{slopepos[Log[minvalue], 0], 
      slopepos[Log[minvalue], 0] - {10, 0}}]], 
   Graphics[
    Table[Line[{slopepos[Log[tag[[i]]], 0], 
       slopepos[Log[tag[[i]]], -0.2]}], {i, 1, Length[tag]}]], 
   Graphics[
    Table[Table[
      Line[{slopepos[Log[k*tag[[i]]], 0], 
        slopepos[Log[k*tag[[i]]], -0.1]}], {k, 1, 10}], {i, 1, 
      Length[tag] - 1}]]];

names = {"Japan", "Taiwan", "Australia", "United States", 
   "United Kingdom", "India", "France", "Germany", "Italy", 
   "New Zealand", "Brazil", "South Korea", "Sweden", "Thailand", 
   "China"};
namesLabel = names;
startdate = {2020, 3, 15};
enddate = {2021, 8, 30};
startdateObj = DateObject[startdate];
date = 4;
newDeathsSmoothedPerMillion = 16;
newCasesSmoothedPerMillion = 13;
kmax = Length[names];
dataTmp = 
  Table[Cases[
     worlddata, (x_)?(#1[[3]] == names[[k]] &)][[All, {date, 
      newDeathsSmoothedPerMillion, newCasesSmoothedPerMillion}]], {k, 
    1, kmax}];
data = Table[
   DeleteCases[
    dataTmp[[k]], (x_)?(DateObject[#1[[1]]] < startdateObj &)], {k, 1,
     kmax}];
colors = Table[ColorData["Rainbow"][(k - 1)/(kmax - 1)], {k, 1, kmax}];
minvalue = 0.001;

names = {"Japan", "Taiwan", "Australia", "United States", 
   "United Kingdom", "India", "France", "Germany", "Italy", 
   "New Zealand", "Brazil", "South Korea", "Sweden", "Thailand", 
   "China"};
namesLabel = names;
startdate = {2020, 3, 15};
enddate = {2021, 8, 30};
startdateObj = DateObject[startdate];
date = 4;
newDeathsSmoothedPerMillion = 16;
newCasesSmoothedPerMillion = 13;
kmax = Length[names];
dataTmp = 
  Table[Cases[
     worlddata, (x_)?(#1[[3]] == names[[k]] &)][[All, {date, 
      newDeathsSmoothedPerMillion, newCasesSmoothedPerMillion}]], {k, 
    1, kmax}];
data = Table[
   DeleteCases[
    dataTmp[[k]], (x_)?(DateObject[#1[[1]]] < startdateObj &)], {k, 1,
     kmax}];
colors = Table[ColorData["Rainbow"][(k - 1)/(kmax - 1)], {k, 1, kmax}];
minvalue = 0.001;

ball[val_, k_] := 
 With[{zeropx = -1}, 
  Show[Graphics[
    If[val <= minvalue, 
     cntzero++; {colors[[k]], 
      Circle[slopepos[Log[minvalue], 0] + {zeropx - cntzero*0.05, 
         radius}, radius]}, {colors[[k]], 
      Circle[slopepos[Log[val], radius], radius]}]], 
   Graphics[{colors[[k]], 
     If[val <= minvalue, 
      Line[line[
        slopepos[Log[minvalue], 0] + {zeropx - cntzero*0.05, 
          radius}, -Log[10]/4 - cntzero*(0.05/Sqrt[2])]], 
      Line[line[slopepos[Log[val], radius], Log[val]]]]}], 
   Graphics[
    If[val <= minvalue, 
     Text[Style[namesLabel[[k]], 8, colors[[k]], FontFamily -> font], 
      slopepos[Log[minvalue], 0] + {-3, 3*radius - tskip*cntzero}, 
      Left],
     Rotate[
      Text[Style[namesLabel[[k]], 8, colors[[k]], FontFamily -> font],
        slopepos[Log[val], 2.3*radius], Left], Pi/6]]]]]
	
tskip = 0.5; tx = 1; ty = 5; pltalldeath = 
 DateListLogPlot[data[[All, All, 2]] /. "" -> "0.", startdate, 
  FrameStyle -> Directive[8, Black, FontFamily -> font], 
  Frame -> True, 
  PlotStyle -> Table[{Thickness[0.003], colors[[k]]}, {k, 1, kmax}], 
  PlotRange -> {{startdate, enddate}, {0.01, 100}}, 
  ImageSize -> 130];
output = Table[cntzero = 0; 
   plt = Show[pltalldeath, 
     DateListLogPlot[{{DateObject[data[[1, i, 1]]], 
        0.0001}, {DateObject[data[[1, i, 1]]], 10^4}}, startdate, 
      PlotStyle -> {{Black, Thickness[0.01]}}, Joined -> True]]; 
   Show[slope, Table[ball[data[[k, i, 2]], k], {k, 1, kmax}], 
    Graphics[Inset[Graphics[plt], {-6, 0}]], 
    Graphics[
     Text[Style["new deaths smoothed per million", 9, Black, 
       FontFamily -> font], {tx, ty + tskip}]], 
    Graphics[
     Text[Style[data[[1, i, 1]], 9, Black, FontFamily -> font], {tx, 
       ty - 0*tskip}]], 
    Graphics[
     Text[Style["source: covid.ourworldindata.org", 9, Black, 
       FontFamily -> font], {tx, ty - tskip}]], 
    PlotRange -> {{-9.2, 4}, {-2, 6}}], {i, 1, Length[data[[1]]]}];
outputMovie = Join[output, Table[Last[output], {j, 1, 30}]];
Last[outputMovie]

Export["~/world_death_per_M.mp4", outputMovie]