library(lubridate)
library(COVID19)
library(tidyverse)
library(gghighlight)
library(plotly)
library(dygraphs)
library(xts)


gmr <- "https://www.gstatic.com/covid19/mobility/Global_Mobility_Report.csv"
d  <- covid19(country="USA",gmr = gmr, level=2)
d %>% filter(!is.na(retail_and_recreation_percent_change_from_baseline)) ->d
d %>% group_by(administrative_area_level_2) -> d
d %>%arrange(date) %>% mutate(New_cases = confirmed - lag(confirmed, default = first(confirmed))) -> d
d %>% mutate(New_deaths = deaths - lag(deaths, default = first(deaths))) %>% arrange(deaths) -> d

Visits to retail and recreation

The google mobility data may be a guide to how effectively the population of a state have implemented social distancing. Find the two most extreme states over the time series. These are South Dakota and Hawaii (exclude Washington DC).

sts <- c("Hawaii", "South Dakota")

ggplot(d,aes(x=date,y=retail_and_recreation_percent_change_from_baseline, colour=administrative_area_level_2, show.legend = FALSE), show.legend = FALSE)  +geom_line() + gghighlight(administrative_area_level_2 %in% sts)

New cases per million

sts <- c("Hawaii", "South Dakota")

ggplot(d,aes(x=date,y=1000000*New_cases/population, colour=administrative_area_level_2, show.legend = FALSE), show.legend = FALSE)  +geom_line() + gghighlight(administrative_area_level_2 %in% sts)

d %>% filter(administrative_area_level_2 %in% sts) -> d1
d1 <- data.frame(admin=d1$administrative_area_level_2,date=d1$date,New_cases=d1$New_cases/(d1$population/1000000))
d1 %>% pivot_wider(names_from = 1, values_from =3) ->d1
d1<-xts(x = d1[,2:3], order.by = d1$date)

dygraph(d1, ylab="Daily cases per million") %>% dyRoller(rollPeriod = 7)

Total deaths against mean change in mobility

Plot of the total death toll per state dvided by its population against the the mean change in mobility over the time frame. Hover on ponit to see names and values.

d %>% group_by(administrative_area_level_2) %>% summarise(mobility=mean(retail_and_recreation_percent_change_from_baseline), deaths_per_100k = 100000*max(deaths)/max(population)) -> dd



ggplot(dd[dd$mobility>-40,],aes(y=deaths_per_100k, x=mobility, label=administrative_area_level_2)) +geom_point() + geom_smooth(method="lm") +ylab("Daeths per 100k") +xlab("Mean change in mobility to retail and recreation")-> g1
ggplotly(g1)

The results are rather ambiguous. Interpret them as you will.

Some key states

sts <- c("New York", "Florida", "Texas", "California")

ggplot(d,aes(x=date,y=retail_and_recreation_percent_change_from_baseline, colour=administrative_area_level_2, show.legend = FALSE), show.legend = FALSE)  +geom_line() + gghighlight(administrative_area_level_2 %in% sts)

New cases per million

ggplot(d,aes(x=date,y=1000000*New_cases/population, colour=administrative_area_level_2, show.legend = FALSE), show.legend = FALSE)  +geom_line() + gghighlight(administrative_area_level_2 %in% sts)

d %>% filter(administrative_area_level_2 %in% sts) -> d1
d1 <- data.frame(admin=d1$administrative_area_level_2,date=d1$date,New_cases=d1$New_cases/(d1$population/1000000))
d1 %>% pivot_wider(names_from = 1, values_from =3) ->d1
d1<-xts(x = d1[,2:5], order.by = d1$date)

dygraph(d1, ylab="Daily cases per million") %>% dyRoller(rollPeriod = 7)