WOLFRAM NOTEBOOK

COVID-19 US County Death Timeline Plots

Bob Sandheinrich

Create timeline plots of New York Times county-by-county data for COVID-19 deaths.

Retrieve Data

Get the latest data from the New York Times using the NYTimesCOVID19Data resource function:

In[]:=

AbsoluteTiming[timeseries=ResourceFunction["NYTimesCOVID19Data"]["USCountiesTimeSeries"];]

Plotting Tools

Making log trend lines

This is pretty hacky—Epilog with DateListLogPlot is not easy to use, but I experimentally found some values that look alright.

Decide how long the trend lines should be and define a vertical offset (the offset was chosen experimentally and may need to be adjusted):

In[]:=

$linedays=30;$startlinevalue=2.5;

Define functions for making trendlines and labeling them:

In[]:=

makeline[a_]:=N@{Darker[ColorData["TemperatureMap"][1/2+1/(a/2)],.2],Line[{{Now,$startlinevalue},{Now+Quantity[$linedays,"Days"],$startlinevalue+($linedays/a)}}],Text["Doubles every "<>ToString[a]<>" days",textlocation[a]]}

In[]:=

textlocation[a_]:=If[2^($linedays/a)<100,{Now+Quantity[$linedays,"Days"],$startlinevalue+($linedays/a)},With[{d=First[x/.NSolve[2^(x/a)100.&&x>0,x]]},{Now+Quantity[d-5,"Days"],N@Log[2,100]}]]

Define DateListPlot options:

In[]:=

$plotopts=Sequence@@{FrameTicks{None, Automatic},PlotRange{Automatic,{5,Automatic}},PlotLegendsNone,PlotLabelsPlaced[Automatic,Right,StringDelete[CommonName[#],", United States"]&],Epilog{Dashed,makeline/@{3,5,10}},ImageSize800};

Select Data

Select only data for counties that have had a minimum number of deaths for a minimum number of days, then align the first timestamp of each time series using the TimeSeriesAlign resource function:

In[]:=

$mindeaths=10;$mindays=18;

In[]:=

highdeaths=timeseries[All,ResourceFunction["TimeSeriesSelect"][#Deaths,#2>$mindeaths&]&][Select[#["PathLength"]>$mindays&]/*ResourceFunction["TimeSeriesAlign"]];

Create a Plot

Create a plot:

In[]:=

DateListLogPlot[highdeaths,$plotopts]

Out[]=

Deploy a Web Form

Export the data to a static cloud object to make the performance reasonable:

In[]:=

dataco=CloudExport[timeseries,"WXF","COVID19/CountyTimeSeries/data.wxf"];

Deploy a form:

In[]:=

CloudDeploy[FormFunction[{"County"RepeatingElement["USCounty"]},With[{data=Import[dataco]},With[{selected=data[KeyTake[#County],ResourceFunction["TimeSeriesSelect"][#Deaths,#2>$mindeaths&]&][Select[#["PathLength"]>$mindays&]/*ResourceFunction["TimeSeriesAlign"]]},If[!MissingQ[selected]&&Length[selected]>0,DateListLogPlot[selected,$plotopts],CloudPut[#County->selected,"COVID19/CountyTimeSeries/lastfailure"];"No data found"]]]&,"CloudCDFElement",AppearanceRules<|"Title""US County COVID-19 Death Timeline","Description""NY Times Data updated: "<>DateString[]|>],"COVID19/CountyTimeSeries/form",Permissions"Public"]

Out[]=

CloudObject[

https://www.wolframcloud.com/obj/bobs/COVID19/CountyTimeSeries/form

]

Any time the results do not contain data, it logs it here:

In[]:=

CloudGet["COVID19/CountyTimeSeries/lastfailure"]

Out[]=

{}MissingNotAvailable,Select[#1[PathLength]>2&]/*

[◼]	TimeSeriesAlign



You are using a browser not supported by the Wolfram Cloud

Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.

I understand and wish to continue anyway »