Covid Tracker + Code

Was going to be just a basic update but I was feeling like the Coronavirus was pretty well in hand, as the growth rate has been slowing, and I decided to make a projection of the next 10 days assuming a 10% growth rate, which is about what we’ve had this past week. It’s really bad. I don’t think we’ll make 10% growth for 10 days, people are talking like growth will level off next week, but the upcoming stats are really important. R Code at bottom, you’ll have to download the data yourself.

Maps

Table

County Percent Capacity Used #Available ICU Beds Coronavirus Cases Estimated Hospitalizations Ten Day Projection
Alpine 100% 0 1 0.1 Inf%
Glenn 100% 0 2 0.2 Inf%
Mono 100% 1 20 2 518.7%
Plumas 100% 0 3 0.3 Inf%
San Benito 100% 2 33 3.3 428%
Sutter 100% 0 20 2 Inf%
San Mateo 67.8% 91 617 61.7 175.9%
Santa Cruz 63.3% 12 76 7.6 164.3%
Yolo 60.9% 11 67 6.7 158%
Nevada 56.7% 6 34 3.4 147%
Marin 55.2% 27 149 14.9 143.1%
Inyo 36.7% 3 11 1.1 95.1%
Imperial 35.7% 21 75 7.5 92.6%
Los Angeles 35.4% 2137 7573 757.3 91.9%
Santa Clara 32.2% 428 1380 138 83.6%
Riverside 31.7% 372 1179 117.9 82.2%
Santa Barbara 30% 76 228 22.8 77.8%
Contra Costa 28.5% 162 462 46.2 74%
Tulare 28% 60 168 16.8 72.6%
San Joaquin 27.6% 86 237 23.7 71.5%
San Diego 25.6% 598 1530 153 66.4%
Monterey 25.6% 27 69 6.9 66.3%
Alameda 23.5% 287 674 67.4 60.9%
San Luis Obispo 22.7% 45 102 10.2 58.8%
Placer 22.5% 52 117 11.7 58.4%
Ventura 21.9% 120 263 26.3 56.8%
San Francisco 21.3% 318 676 67.6 55.1%
Kern 20.1% 151 303 30.3 52%
Humboldt 20% 25 50 5 51.9%
Sonoma 19.7% 69 136 13.6 51.1%
Merced 19% 21 40 4 49.4%
Orange 16.7% 607 1016 101.6 43.4%
Sacramento 15.8% 368 580 58 40.9%
Solano 14.4% 78 112 11.2 37.2%
San Bernardino 13.4% 478 641 64.1 34.8%
Calaveras 12.5% 4 5 0.5 32.4%
Yuba 12.5% 12 15 1.5 32.4%
El Dorado 11.2% 26 29 2.9 28.9%
Stanislaus 10.9% 87 95 9.5 28.3%
Fresno 10.8% 145 156 15.6 27.9%
Amador 10% 3 3 0.3 25.9%
Colusa 10% 3 3 0.3 25.9%
Del Norte 6.7% 3 2 0.2 17.3%
Madera 6.7% 42 28 2.8 17.3%
Siskiyou 6.7% 6 4 0.4 17.3%
Napa 5.7% 44 25 2.5 14.7%
Lake 5% 6 3 0.3 13%
Kings 4% 20 8 0.8 10.4%
Shasta 3.8% 64 24 2.4 9.7%
Butte 3% 44 13 1.3 7.7%
Mendocino 2.9% 14 4 0.4 7.4%
Tehama 2.5% 4 1 0.1 6.5%
Tuolumne 2% 5 1 0.1 5.2%
Lassen 0% 0 0 0 0%
Mariposa 0% 0 0 0 0%
Modoc 0% 0 0 0 0%
Sierra 0% 0 0 0 0%
Trinity 0% 0 0 0 0%

Code

#Libraries
#https://rforpublichealth.blogspot.com/2015/10/mapping-with-ggplot-create-nice.html
library(ggplot2)
library(maptools)
library(rgeos)
library(ggmap)
library(scales)
library(RColorBrewer)

