Message Boards

Answer (Unmark)

Mark as an Answer

GROUPS:

Richard Frost

Visualization of Cumulative Covid-19 Deaths: US, States, CA Counties

Richard Frost, Frost Concepts

Posted 2 years ago

1466 Views

0 Replies

2 Total Likes

Follow this post

enter image description here

Covid-19 : US, US States, and CA counties
Author, Richard Frost - http://tangentvectors.org/
Use at your own risk.

======= INITIALIZATIONS =======

In[]:=

dateFormat="yyyy/mm/dd";

In[]:=

dateTickFormat={"MonthShort","/","Day"};

In[]:=

onePerson=Quantity[1,"People"];

In[]:=

oneDay=

day

;

In[]:=

iSize=512;

In[]:=

hyperEpidemicMagnitude=0.04;

In[]:=

hyperEpidemicLevel=Quantity[hyperEpidemicMagnitude,"Percent"];

In[]:=

hyperEpidemicLevelInf=hyperEpidemicLevel-Quantity[0.01,"Percent"];

======= INPUT DATA =======

----- Covid-19 deaths -----

In[]:=

analysisURL="http://tangentvectors.org";

In[]:=

dataSourcesURL="http://tangentvectors.org/DataSources.csv";

In[]:=

dataSourcesTable=Import[dataSourcesURL];

In[]:=

dataSourcesTable//Grid

Out[]=

Data	Source	Source Data URL
Historic US	The COVID Tracking Project	https://covidtracking.com/api/v1/us/daily.csv
Historic US State	The COVID Tracking Project	https://covidtracking.com/api/v1/states/daily.csv
Historic CA County	California Health and Human Services	https://data.chhs.ca.gov/dataset/6882c390-b2d7-4b9a-aefa-2068cee63e47/resource/6cd8d424-dfaa-4bdd-9410-a3d656e1176e/download/covid19data.csv

In[]:=

USdeathsCreditsText="Data Source: "<>dataSourcesTable[[2,2]]<>" "<>"Data Analysis: "<>analysisURL;

In[]:=

USdeathsCreditsStyledText=Style[Text[USdeathsCreditsText],Black,Small];

In[]:=

USdeathsCredits=Graphics[USdeathsCreditsStyledText,ImageSize{384,12}]

Out[]=

In[]:=

CAdeathsCreditsText="Data Source: "<>dataSourcesTable[[4,2]]<>" "<>"Data Analysis: "<>analysisURL;

In[]:=

CAdeathsCreditsStyledText=Style[Text[CAdeathsCreditsText],Black,Small];

In[]:=

CAdeathsCredits=Graphics[CAdeathsCreditsStyledText,ImageSize{416,12}]

Out[]=

In[]:=

USdataURL=dataSourcesTable[[2,3]];

In[]:=

USrevDataTable=Import[USdataURL];

In[]:=

USdataHeader=USrevDataTable[[1]]

Out[]=

{date,states,positive,negative,pending,hospitalizedCurrently,hospitalizedCumulative,inIcuCurrently,inIcuCumulative,onVentilatorCurrently,onVentilatorCumulative,recovered,dateChecked,death,hospitalized,lastModified,total,totalTestResults,posNeg,deathIncrease,hospitalizedIncrease,negativeIncrease,positiveIncrease,totalTestResultsIncrease,hash}

In[]:=

CTPdateHeader="date";

In[]:=

CTPdeathHeader="death";

In[]:=

USrawDataTable=Reverse[USrevDataTable[[2;;]]];

In[]:=

Take[USrawDataTable,1]

Out[]=

{{20200122,1,1,,,,,,,,,,2020-01-22T00:00:00Z,,,2020-01-22T00:00:00Z,1,1,1,0,0,0,0,0,615132d06fd9e22bc21b1b3ec47fb9b2a0de0734}}

In[]:=

StatesDataURL=dataSourcesTable[[3,3]];

In[]:=

StatesRevDataTable=Import[StatesDataURL];

In[]:=

StatesDataHeader=StatesRevDataTable[[1]]

Out[]=

{date,state,positive,negative,pending,hospitalizedCurrently,hospitalizedCumulative,inIcuCurrently,inIcuCumulative,onVentilatorCurrently,onVentilatorCumulative,recovered,dataQualityGrade,lastUpdateEt,dateModified,checkTimeEt,death,hospitalized,dateChecked,fips,positiveIncrease,negativeIncrease,total,totalTestResults,totalTestResultsIncrease,posNeg,deathIncrease,hospitalizedIncrease,hash,commercialScore,negativeRegularScore,negativeScore,positiveScore,score,grade}

