diff --git a/effecto_temprano_pob/eeuu_pob.tsv b/effecto_temprano_pob/eeuu_pob.tsv new file mode 100644 index 0000000..bb74811 --- /dev/null +++ b/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 + diff --git a/effecto_temprano_pob/efecto_temprano_pob.r b/effecto_temprano_pob/efecto_temprano_pob.r new file mode 100644 index 0000000..7517768 --- /dev/null +++ b/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) + diff --git a/semana_proxima_desde_hoy.png b/semana_proxima_desde_hoy.png new file mode 100644 index 0000000..2ca41f7 Binary files /dev/null and b/semana_proxima_desde_hoy.png differ