#https://stackoverflow.com/questions/6364783/capitalize-the-first-letter-of-both-words-in-a-two-word-string
#Make Function
simpleCap <- function(x) {
s <- strsplit(x, ” “)[[1]]
paste(toupper(substring(s, 1,1)), substring(s, 2),
sep=””, collapse=” “)
}

#Load all data
CABedCounts<-read.csv(“E:/CovidTracker/healthcare_facility_beds.csv”, stringsAsFactors = F)
MasterCountyList<-read.csv(“E:/CovidTracker/MasterCACountyList.csv”, stringsAsFactors = F)
LATimesCovidCount<-read.csv(“E:/CovidTracker/LATimesInfectionCount.csv”, stringsAsFactors = F)
CABedUtilization<-read.csv(“E:/CovidTracker/licensed-bed-classification-and-designations-trends.csv”, stringsAsFactors = F)

#Clean Infection Data
colnames(MasterCountyList)<-c(“County”, “Fips”)
colnames(LATimesCovidCount)<-c(“DownloadDate”, “County”, “Cases”, “Deaths”)
LATimesCovidCount$DownloadDate<-as.Date(LATimesCovidCount$DownloadDate, “%m/%d/%y”)
LATimesCovidCount<-LATimesCovidCount[LATimesCovidCount$DownloadDate==as.Date(“2020-04-8”), ]
LATimesCovidCount$Cases<-as.numeric(gsub(“,”, “”, LATimesCovidCount$Cases))
LATimesCovidCount
CovidCount<-merge(x=LATimesCovidCount, y=MasterCountyList, by.x=”County”, by.y=”County”, all.y=T)
#Fix Dates
CovidCount[is.na(CovidCount$DownloadDate), “DownloadDate”]<-Sys.Date()
CovidCount[is.na(CovidCount$Cases), “Cases”]<-0
CovidCount[is.na(CovidCount$Deaths), “Deaths”]<-0
CovidCount

#Clean Bed Count
CABedCounts<-subset(CABedCounts,
BED_CAPACITY_TYPE %in% c(“INTENSIVE CARE”, “ACUTE RESPIRATORY CARE”))
BedCountAgg<-aggregate(BED_CAPACITY~COUNTY_NAME, data=CABedCounts, sum)
BedCountAgg$COUNTY_NAME<-sapply(tolower(BedCountAgg$COUNTY_NAME), simpleCap)
MasterBedCount<-merge(x=BedCountAgg, y=MasterCountyList, by.x =”COUNTY_NAME”, by.y=”County”,
all.y=T)
MasterBedCount$BED_CAPACITY[is.na(MasterBedCount$BED_CAPACITY)]<-0

#Standard Bed Usage
CABedUtilization<-read.csv(“E:/CovidTracker/licensed-bed-classification-and-designations-trends.csv”, stringsAsFactors = F)
CABedUtilization<-CABedUtilization[, c(“Year”, “COUNTY”, “Licensed.Bed.Classification”, “License.Bed.Designation”, “Licensed.Bed.Day”)]
CABedUtilization<-subset(CABedUtilization,
CABedUtilization$License.Bed.Designation %in% c(“Intensive Care”, “Acute Respiratory Care”))
colnames(CABedUtilization)<-c(“Year”, “County”, “Licensed_Bed_Classification”, “License_Bed_Designation”, “Bed_Days”)
#For some reason, a lot of these have a space/ ‘ ‘ or ‘San Luis Obisp’
CABedUtilization$County<-trimws(CABedUtilization$County)
CABedUtilization$County[CABedUtilization$County==”San Luis Obisp”]<-“San Luis Obispo”
unique(CABedUtilization$County)

CA_County_Average<-aggregate(Bed_Days~County, CABedUtilization, mean)
CA_County_Average$Bed_Days<-floor(CA_County_Average$Bed_Days)
CA_County_Average$Beds_Used_per_year<-floor(CA_County_Average$Bed_Days/365)
colnames(CA_County_Average)<-c(“County”, “Average_Bed_Days_year”, “Average_beds_in_use”)