In[]:=

CTPstateHeader="state";

In[]:=

StatesRawDataTable=Reverse[StatesRevDataTable[[2;;]]];

In[]:=

Take[StatesRawDataTable,1]

Out[]=

{{20200122,WA,1,,,,,,,,,,,,,,,,,53,0,0,1,1,0,1,0,0,3f9b3067fb6e1b79d174e867e388ae24d90de6e3,0,0,0,0,0,}}

In[]:=

CAcountiesDataURL=dataSourcesTable[[4,3]];

In[]:=

CAcountiesRawData=Import[CAcountiesDataURL];

In[]:=

CAcountiesDataHeader=CAcountiesRawData[[1]]

Out[]=

{County Name,Most Recent Date,Total Count Confirmed,Total Count Deaths,COVID-19 Positive Patients,Suspected COVID-19 Positive Patients,ICU COVID-19 Positive Patients,ICU COVID-19 Suspected Patients}

In[]:=

CHHScountNameHeader="County Name";

In[]:=

CHHSdateHeader="Most Recent Date";

In[]:=

CHHSdeathHeader="Total Count Deaths";

In[]:=

CAcountiesRawDataTable=CAcountiesRawData[[2;;]];

In[]:=

Take[CAcountiesRawDataTable,3]//Grid

Out[]=

Los Angeles	4/1/2020	3502	66	739	1332	335	220
San Bernardino	4/1/2020	245	5	95	196	39	52
Orange	4/1/2020	579	11	117	221	50	48

----- Population data -----

In[]:=

USpopulationsURL="http://tangentvectors.org/USPopulations.csv";

In[]:=

USpopTable=Import[USpopulationsURL];

In[]:=

Take[USpopTable,3]//Grid

Out[]=

Entity	Population
US	331818309
AK	731545

In[]:=

USpopHash=CreateDataStructure["HashTable"];

In[]:=

Do[USpopHash["Insert",USpopTable[[n,1]]USpopTable[[n,2]]],{n,2,Length[USpopTable]}];

In[]:=

CApopulationsURL="http://tangentvectors.org/CAPopulations.csv";

In[]:=

CApopTable=Import[CApopulationsURL];

In[]:=

Take[CApopTable,3]//Grid

Out[]=

County	Population
Alameda	1669301
Alpine	1162

In[]:=

CApopHash=CreateDataStructure["HashTable"];

In[]:=

Do[CApopHash["Insert",CApopTable[[n,1]]CApopTable[[n,2]]],{n,2,Length[CApopTable]}];

----- CA phased openings -----

In[]:=

CAPhaseDatesURL="http://tangentvectors.org/CAPhaseDates.csv";

In[]:=

CAPhaseDatesCSVTable=Import[CAPhaseDatesURL];

In[]:=

