COVID-19 Analysis

Updated April 29, 2020

Introduction

I have been asked by several co-workers and others if I have looked at the data for COVID-19. This document is an attempt to look at that data at a fairly high level.

The data for this writeup is now coming from the Johns Hopkins data set.

https://github.com/CSSEGISandData/COVID-19

Note: RPubs doens’t seem to allow URLs. You will need to copy/pase the url into your browser.

The data is updated almost daily.

Loading the Data

The following loads the COVID-19 data.

rm(list=ls())
library(ggplot2)
library(data.table)
library(RCurl)

df_confirmed <- read.csv('time_series_covid_19_confirmed.csv')

Reshape the Data

The data in the dataset is a little difficult to work with. The next several code chunks arrange the data in such a way to make it easier to graph.

Fill in Empty Country Names

The dataset contains some countries without state or province names. In those cases, we’d like the state name to just be the same as the country name.

fill_missing_province <- function(df) {
  df[,1] <- as.character(df[,1])
  df[,2] <- as.character(df[,2])
  head(df_confirmed)
  for(i in seq(1,nrow(df))){
    if(as.character(df[i,1])==""){
      df[i,1] <- df[i,2]
    }
  }
  df[,1] <- as.factor(df[,1])
  df[,2] <- as.factor(df[,2])
  return(df)
}

df_confirmed <- fill_missing_province(df_confirmed)
head(df_confirmed)

Transpose the Data

We want the data to eventually be in a tibble (tall skinny table) to make it easier to graph.

# Rename rows...
extract_location <- function(df, cname, pname){
  country <- subset(df, df$Country.Region==cname)
  head(country)
  dfct <- data.frame(t(subset(country, country$Province.State==pname)))
  dfct <- tail(dfct, length(dfct)-5)
  names(dfct) <- c("count")
  dfct$count <- as.numeric(as.character(dfct$count))
  dfct$location = rep(paste(cname,"-",pname), nrow(dfct))
  dfct$sequence = seq(1,nrow(dfct))
  names(dfct)<- c('count','location','sequence')
  dfct <- dfct[c('sequence','location','count')]
  dfct$count <- as.integer(dfct$count)
  row.names(dfct) <- seq(1,nrow(dfct))
  return(dfct)
}

head(extract_location(df_confirmed, "US", "US"))

Shuffle the Data

Countries found their first case of the virus on different days. This code shuffles the data so that we can explore the growth curve for each country starting on the first day a case was reported in that location. This is their “day 0”.

shift_up <- function(df, column){
  idx = which(names(df)==column)
  while(df[1,idx]==0){
    first_row <- df[1,]
    for(i in seq(1, nrow(df)-1)){
      df[i,] <- df[i+1,]
    }
    df[nrow(df),] <- first_row
  }
  return(df)
}

test_df <- data.frame(as.integer(), as.character())
test_df <- rbind(test_df,data.frame(count=0,stuff='zero'))
test_df <- rbind(test_df,data.frame(count=0,stuff='zero'))
test_df <- rbind(test_df,data.frame(count=1,stuff='one'))
test_df <- rbind(test_df,data.frame(count=2,stuff='two'))
test_df <- rbind(test_df,data.frame(count=3,stuff='three'))
names(test_df) <- c('count','stuff')
test_df

shift_up(test_df, 'count')

NA

Remove Empty Values

In order to make the graphs cleaner, we delete all days that have a zero count value. This will prevent our trendlines from dropping to zero if we don’t have data.

remove_zeros <- function(df) {
  new_df = subset(df, df$count>0)
  return(new_df)
}

test_df <- data.frame(as.integer(), as.character())
test_df <- rbind(test_df,data.frame(count=0,stuff='zero'))
test_df <- rbind(test_df,data.frame(count=0,stuff='zero'))
test_df <- rbind(test_df,data.frame(count=1,stuff='one'))
test_df <- rbind(test_df,data.frame(count=2,stuff='two'))
test_df <- rbind(test_df,data.frame(count=3,stuff='three'))
names(test_df) <- c('count','stuff')
test_df

shift_df <- shift_up(test_df, 'count')
shift_df

clean_df <- remove_zeros(shift_df)
clean_df

Compute the Delta Column

Rather than calculating cumulative values, which never decline, I have opted to go for deltas. In other words, the number of cases that have changed since the previous day.

test_df <- data.frame(as.integer(), as.character())
test_df <- rbind(test_df,data.frame(count=5,stuff='zero'))
test_df <- rbind(test_df,data.frame(count=45,stuff='zero'))
test_df <- rbind(test_df,data.frame(count=112,stuff='one'))
test_df <- rbind(test_df,data.frame(count=209,stuff='two'))
test_df <- rbind(test_df,data.frame(count=783,stuff='three'))
names(test_df) <- c('count','stuff')

compute_delta <- function(df, colname){
  delta = data.frame(as.integer())
  delta <- rbind(delta,delta=0)
  c = which(names(df)==colname)
  for (r in seq(2,nrow(df))){
      delta <- rbind(delta, delta=(df[r,c] - df[r-1,c]))
  }
  names(delta) <- c('delta')
  df$delta <- delta$delta
  return(df)
}