#Merge
Master<-merge(x=CovidCount, y=MasterBedCount, by.x=”County”,
by.y=”COUNTY_NAME”, all.x=T, all.y=T)
Master$County<-sapply(tolower(Master$County), simpleCap)
Master<-merge(x=Master, y=CA_County_Average, by.x=”County”, by.y=”County”, all.x=T, all.y=T)
Master$Average_Bed_Days_year[is.na(Master$Average_Bed_Days_year)]<-0
Master$Average_beds_in_use[is.na(Master$Average_beds_in_use)]<-0
Master$Adjusted_Bed_Capacity<-Master$BED_CAPACITY-Master$Average_beds_in_use
#Presuming 10% of patients need the IC
#https://www.washingtonpost.com/world/europe/coronavirus-in-italy-fills-hospital-beds-and-turns-doctors-into-patients/2020/03/03/60a723a2-5c9e-11ea-ac50-18701e14e06d_story.html
Master$PercentCapacityUsed<-((Master$Cases/10)/Master$Adjusted_Bed_Capacity)*100
Master$PercentCapacityUsed[Master$PercentCapacityUsed>10000]<-100

Master

#Assuming 10% growth
Master$TenDayProjection<-((Master$Cases*1.1^10)*0.1*100)/Master$Adjusted_Bed_Capacity

MasterPrint<-Master[order(Master$PercentCapacityUsed, decreasing = T), c(“County”, “PercentCapacityUsed”, “Adjusted_Bed_Capacity”, “Cases”, “TenDayProjection”)]
MasterPrint$EstimatedICUCases<-MasterPrint$Cases/10
MasterPrint<-MasterPrint[, c(“County”, “PercentCapacityUsed”, “Adjusted_Bed_Capacity”, “Cases”, “EstimatedICUCases”, “TenDayProjection”)]
MasterPrint$County<-sapply(MasterPrint$County, simpleCap)
MasterPrint$PercentCapacityUsed[is.nan(MasterPrint$PercentCapacityUsed)]<-0
MasterPrint$PercentCapacityUsed<-paste(as.character(round(MasterPrint$PercentCapacityUsed, 1)), “%”, sep=””)
MasterPrint$TenDayProjection[is.nan(MasterPrint$TenDayProjection)]<-0
MasterPrint$TenDayProjection<-paste(as.character(round(MasterPrint$TenDayProjection, 1)), “%”, sep=””)
colnames(MasterPrint)<-c(“County”, “Percent Capacity Used”, “#Available ICU Beds”, “Coronavirus Cases”, “Estimated Hospitalizations”, “Ten Day Projection”)
MasterPrint

write.csv(MasterPrint, “4-8-20DailyTable.csv”)

str(MasterPrint)

#map
#https://eriqande.github.io/rep-res-web/lectures/making-maps-with-R.html
#https://www.r-bloggers.com/choropleth-map-in-ggplot2/
#https://stackoverflow.com/questions/35090883/remove-all-of-x-axis-labels-in-ggplot
#https://stackoverflow.com/questions/16220812/how-do-i-change-the-na-color-from-gray-to-white-in-a-ggplot-choropleth-map
#https://www.december.com/html/spec/color2.html
#Green3
caMap<-map_data(“county”)
caMap<-caMap[caMap$region==”california”,]
Master$County<-tolower(Master$County)
Master$PercentCapacityUsed[Master$PercentCapacityUsed>100]<-100
Master$TenDayProjection[Master$TenDayProjection>100]<-100
masterCaMap<-merge(x=Master, y=caMap, by.x=”County”,
by.y=”subregion”)

ggplot(masterCaMap, aes(long, lat, group=group))+
geom_polygon(aes(fill=TenDayProjection), color=”black”)+
ggtitle(“Coronavirus ICU Bed Capacity, 10 Day Projection, 10% growth”)+
scale_fill_continuous(low=”#00CD00″, high=”darkred”, guide=”colorbar”, na.value=”white”, limits=c(0, 100))+
theme(axis.title.x=element_blank(),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.title.y=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank())

One thought on “Covid Tracker + Code

Leave a Reply

Your email address will not be published. Required fields are marked *