Message Boards

GROUPS:

Staff Picks Biological Sciences Data Science Medical Sciences Curated Data Graphics and Visualization Wolfram Language Statistics and Probability Machine Learning

Mads Bahrami

COVID19 data visualization across US counties

Mads Bahrami, Wolfram Research Inc

Posted 2 years ago

4962 Views

4 Replies

7 Total Likes

Follow this post

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

enter image description here

I briefly explore some viz for daily COVID19 cases (weakly-averaged time series) across US counties. The distribution of data (as, e.g., histogram) in time show an interesting trend toward heavy tail distributions, that could be used for developing some predictive measures (which I will explore in another essay).

Clear the cached data, if any:

In[]:=

DeleteObject[ResourceObject["Epidemic Data for Novel Coronavirus COVID-19"]]

Get data from Wolfram Function Repository:

In[]:=

ds0=ResourceData["Epidemic Data for Novel Coronavirus COVID-19","USCounties"];

Column tags:

In[]:=

ds0[1]//Keys//Normal

Out[]=

{State,County,GeoPosition,ConfirmedCases,Deaths}

A peek into dataset:

In[]:=

ds0[{1,2000}]

Out[]=

Contents cannot be rendered at this time; please try again later

Histogram of US counties populations:

In[]:=

ds0[Histogram@DeleteMissing@EntityValue[#,"Population"]&,"County"]

Out[]=

Contents cannot be rendered at this time; please try again later

1/4, 1/2, and 3/4 of US counties population data:

In[]:=

ds0[Quantile[DeleteMissing@EntityValue[#,"Population"],{.25,.5,.75}]&,"County"]

Out[]=

Although most viz calculate the COVID19 confirmed cases per 10,000 or 100,000 inhabitants, I think it is more convenient to consider a number close to 1/2 quantile. So I shall take cases per 30k inhabitants.

Return a list of {{counties},{ weekly averaged timeseries of cases}}:

In[]:=

dt=ds0All,#County,

MovingAverage[#ConfirmedCases,

]

QuantityMagnitude[#County["Population"]]/30000

&[Select[FreeQ[_Missing]]]//Normal//Transpose;

dates in dataset

In[]:=

dates=dt〚2,1〛["Dates"];

In[]:=

MinMax[dates]

Out[]=



Wed 29 Jan 2020 00:00:00GMT-7.

Tue 17 Nov 2020 00:00:00GMT-7.



How many days of data?

In[]:=

DateRange@@%//Length

Out[]=

294

How many months?

In[]:=

DateRange[Sequence@@%%,"Month"]//Length

Out[]=

Yike! 10 months of tracking COVID19 data!!

Put all values for all counties into a TemporalData (why? b/c it will be easier to call data later, you will see soon), then map Differences to get daily cases:

In[]:=

dailyCases=Differences@TemporalData[#["Values"]&/@dt〚2〛,{dates}];

Now using dailyCases[“SliceData”,date] we can call the covid19 daily cases for all US counties. Beauty of functional programming in WL!

For all dates, get the daily cases for all counties and return a histogram:

In[]:=

list=Histogram[dailyCases["SliceData",#],{0,100,1},"Intensity",(*PlotRange{0,.3},*)FrameTrue,FrameLabel{"ConfirmedCases Per 30,000 Inhabitants","Intensity"},PlotLabelDateString[#,{"MonthName"," ","Day",", ","Year"}],ImageSizeMedium]&/@dates〚2;;〛;

Find the underlying distribution from the data:

In[]:=

dist=FindDistribution/@(dailyCases["SliceData",#]&/@dates〚2;;〛);

In[]:=

Flatten[dist]/.MixtureDistribution[_,{x_,y_}](Head/@{x,y})//Flatten//Counts//ReverseSort

Out[]=

NormalDistribution205,CauchyDistribution174,LogNormalDistribution75,WaringYuleDistribution[1571.5]41,LogisticDistribution36,LaplaceDistribution2,FrechetDistribution[3.21159,16.3345,-10.5651]1,FrechetDistribution[3.21564,15.724,-10.213]1,ExtremeValueDistribution[2.83812,3.24127]1,PoissonDistribution[0.0031837]1,PoissonDistribution[0.00222859]1,PoissonDistribution[0.00159185]1

Animate viz of histograms:

In[]:=

ListAnimate[list,10,AnimationRepetitions1]

Out[]=

Contents cannot be rendered at this time; please try again later

Geo viz

Now lets visualize it over county polygons. I am sure you have seen such a GIF many times, even I made one some months ago, but let’s explore it.

Define colors and bins used in the visualization.

In[]:=

colors=(*Blend[{Green,Red},#]*)Blend

,#&/@Range[0,1,1/11];bins=Range[0,50,5];cfunc[x_]:=Which@@Riffle[Join[x≤#&/@bins,{x>Last[bins]}],colors];

Define the legend used based on colors and bins:

legend=BarLegend[{colors,MinMax[bins]},bins,LegendLayout"Column",LegendLabel"Daily Cases per 30k ppl",LegendMarkerSize200]

Out[]=

Daily Cases per 30k ppl

Contents cannot be rendered at this time; please try again later

Geo-visualize counties with colors proportional to cases per 30k inhabitant:

In[]:=

geoViz[day_]:=Module{data,continentalCounties,alaskaCounties,hawaiiCounties},data=Transpose[{dailyCases["SliceData",day],dt〚1〛}];continentalCounties=Selectdata,MemberQFlatten

Continental US states

ADMINISTRATIVE DIVISIONS



subdivisions

,#2&;alaskaCounties=Selectdata,MemberQEntityList@

US boroughs in Alaska

ADMINISTRATIVE DIVISIONS

,#2&;hawaiiCounties=Selectdata,MemberQEntityList@

US counties in Hawaii

ADMINISTRATIVE DIVISIONS

,#2&;GeoGraphics[{{GeoStyling[FaceForm[cfunc[#1]],EdgeForm[]],Polygon[#2]}&@@@continentalCounties,Inset[GeoGraphics[{{GeoStyling[FaceForm[cfunc[#1]],EdgeForm[]],Polygon[#2]}&@@@alaskaCounties},GeoBackgroundNone],Scaled[{0.0,0.0}],Scaled[{0.2,0.2}],Scaled[{0.5,0.5}]],Inset[GeoGraphics[{{GeoStyling[FaceForm[cfunc[#1]],EdgeForm[]],Polygon[#2]}&@@@hawaiiCounties},GeoBackgroundNone],Scaled[{0.3,0.1}],{Center,Center},Scaled[{0.2,0.2}]],Inset[legend,Scaled[{.15,1}],{Right,Top},Automatic]},GeoBackgroundNone,ImageSize600,PlotLabelDateString[day,{"MonthName"," ","Day",", ","Year"}]]

Geo-viz 4 random days:

In[]:=

geoViz/@Sort[RandomSample[dates〚2;;〛,4]]//Multicolumn

Out[]=

Contents cannot be rendered at this time; please try again later

Sorry, next step is kind of time-consuming

In[]:=

geoImageList=geoViz/@dates〚2;;〛;//AbsoluteTiming

Out[]=

{11774.8,Null}

In[]:=

Export[NotebookDirectory[]<>"GeoImagesdCOVID19.m",geoImageList]

Out[]=

/Users/mohammadb/Nextcloud/Mads/Exploration/COVID19/Epidemic/GeoImagesdCOVID19.m

GIF

In[]:=

Export[NotebookDirectory[]<>"animationUSA.gif",list,"DisplayDurations".3,AnimationRepetitions100]

In[]:=

Export[NotebookDirectory[]<>"animationGeoUSA.gif",geoImageList,"DisplayDurations".3,AnimationRepetitions100]

Acknowledgment

Diego Zviovich has developed a very interesting GIF on COVID19 spread across US. For plotting lower 48 US states with Alaska and Hawaii, I borrowed some ideas from Arnoud Buzing (WRI).

POSTED BY: Mads Bahrami

4 Replies

Sort By:

Tim Laska

Tim Laska, A Priori, Ltd

Posted 2 years ago

I am having trouble with the second input cell ($Version=12.1.1 for Microsoft Windows (64-bit) (June 19, 2020). Any suggestions? Thanks! ds0 = ResourceData["Epidemic Data for Novel Coronavirus COVID-19", "USCounties"]; ResourceObject::apierr: The requested element has not been imported.

POSTED BY: Tim Laska

Mads Bahrami

Mads Bahrami, Wolfram Research Inc

Posted 2 years ago

Try again. It may happen before the content is fully deployed from WRI side. Let me know if you see it again

POSTED BY: Mads Bahrami

Tim Laska

Tim Laska, A Priori, Ltd

Posted 2 years ago

Thank you for your help! It has evaluated up to "Sorry, next step is kind of time-consuming." So, the problem has been fixed.

POSTED BY: Tim Laska

Moderation Team

Moderation Team, WOLFRAM

Posted 2 years 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

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Group Abstract

Feedback

Enable JavaScript to interact with content and submit forms on Wolfram websites. Learn how »