Message Boards

GROUPS:

Christopher Wolfram

Understanding Aggregate COVID Curves

Christopher Wolfram, WOLFRAM

Posted 6 months ago

2262 Views

5 Replies

17 Total Likes

Follow this post

MODERATOR NOTE: coronavirus resources & updates: https://wolfr.am/coronavirus

This post is largely the result of a conversation I had with Brian Silverman.

Here is the current plot of weekly global COVID-19 deaths:

covidData=ResourceData["Epidemic Data for Novel Coronavirus COVID-19"];

In[]:=

DateListPlot[covidData[Select[FreeQ[#Deaths["Values"],_Missing]&]/*Total/*Differences/*(MovingMap[Total,#,"Week"]&),"Deaths"],FrameLabel"deaths"]

Out[]=

This curve is probably very familiar at this point. It gives the impression that there has been a resurgence in the incidence of COVID, perhaps associated with the lifting of lockdowns. In order to understand what is going on, we start by decomposing this global aggregate into national aggregates, and looking at a small sample:

nationalDeaths=covidData[Query[GroupBy["Country"],Total,"Deaths"]/*Select[GreaterThan[50000]@*Total]/*Map[MovingMap[Total,#,"Week"]&]];

In[]:=

nationalDeathsDerivatives=Differences/@nationalDeaths;

In[]:=

plotCurve[label_,ts_,opts___]:=DateListPlot[ts,PlotLabellabel,PlotRange{All,{0,All}},ImageSize700,AspectRatio1/6,opts]

In[]:=

Column[KeyValueMap[plotCurve,RandomSample[Normal[nationalDeathsDerivatives],5]]]

Out[]=

There is a wide variety of behavior here, with some countries primarily showing a peak around April, others showing a peak in August, and some with both. This might suggest that, to an extent, the double peak we see in the global aggregate is not a resurgence of cases in regions lifting lockdowns, but the appearance of COVID in regions which did not experience a peak in May.

In order to visualize this better, we can start by trying to quantify the locations of peaks in these national curves. We could just find the highest point, but this is highly sensitive to outliers and can’t deal with double peaks. It also fails to capture the behavior in the tails, which we can see are also varied (from fat to narrow tails). Instead, think of each peak as a histogram showing the distribution of dates when deaths occurred. The mean or median of this distribution gives us a measure of centrality. We can also look at the standard deviation to get a measure of how “flat” the curve is.

(There are very efficient ways of performing these calculations, but they require more explanation, so I will probably have to write about them in a future post. There isn’t too much data here, so I will use simpler but less efficient methods.)

nationalDists=ProbabilityDistribution[Abs[Interpolation[DeleteMissing[#["Path"],1,2],InterpolationOrder1][x]],{x,#["FirstTime"],#["LastTime"]},Method"Normalize"]&/@Normal[nationalDeathsDerivatives];

In[]:=

nationalMeans=DateObject[N@NExpectation[x,x#]]&/@nationalDists;

nationalStandardDevs=MapThread[UnitConvert[Quantity[N@Sqrt@NExpectation[(x-AbsoluteTime[#2])^2,x#1],"Seconds"],"Days"]&,{nationalDists,nationalMeans}];

nationalMedians=#["Dates"][[FirstPosition[#["Values"],_?(GreaterThan[#["LastValue"]/2])][[1]]]]&/@Normal[nationalDeaths];

In[]:=

The following shows all of the national curves sorted by mean (peak date):

Column[KeyValueMap[plotCurve,KeySortBy[Normal[nationalDeathsDerivatives],nationalMeans]]]

Out[]=

(I don’t know why some of the curves show negative deaths. This is probably some error in the data because I think resurrection on that scale would be more widely reported.)

Apart from a number of data issues, we can see that China had its peak long before anywhere else, and then a procession of countries with well-defined peaks around April. Then there are a few countries that have more erratic curves, and then there are a few with late peaks. Interestingly, there are relatively few which show two proper peaks.

We can also look at how the mean death date varies with geography. Below shows countries with late mean death dates in red, and countries with earlier mean death dates in blue:

(Gray countries had fewer than 50,000 cases and were not counted.)

GeoRegionValuePlot[AbsoluteTime/@KeyMap[GeoVariant[#,"SimplifiedArea"]&,nationalMeans],ImageSize1000,GeoBackground{"CountryBorders","Land"LightGray},GeoRange"World",GeoProjection"WinkelTripel",ColorFunction(ColorData[{"RedBlueTones","Reversed"}][#]&),PlotLegendsNone]

Out[]=

We can also look at medians:

GeoRegionValuePlot[AbsoluteTime/@KeyMap[GeoVariant[#,"SimplifiedArea"]&,nationalMedians],ImageSize1000,GeoBackground{"CountryBorders","Land"LightGray},GeoRange"World",GeoProjection"WinkelTripel",ColorFunction(ColorData[{"RedBlueTones","Reversed"}][#]&),PlotLegendsNone]

Out[]=

Finally, we can look at standard deviation. A high standard deviation could be interpreted as the curve being successfully flattened, or it could be interpreted as the outbreak being drawn out for a long time:

GeoRegionValuePlot[KeyMap[GeoVariant[#,"SimplifiedArea"]&,nationalStandardDevs],ImageSize1000,GeoBackground{"CountryBorders","Land"LightGray},GeoRange"World",GeoProjection"WinkelTripel",ColorFunction(ColorData[{"RedBlueTones","Reversed"}][#]&)]

Out[]=

US States

We can perform a similar analysis on US states.

stateDeaths=covidDataQuerySelect#Country===

United States

COUNTRY

&/*GroupBy["AdministrativeDivision"],Total,"Deaths"/*KeySelect[Not@*MissingQ]/*Select[GreaterThan[0]@*Total]/*Map[MovingMap[Total,#,"Week"]&];

In[]:=

stateDeathsDerivatives=Differences/@stateDeaths;

In[]:=

stateDists=ProbabilityDistribution[Abs[Interpolation[DeleteMissing[#["Path"],1,2],InterpolationOrder1][x]],{x,#["FirstTime"],#["LastTime"]},Method"Normalize"]&/@Normal[stateDeathsDerivatives];

In[]:=

stateMeans=DateObject[N@NExpectation[x,x#]]&/@stateDists;

In[]:=

stateStandardDevs=MapThread[UnitConvert[Quantity[N@Sqrt@NExpectation[(x-AbsoluteTime[#2])^2,x#1],"Seconds"],"Days"]&,{stateDists,stateMeans}];

In[]:=

stateMedians=#["Dates"][[FirstPosition[#["Values"],_?(GreaterThan[#["LastValue"]/2])][[1]]]]&/@Normal[stateDeaths];

In[]:=

The following shows all of the state curves sorted by mean (peak date):

Column[KeyValueMap[plotCurve,KeySortBy[Normal[stateDeathsDerivatives],stateMeans]]]

Out[]=

Like with the national curves, most of the high-mortality states either have an early peak or a late peak (California being a notable exception). There are, however, a number of smaller states which show flatter curves, but most of these show lower total mortality, and probably don’t affect the national aggregate curve as much.

Now we can look at how the means vary with geography:

GeoRegionValuePlotAbsoluteTime/@KeyMap[GeoVariant[#,"SimplifiedArea"]&,stateMeans],ImageSize1000,GeoRange

United States

COUNTRY

,ColorFunction(ColorData[{"RedBlueTones","Reversed"}][#]&),PlotLegendsNone

Out[]=

And the medians:

GeoRegionValuePlotAbsoluteTime/@KeyMap[GeoVariant[#,"SimplifiedArea"]&,stateMedians],ImageSize1000,GeoRange

United States

COUNTRY

,ColorFunction(ColorData[{"RedBlueTones","Reversed"}][#]&),PlotLegendsNone

Out[]=

And finally, the standard deviations:

GeoRegionValuePlotKeyMap[GeoVariant[#,"SimplifiedArea"]&,stateStandardDevs],ImageSize1000,GeoRange

United States

COUNTRY

,ColorFunction(ColorData[{"RedBlueTones","Reversed"}][#]&)

Out[]=

The North East and Midwest both had earlier peaks than in the South or West. The North East had sharp peaks, while the rest of the country had relatively flat peaks.

Conclusion

There are some issues with this kind of analysis, particularly because the weekly deaths curve is clipped at the present, and so statistics like the mean or median can be skewed because we don’t have the whole PDF. However, measures like these still give us a nice way of quantifying many of the properties of the weekly deaths curve that we care about.

We can also see that in most cases the the double peak that appears in aggregates disappears when we look at smaller regions. Finally, we can look at the distribution of national means and medians:

GraphicsRow[{DateHistogram[nationalMeans,"Week",PlotLabel"means"],DateHistogram[nationalMedians,"Week",PlotLabel"medians"]}]

Out[]=

Though both are a bit fuzzy, it does look like there are roughly two peaks: the countries that got COVID in April, and the countries that got COVID in June or August.

POSTED BY: Christopher Wolfram

Answer

5 Replies

Sort By:

Robert Nachbar

Robert Nachbar, Wolfram Research Inc.

Posted 6 months ago

Very nice deep dive into the data! I find it very curious that many of the national curves have very sharp, flat-topped "peaks" of about a week's duration. Do you know of an explanation for this feature? I suspect that they are reporting errors, and it would be useful to know their origin and appropriate data-cleaning techniques. I've been using ColorData for many years, and learned something new about it today: one can get the colors reversed directly with ColorData[{"RedBlueTones","Reversed"}][#]&

POSTED BY: Robert Nachbar

Answer

Moderation Team

Moderation Team, WOLFRAM

Posted 6 months ago

-- you have earned *Featured Contributor Badge* Your exceptional post has been selected for our editorial column *Staff Picks* http://wolfr.am/StaffPicks and Your Profile is now distinguished by a *Featured Contributor Badge* and is displayed on the Featured Contributor Board. Thank you!

POSTED BY: Moderation Team

Answer

Christopher Wolfram

Christopher Wolfram, WOLFRAM

Posted 6 months ago

Yes, I assume those plateaus are reporting errors of some kind. There are also some negative ones, which are even more suspect. About the ColorFunction, you also might think that ColorData[{"RedBlueTones","Reversed"}][#]& is equivalent to ColorData[{"RedBlueTones","Reversed"}] but `GeoRegionValuePlot` will bin the data if you use the second, but not if you use the first. I think it is much more useful to look at the unbinned data, so I often wrote this weird `ColorData[...][#]&` construct. I believe there is going to be an option to get around this in a future version.

POSTED BY: Christopher Wolfram

Answer

Sander Huisman

Sander Huisman, University of Twente

Posted 6 months ago

Isn't that really a bug though? those should be equivalent no? ColorData[{"RedBlueTones","Reversed"}][#]&[0.3] would evaluate to: ColorData[{"RedBlueTones","Reversed"}][0.3] so then, they are the same? Unless ColorData[…] is recognized in some special way of course…

POSTED BY: Sander Huisman

Answer

Christopher Wolfram

Christopher Wolfram, WOLFRAM

Posted 6 months ago

If the `ColorFunction` is of the form `ColorData[...]` it processes it differently from generalized functions. They are equivalent in general, but `GeoRegionValuePlot` treats them differently.

POSTED BY: Christopher Wolfram

Answer

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Group Abstract

Feedback