test_df <- compute_delta(test_df, 'count')
test_df

get_location <- function(df_full, country, province) {
  df <- shift_up(extract_location(df_full, country,province), "count")
  df$sequence <- seq(1,nrow(df))
  df$count <- as.numeric(df$count)
  df <- remove_zeros(df)
  # Compute delta column
  df <- compute_delta(df, 'count')
  return(df)
}

Graphs

We will start with a set of places: United States, Iran, France, Spain, and Hubei, China, Taiwan and South Korea. This code creates a single dataframe that we can explore with various transforms of the data.

all_locations = data.frame(as.integer(), as.character(), as.integer(), as.integer())
names(all_locations) <- c("sequence", "location","count", "delta")

us <- get_location(df_confirmed, "US", "US")
iran <- get_location(df_confirmed, "Iran","Iran")
italy <- get_location(df_confirmed, "Italy", "Italy")
france <- get_location(df_confirmed, "France","France")
spain <- get_location(df_confirmed, "Spain","Spain")
china <- get_location(df_confirmed, "China","Hubei")
taiwan <- get_location(df_confirmed, "Taiwan*", "Taiwan*")
skorea <- get_location(df_confirmed, "Korea, South","Korea, South")

all_locations <- rbind(all_locations, us)
all_locations <- rbind(all_locations, iran)
all_locations <- rbind(all_locations, italy)
all_locations <- rbind(all_locations, france)
all_locations <- rbind(all_locations, spain)
all_locations <- rbind(all_locations, china)
all_locations <- rbind(all_locations, taiwan)
all_locations <- rbind(all_locations, skorea)

Raw Counts

Our first graph will be of confirmed case counts in the different areas of interest. Here we are graphing the raw number of new reported cases by days since “day 0”.

p <- ggplot(all_locations, aes(x=sequence, y=delta, colour=location, linetype=location)) +
  geom_line() +
  ggtitle("COVID19 New Cases")+xlab("Days After First Case")+ylab("New Cases")
p

On this graph, we see something interesting. several of the countries doesn’t seem to appear. Actually, you have to look really really close. Due to the scale, several of the lines hug the x-axis.

Square Root of Counts

In the next graph, we will plot the square root of the number of new cases for each of the countries. By doing so, we will be able to more easily see the smaller numbers.

p <- ggplot(all_locations, aes(x=sequence, y=sqrt(delta), colour=location, linetype=location)) +
  geom_line()+ggtitle("COVID-19 New Cases (Sqrt)")+xlab("Days After First Case")+ylab("New Cases sqrt(x)")
p

Here we see several of the countries just start to appears. The square root transform is not sufficient to really get a sense of the pattern. To do that we will move to a log scale.

Log Scale

In the next graph, we transform the number of cases by a natural log.

all_locations$logscale <- log(all_locations$delta)

NaNs produced

all_locations[all_locations<0] <-0
p <- ggplot(all_locations, aes(x=sequence, y=logscale, colour=location,  linetype=location)) +
  geom_line() + ggtitle("COVID-19 New Cases Natural Log")+xlab("Days After First Case")+ylab("New Cases ln(x)")
p

write.csv(all_locations, "all_locations.csv", row.names = FALSE)

A Few Words About the Data

In data science and statistics we frequently talk about sample bias. This data is a perfect example of that phenomenon. Only those that appear sick are tested for the virus Also, different countries and regions have differing inventory of test kits. Clearly, those areas that are performing more tests are going to find more people with the virus. The site https://ourworldindata.org/covid-testing has several graphs that display total tests by country and test per capita by country.

We are not looking at actual new cases in the graphs that I displayed, but a much smaller subset.

The virus takes 1-14 days before symptoms start to appear. The most common incubation period is around 5 days. (https://www.who.int/news-room/q-a-detail/q-a-coronaviruses) While it is possible to pass the virus on before being contageous, the virus is mainly spread by people that are symptomatic. (https://www.cdc.gov/coronavirus/2019-ncov/prepare/transmission.html)

Conclusion

COVID-19 presents an unprecident challenge to our society. It is a serious situation due to several factors including the risk it poses to the elderly and those with pre-existing health issues as well as the overall strain that it could pose to our healthcare system. A COVID-19 patient taking up a room in a hospital is one less bed that hospital has for people with other urgent healthcare needs.

While we should take this situation seriously, we should not panic. The US Centers for Disease Control, World Health Organizaton and many state and local departments of health and publich safety have valueable resources for us.

I have made every attempt to ensure that the numbers and data presented in this writeup are accurate based on the data that I could find. That said, it makes a great deal of sense to confirm any data you see on the internet with other sources such as the CDC and WHO.

Lastly, for more information, the CDC is a good place to start:

https://www.cdc.gov/coronavirus/2019-ncov/symptoms-testing/share-facts.html?CDC_AA_refVal=https%3A%2F%2Fwww.cdc.gov%2Fcoronavirus%2F2019-ncov%2Fabout%2Fshare-facts.html

Thanks, and stay healthy, and #flattenthecurve everyone.