Mostrando relación entre población y tamaño de la epidemia

effecto_temprano_pob/eeuu_pob.tsv

@@ -0,0 +1,58 @@
+estado	pob_2019	pob_2010
+California	39512223	37254523
+Texas	28995881	25145561
+Florida	21477737	18801310
+New York	19453561	19378102
+Pennsylvania	12801989	12702379
+Illinois	12671821	12830632
+Ohio	11689100	11536504
+Georgia	10617423	9687653
+North Carolina	10488084	9535483
+Michigan	9986857	9883640
+New Jersey	8882190	8791894
+Virginia	8535519	8001024
+Washington	7614893	6724540
+Arizona	7278717	6392017
+Massachusetts	6949503	6547629
+Tennessee	6833174	6346105
+Indiana	6732219	6483802
+Missouri	6137428	5988927
+Maryland	6045680	5773552
+Wisconsin	5822434	5686986
+Colorado	5758736	5029196
+Minnesota	5639632	5303925
+South Carolina	5148714	4625364
+Alabama	4903185	4779736
+Louisiana	4648794	4533372
+Kentucky	4467673	4339367
+Oregon	4217737	3831074
+Oklahoma	3956971	3751351
+Connecticut	3565287	3574097
+Utah	3205958	2763885
+Puerto Rico	3193694	3725789
+Iowa	3155070	3046355
+Nevada	3080156	2700551
+Arkansas	3017825	2915918
+Mississippi	2976149	2967297
+Kansas	2913314	2853118
+New Mexico	2096829	2059179
+Nebraska	1934408	1826341
+West Virginia	1792147	1852994
+Idaho	1787065	1567582
+Hawaii	1415872	1360301
+New Hampshire	1359711	1316470
+Maine	1344212	1328361
+Montana	1068778	989415
+Rhode Island	1059361	1052567
+Delaware	973764	897934
+South Dakota	884659	814180
+North Dakota	762062	672591
+Alaska	731545	710231
+District of Columbia	705749	601723
+Vermont	623989	625741
+Wyoming	578759	563626
+Guam	165718	159358
+U.S. Virgin Islands	104914	106405
+American Samoa	55641	55519
+Northern Mariana Islands	55194	53883
+

effecto_temprano_pob/efecto_temprano_pob.r

@@ -0,0 +1,117 @@
+library(tidyverse)
+
+convertir_formato <- function(datos, values_to = "valor"){
+  # datos <- muertes
+  # datos <- casos
+  datos <- datos %>%
+    select(-UID, -iso2, -iso3, -code3, -FIPS, -Admin2, -Lat, -Long_, -Combined_Key, -Country_Region) %>%
+    pivot_longer(!all_of(intersect(c("Province_State", "Population"), colnames(datos))),
+                 names_to = "fecha", values_to = values_to)
+
+  # if(!("Population" %in% colnames(datos))){
+  #   if(is.null(pob)){
+  #     stop("ERROR")
+  #   }else{
+  #     datos %>%
+  #       left_join(pob, by = c("Province_State"="estado"))
+  #   }
+  # }
+
+  datos <- datos %>%
+    split(.$Province_State) %>%
+    map_dfr(function(d){
+      d %>%
+        split(.$fecha) %>%
+        map_dfr(function(d, col){
+          res <- tibble(!!col := sum(d[,col]))
+          if("Population" %in% colnames(d)){
+            res$pob <- sum(d$Population)
+          }
+          res
+        }, col = values_to, .id = "fecha") %>%
+        mutate(fecha = as.Date(fecha, "%m/%d/%y") %>% strftime(format = "%Y-%m-%d") %>% as.Date()) %>%
+        arrange(fecha)
+    }, .id = "Province_State") 
+
+  return(datos)
+}
+
+
+args <- list(pob = "effecto_temprano_pob/eeuu_pob.tsv",
+             casos_tiempo = "../COVID-19/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_confirmed_US.csv",
+             muertes_tiempo = "../COVID-19/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_deaths_US.csv")
+
+pob <- read_tsv("effecto_temprano_pob/eeuu_pob.tsv")
+pob
+casos <- read_csv(args$casos_tiempo)
+casos
+muertes <-read_csv(args$muertes_tiempo)
+muertes
+
+
+casos <- convertir_formato(datos = casos, values_to = "casos_acumulados") %>%
+  left_join(pob %>% select(Province_State = estado, pob = pob_2019))
+casos
+muertes <- convertir_formato(datos = muertes, values_to = "muertes_acumuladas")
+muertes
+
+
+grafica_pob_futuro <- function(dat, var, valor_min = 10, n = 7, grupo = "Province_State"){
+  # var <- "muertes_acumuladas"
+  # valor_min = 10
+  # n = 7
+  # grupo = "Province_State"
+  # dat <- muertes
+  dat <- dat %>%
+    split(.[,grupo]) %>%
+    map_dfr(function(d, var, valor_min = 10, n = 7){
+      # print(var)
+      d %>%
+        mutate(acum_prox = lead(.[,var] %>% unlist, n = n)) %>%
+        mutate(nuevos_prox = acum_prox - .[,var] %>% unlist) %>%
+        filter(.[,var] >= valor_min) %>%
+        head(1)
+    }, var = var, valor_min = valor_min, n = n)
+  # dat
+
+  p1 <- ggplot(dat, aes(x=pob, y = nuevos_prox)) +
+    geom_point() +
+    geom_smooth(method = "lm", se = FALSE) +
+    scale_x_log10() +
+    xlab("Población") +
+    ylab("Nuevos") +
+    AMOR::theme_blackbox()
+  p1
+}
+
+p11 <- grafica_pob_futuro(dat = muertes, var = "muertes_acumuladas",
+                         valor_min = 1, grupo = "Province_State", n = 7)
+p11
+p21 <- grafica_pob_futuro(dat = muertes, var = "muertes_acumuladas",
+                          valor_min = 10, grupo = "Province_State", n = 7)
+p21
+p31 <- grafica_pob_futuro(dat = muertes, var = "muertes_acumuladas",
+                          valor_min = 20, grupo = "Province_State", n = 7)
+p31
+
+p12 <- grafica_pob_futuro(dat = casos, var = "casos_acumulados",
+                          valor_min = 1, grupo = "Province_State", n = 7)
+p12
+p22 <- grafica_pob_futuro(dat = casos, var = "casos_acumulados",
+                          valor_min = 10, grupo = "Province_State", n = 7)
+p22
+p32 <- grafica_pob_futuro(dat = casos, var = "casos_acumulados",
+                          valor_min = 20, grupo = "Province_State", n = 7)
+p32
+
+
+p1 <- cowplot::plot_grid(p11 + ggtitle(label = "Nuevas muertes 7 días despues\nde 1 muerte (Estados de EEUU)"),
+                   p12 + ggtitle(label = "Nuevos casos 7 días despues\nde 1 caso (Estados de EEUU)"),
+                   p21 + ggtitle(label = "Nuevas muertes 7 díasdespues\nde 10 muertes (Estados de EEUU)"),
+                   p22 + ggtitle(label = "Nuevos casos 7 días despues\nde 10 casos (Estados de EEUU)"),
+                   p31 + ggtitle(label = "Nuevas muertes 7 días despues\nde 20 muertes (Estados de EEUU)"),
+                   p32 + ggtitle(label = "Nuevos casos 7 días despues de\n20 casos (Estados de EEUU)"),
+                   ncol = 2)
+archivo <- "semana_proxima_desde_hoy.png"
+ggsave(archivo, p1, width = 7, height = 6.7, dpi = 150)
+