CAPhaseDatesTable={#[[1]],DateObject[#[[2]]]}&/@CAPhaseDatesCSVTable;

In[]:=

CAPhaseDatesTable//Grid

Out[]=

Phase 1	Day: Thu 19 Mar 2020
Phase 2	Day: Fri 8 May 2020
Phase 3	Day: Tue 26 May 2020

In[]:=

nonPhase3countiesMayURL="http://tangentvectors.org/CANonPhase3CountiesMay.csv";

In[]:=

nonPhase3countiesMayTable=Import[nonPhase3countiesMayURL];

In[]:=

nonPhase3countiesMayList=nonPhase3countiesMayTable[[4,2]]

Out[]=

Alameda, Contra Costa, Imperial, Los Angeles, Marin, Monterey, San Francisco, San Mateo, Santa Clara, Santa Cruz

======= US ANALYSIS =======

----- establish current data -----

In[]:=

USdateI=Table[If[USdataHeader[[m]]CTPdateHeader,m,Nothing],{m,1,Length[USdataHeader]}][[1]]

Out[]=

In[]:=

USdeathI=Table[If[USdataHeader[[m]]CTPdeathHeader,m,Nothing],{m,1,Length[USdataHeader]}][[1]]

Out[]=

DateObject[“string”] prefers “yyyy/mm/dd”

In[]:=

USdeathsAllDates=Sort[Table[{DateObject[StringTake[#,4]<>"/"<>StringTake[StringTake[#,-4],2]<>"/"<>StringTake[#,-2]&[IntegerString[USrawDataTable[[n,USdateI]]]]],Quantity[USrawDataTable[[n,USdeathI]],"People"]},{n,1,Length[USrawDataTable]}]];

In[]:=

Take[USdeathsAllDates,1]//InputForm

Out[]//InputForm=

{{DateObject[{2020, 1, 22}, Day, Gregorian, -7.], Quantity[, People]}}

In[]:=

USdataNullTable=Table[If[QuantityMagnitude[USdeathsAllDates[[n,2]]]"",{n,USdeathsAllDates[[n,1]]},Nothing],{n,1,Length[USdeathsAllDates]}];

In[]:=

Take[USdataNullTable,3]

Out[]=

1,

Day: Wed 22 Jan 2020

,2,

Day: Thu 23 Jan 2020

,3,

Day: Fri 24 Jan 2020



In[]:=

If[Length[USdataNullTable]0,USdata1stNonNullI=1,USdata1stNonNullI=Max[#[[1]]&/@USdataNullTable]+1]

Out[]=

In[]:=

USxOrigin=USdeathsAllDates[[USdata1stNonNullI-2,1]]

Out[]=

Day: Mon 24 Feb 2020

In[]:=

USdataAllDatesTail=USdata1stNonNullI-Length[USdeathsAllDates]-1;

In[]:=

USdeathsTable=Take[USdeathsAllDates,USdataAllDatesTail];

In[]:=

Take[USdeathsTable,1]

Out[]=



Day: Wed 26 Feb 2020

people



In[]:=

USdataStartDate=USdeathsTable[[1,1]];

In[]:=

USdataDay0=USdataStartDate-oneDay;

In[]:=

USdeathsTableCount=Length[USdeathsTable]

Out[]=

102

In[]:=

USdeathsDateHash=CreateDataStructure["HashTable"];

In[]:=

Do[USdeathsDateHash["Insert",USdeathsTable[[i,1]]i],{i,1,USdeathsTableCount}];

----- compute extrapolations -----

--- goals ---

In[]:=

USdeltaGoal=

100

people

;

In[]:=

USgoalDate=DateObject[{2020,8,1}];

In[]:=

USlatestDate=USdeathsTable[[USdeathsTableCount,1]]

Out[]=

Day: Sat 6 Jun 2020

In[]:=

latestDaysTillGoal=USgoalDate-USlatestDate

Out[]=

days

In[]:=

extrapolationCount=QuantityMagnitude[latestDaysTillGoal];

In[]:=

indexedGoalDates=Tablen,USdataDay0+

days

,{n,USdeathsTableCount+1,USdeathsTableCount+QuantityMagnitude[latestDaysTillGoal]};

--- trend data ---

In[]:=

UStrendDate0=

Day: Sun 24 May 2020

;

In[]:=

UStrendi0=USdeathsDateHash["Lookup",UStrendDate0];

In[]:=

UStrendData=Table[{n,QuantityMagnitude[USdeathsTable[[n,2]]]},{n,UStrendi0,USdeathsTableCount}];

--- linear fit ---

In[]:=

UStrendLinearFit=LinearModelFit[UStrendData,x,x]

Out[]=

FittedModel

7853.38+943.404x



In[]:=

UStrendBeta1=UStrendLinearFit["BestFitParameters"][[2]];

In[]:=

USlinearExtrapolation=Table[{indexedGoalDates[[m,2]],UStrendLinearFit[indexedGoalDates[[m,1]]]},{m,1,extrapolationCount}];

--- geometric decay ---

10^(log10(ΔGoal/Δdeaths

)/(daysTillGoal-1))

In[]:=

USlatestDeltaDeaths=Abs[USdeathsTable[[USdeathsTableCount,2]]-USdeathsTable[[USdeathsTableCount-1,2]]];

In[]:=

UStrendDecay=10^(Log10[QuantityMagnitude[USdeltaGoal]/QuantityMagnitude[USlatestDeltaDeaths]]/(QuantityMagnitude[latestDaysTillGoal]));

In[]:=

UStrendDecay//N

Out[]=

0.964751

In[]:=

USgeoDeltaExtrapolation=USlinearExtrapolation;

In[]:=

USgeoDeltaExtrapolation[[1,2]]=USlatestDeltaDeaths*UStrendDecay;

In[]:=

Do[USgeoDeltaExtrapolation[[m,2]]=(USgeoDeltaExtrapolation[[m-1,2]]*UStrendDecay),{m,2,extrapolationCount}];

In[]:=

USgeoDeltaExtrapolation[[extrapolationCount,2]]

Out[]=

100

people

In[]:=

USgeoExtrapolation=USgeoDeltaExtrapolation;

In[]:=

USgeoExtrapolation[[1,2]]=USdeathsTable[[USdeathsTableCount,2]];

In[]:=

Do[USgeoExtrapolation[[m,2]]=USgeoExtrapolation[[m-1,2]]+USgeoDeltaExtrapolation[[m-1,2]],{m,2,extrapolationCount}];

In[]:=

USgeoExtrapolation[[extrapolationCount,2]]//N

Out[]=

121528.

people

----- make the graph -----

In[]:=

USdeathsTitle=Style["US Covid-19 Deaths",Black,Medium,Bold];

In[]:=

USdeathsAspectRatio=1/2;

In[]:=

USdeathsG=DateListPlot[{Legended[USdeathsTable,"cumulative total"],Legended[USlinearExtrapolation,"if current rate continues"],Legended[USgeoExtrapolation,"if rate reduces to "<>ToString[USdeltaGoal]<>"/day by "<>DateString[USgoalDate,"ISODate"]]},Joined{False,True,True},PlotStyle{Red,{Orange,Dashed,Thick},{Blue,Dashed,Thick}},AxesOrigin{USxOrigin,0},AxesLabelNone,Ticks{Automatic,Automatic},DateTicksFormatdateTickFormat,AxesStyle{{Black,Medium},{Black,Medium}},GridLinesAutomatic,PlotLabelUSdeathsTitle,AspectRatioUSdeathsAspectRatio,FrameNone,ImageSizeiSize];

In[]:=

GraphicsColumn[{USdeathsG,USdeathsCredits},ImageSizeiSize*17/16]

Out[]=

======= US STATES ANALYSIS =======

----- establish current data -----

In[]:=

StatesDateI=Table[If[StatesDataHeader[[m]]CTPdateHeader,m,Nothing],{m,1,Length[StatesDataHeader]}][[1]];

In[]:=

StatesStateI=Table[If[StatesDataHeader[[m]]CTPstateHeader,m,Nothing],{m,1,Length[StatesDataHeader]}][[1]];

In[]:=

StatesKeys=If[USpopHash["KeyExistsQ",#],#,Nothing]&/@Sort[DeleteDuplicates[#[[StatesStateI]]&/@StatesRawDataTable]]

Out[]=

{AK,AL,AR,AS,AZ,CA,CO,CT,DC,DE,FL,GA,GU,HI,IA,ID,IL,IN,KS,KY,LA,MA,MD,ME,MI,MN,MO,MP,MS,MT,NC,ND,NE,NH,NJ,NM,NV,NY,OH,OK,OR,PA,PR,RI,SC,SD,TN,TX,UT,VA,VI,VT,WA,WI,WV,WY}

In[]:=

StatesKeysCount=Length[StatesKeys];

In[]:=

StatesIndexHash=CreateDataStructure["HashTable"];

In[]:=

Do[StatesIndexHash["Insert",StatesKeys[[s]]s],{s,1,StatesKeysCount}];

In[]:=

StatesDeathI=Table[If[StatesDataHeader[[m]]CTPdeathHeader,m,Nothing],{m,1,Length[StatesDataHeader]}][[1]];

In[]:=

StatesAllDates=Table[{StatesKeys[[s]],Sort[Table[If[StatesRawDataTable[[n,StatesStateI]]≠StatesKeys[[s]],Nothing,{DateObject[StringTake[#,4]<>"/"<>StringTake[StringTake[#,-4],2]<>"/"<>StringTake[#,-2]&[IntegerString[StatesRawDataTable[[n,StatesDateI]]]]],Quantity[StatesRawDataTable[[n,StatesDeathI]],"People"]}],{n,1,Length[StatesRawDataTable]}]]},{s,1,StatesKeysCount}];

Next find the 1st non-zero dates for each state. Start with StatesNullTable

In[]:=

StatesNonNullI=Table[{StatesAllDates[[s,1]],If[Length[#]0,1,Max[#]+1]&[Table[If[QuantityMagnitude[StatesAllDates[[s,2,n,2]]]"",n,Nothing],{n,1,Length[StatesAllDates[[s,2]]]}]],Length[StatesAllDates[[s,2]]]},{s,1,StatesKeysCount}];

In[]:=

StatesData=Table[Take[StatesAllDates[[s,2]],StatesNonNullI[[s,2]]-StatesNonNullI[[s,3]]-1],