movilidad_muertes.R

library(data.table)
library(magrittr)
library(ggplot2)


url_movility <- "https://raw.githubusercontent.com/githubmg/reduccion_movilidad/master/data/Global_Mobility_Report.csv"
url_deaths <- "https://raw.githubusercontent.com/githubmg/reduccion_movilidad/master/data/time_series_covid19_deaths_global.csv"


mov <- fread(url_movility) %>% 
  .[, date := as.Date(date)]

mov_mean_country <- mov %>% 
  copy() %>% 
  .[, country_region_code := NULL] %>% 
  melt(id.vars = c("date", "country_region", "sub_region_1", "sub_region_2")) %>% 
  .[, .(movility = mean(value, na.rm = TRUE)), 
    by = .(date, variable, country = country_region)] %>% 
  .[, variable := gsub("_percent_change_from_baseline", "", variable)] 


lab_mov <- c("Negocios y recreación", 
             "Mercados y farmacias", 
             "Parques", 
             "Estaciones de tránsito", 
             "Lugares de trabajo", 
             "Residencial")
names(lab_mov) <- unique(mov_mean_country$variable)


mov_mean_country  %>%   
  ggplot(aes(date, movility)) +
  geom_line(aes(group = country), alpha = 0.1) +
  scale_y_continuous("Índice de movilidad de Google") +
  scale_x_date("Fecha") +
  facet_wrap(~variable, labeller = labeller(variable = lab_mov)) +
  theme_minimal(base_size = 16)


deaths <- fread(url_deaths) %>% 
  setnames(c("Lat", "Long", "Country/Region", "Province/State"), 
           c("lat", "lon", "country", "province")) %>% 
  melt(id.vars = c("lat", "lon", "country", "province"), 
       variable.name = "date", value.name = "deaths") %>% 
  .[, date := lubridate::mdy(date)]


total_deaths_country <- deaths[, .(deaths = sum(deaths)), by = .(date, country)]


total_deaths_country %>% 
  copy() %>% 
  .[deaths >= 20] %>% 
  ggplot(aes(date, deaths)) +
  geom_line(aes(group = country), alpha = 0.4) +
  scale_y_log10("Cantidad de muertes") +
  scale_x_date("Fecha") +
  theme_minimal(base_size = 16)



linear <- function(x) {
  fit <- metR::FitLm(x, t = seq_along(x))
  fit$estimate[2]
}


linear_se <- function(x) {
  fit <- metR::FitLm(x, t = seq_along(x), se = TRUE)
  fit$std.error[2]
}

lags <- seq(-4, -22, by = -2)


datos <- total_deaths_country %>% 
  .[deaths >= 20] %>% 
  .[, ":="(ddeaths = frollapply(log(deaths), 7, FUN = linear, align = "center")),
    by = .(country)]

datos %>% 
  copy() %>% 
  .[deaths >= 20] %>% 
  ggplot(aes(date, exp(ddeaths))) +
  geom_line(aes(group = country), alpha = 0.4) +
  scale_y_log10("Tasa de crecimiento de muertes") +
  scale_x_date("Fecha") +
  theme_minimal(base_size = 16)



mov_mean_country <- mov %>% 
  copy() %>% 
  .[, country_region_code := NULL] %>% 
  melt(id.vars = c("date", "country_region", "sub_region_1", "sub_region_2")) %>% 
  .[, .(movility = mean(value, na.rm = TRUE)), 
    by = .(date, variable, country = country_region)] 

datos <- datos %>% 
  .[, ddeaths := shift(ddeaths, -15, give.names = TRUE), 
    by = country] %>%
  .[mov_mean_country, on = .NATURAL] %>% 
  .[, variable := gsub("_percent_change_from_baseline", "", variable)] %>% 
  .[ddeaths >= 0.01] 
  

ggplot(datos, aes(movility, exp(ddeaths))) +
  geom_point(size = 0.7, alpha = 0.3) +
  geom_smooth(method = "loess", color = "#452981") +
  scale_color_discrete(guide = "none") +
  scale_x_continuous("<- menos movilidad                       más movilidad ->\nCambio en movilidad",
                     breaks = scales::pretty_breaks(7)) +
  scale_y_continuous("Tasa de crecimiento de cantidad de muertes\n<- crecimiento lento                crecimiento rápido ->")  +
  facet_wrap(~variable, scale = "free_x", labeller = labeller(variable = lab_mov)) +
  labs(title = "Relación entre reducción en la movilidad y la cantidad de muertes por Covid-19",
       subtitle = "Tasa de crecimiento de la cantidad de muerte 15 días siguiente al cambio de movilidad") +
  theme_minimal(base_size = 16)