Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Investigación reproducible sobre positividad y letalidad en departamentos con mayor positividad #3

Open
kenarab opened this issue Jun 12, 2020 · 0 comments
Open

Investigación reproducible sobre positividad y letalidad en departamentos con mayor positividad #3

kenarab opened this issue Jun 12, 2020 · 0 comments
Labels
positividad RR

Comments

@kenarab
Copy link
Collaborator

kenarab commented Jun 12, 2020 •
edited
Loading 

library(COVID19AR)
#> Loading required package: dplyr
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
#> Loading required package: knitr
#> Loading required package: magrittr
#> Loading required package: lgr
#> Warning: replacing previous import 'ggplot2::Layout' by 'lgr::Layout' when
#> loading 'COVID19AR'
#> Warning: replacing previous import 'readr::col_factor' by 'scales::col_factor'
#> when loading 'COVID19AR'
#> Warning: replacing previous import 'magrittr::equals' by 'testthat::equals' when
#> loading 'COVID19AR'
#> Warning: replacing previous import 'magrittr::not' by 'testthat::not' when
#> loading 'COVID19AR'
#> Warning: replacing previous import 'magrittr::is_less_than' by
#> 'testthat::is_less_than' when loading 'COVID19AR'
#> Warning: replacing previous import 'dplyr::matches' by 'testthat::matches' when
#> loading 'COVID19AR'
library(ggplot2)
#> 
#> Attaching package: 'ggplot2'
#> The following object is masked from 'package:lgr':
#> 
#>     Layout
#library(dplyr)
#library(RColorBrewer)
knitr::opts_chunk$set(fig.width = 4, fig.height = 6, dpi = 300, warning = FALSE)

report.dir = file.path(getEnv("data_dir"), "reports")
dir.create(report.dir, showWarnings = FALSE, recursive = TRUE)
covid19.curator <- COVID19ARCurator$new(download.new.data = FALSE)

dummy <- covid19.curator$loadData()
#> INFO  [22:16:48.304] Exists dest path? {dest.path: ~/.R/COVID19AR/Covid19Casos.csv, exists.dest.path: TRUE}
dummy <- covid19.curator$curateData()
#> INFO  [22:16:49.962] Normalize 
#> INFO  [22:16:50.339] checkSoundness 
#> INFO  [22:16:50.457] Mutating data
covid19.curator$max.date
#> [1] "2020-06-15"

covid19.ar.provincia.summary <- covid19.curator$makeSummary(group.vars = c("residencia_provincia_nombre", "sepi_apertura"),
                                                  cache.filename = "covid19ar_residencia_provincia_nombre-sepi_apertura.csv")
#> Parsed with column specification:
#> cols(
#>   .default = col_double(),
#>   residencia_provincia_nombre = col_character()
#> )
#> See spec(...) for full column specifications.
covid19.ar.provincia.summary.selected <- covid19.ar.provincia.summary %>%
                                             filter(confirmados >= 20) %>%
                                             group_by(residencia_provincia_nombre) %>%
                                             summarise(min_sepi_apertura = min(sepi_apertura),
                                                       max_confirmados = max(confirmados), .groups = "keep") %>%
                                             filter(max_confirmados >=100) %>% arrange(desc(max_confirmados))
kable(covid19.ar.provincia.summary.selected)
residencia_provincia_nombre min_sepi_apertura max_confirmados
CABA 11 15104
Buenos Aires 11 13710
Chaco 12 1364
Río Negro 14 564
Córdoba 12 497
Santa Fe 13 285
SIN ESPECIFICAR 19 216
Neuquén 14 212
Tierra del Fuego 13 136
Mendoza 13 112
Corrientes 13 104 
covid19.ar.summary <- covid19.curator$makeSummary(group.vars = c("residencia_provincia_nombre", "residencia_departamento_nombre", "sepi_apertura"),
                                                  cache.filename = "covid19ar_residencia_provincia_nombre-residencia_departamento_nombre-sepi_apertura.csv"
                                                  )
#> Parsed with column specification:
#> cols(
#>   .default = col_double(),
#>   residencia_provincia_nombre = col_character(),
#>   residencia_departamento_nombre = col_character()
#> )
#> See spec(...) for full column specifications.
covid19.ar.summary %<>% inner_join(covid19.ar.provincia.summary.selected, by = "residencia_provincia_nombre")
covid19.ar.summary %<>% filter(sepi_apertura >= min_sepi_apertura)

departamento_max_sepi_apertura <- covid19.ar.summary %>%
  group_by(residencia_provincia_nombre, residencia_departamento_nombre) %>%
  summarize(sepi_apertura = max(sepi_apertura), .groups = "keep")

covid19.ar.summary.selected <- covid19.ar.summary %>%
                                inner_join(departamento_max_sepi_apertura,
                                           by = c("residencia_provincia_nombre",
                                                  "residencia_departamento_nombre",
                                                  "sepi_apertura"))
nrow(covid19.ar.summary)
#> [1] 3407
last_sepi_apertura <- max(covid19.ar.summary.selected$sepi_apertura)
covid19.ar.summary.selected %<>% filter(sepi_apertura == last_sepi_apertura & confirmados >= 20) %>% arrange(desc(positividad.porc))

departamentos2plot <- covid19.ar.summary.selected %>%
               #filter(positividad.porc >= 0.2) %>%
               select(residencia_provincia_nombre, residencia_departamento_nombre, sepi_apertura, confirmados, sospechosos, fallecidos, positividad.porc)
departamentos2plot %<>% mutate(rank = rank(desc(positividad.porc)))
departamentos2plot %<>% filter(rank <= 20)
top.n <- nrow(departamentos2plot)
kable(departamentos2plot %>% select(residencia_provincia_nombre, residencia_departamento_nombre, confirmados, positividad.porc, rank))
residencia_provincia_nombre residencia_departamento_nombre confirmados positividad.porc rank
CABA COMUNA 1 2069 0.593 1.0
CABA COMUNA 7 1886 0.575 2.0
CABA COMUNA 8 767 0.443 3.0
CABA COMUNA 3 332 0.365 4.5
CABA COMUNA 4 1017 0.365 4.5
CABA COMUNA 15 191 0.329 6.0
Buenos Aires Avellaneda 899 0.296 7.0
Río Negro Avellaneda 111 0.295 8.0
SIN ESPECIFICAR SIN ESPECIFICAR 216 0.294 9.0
Buenos Aires Capitán Sarmiento 29 0.287 10.0
CABA COMUNA 10 150 0.273 11.0
CABA COMUNA 5 156 0.267 12.0
CABA COMUNA 13 147 0.259 13.0
CABA COMUNA 2 114 0.256 14.0
Buenos Aires Presidente Perón 106 0.255 15.0
CABA SIN ESPECIFICAR 7817 0.240 16.0
Buenos Aires Quilmes 1227 0.239 17.0
CABA COMUNA 14 144 0.227 18.0
CABA COMUNA 9 80 0.219 19.0
Buenos Aires San Vicente 104 0.218 20.0 
data2plot <- covid19.ar.summary %>%
             inner_join(departamentos2plot %>%
                          select(residencia_provincia_nombre, residencia_departamento_nombre, rank),
                        by = c("residencia_provincia_nombre", "residencia_departamento_nombre")) %>%
             filter(positividad.porc <=0.6 | confirmados >= 20) %>%
             arrange(rank, sepi_apertura)

data2plot %<>% mutate(group.name = paste(sprintf("%02d", round(rank)), residencia_provincia_nombre, residencia_departamento_nombre, sep = "-"))
data2plot.caba  <- data2plot %>% filter(residencia_provincia_nombre %in% "CABA")
data2plot.resto <- data2plot %>% filter(!residencia_provincia_nombre %in% "CABA")

sepi.fechas <- covid19.curator$data %>%
                 group_by(sepi_apertura) %>%
                 summarize(ultima_fecha_sepi = max(fecha_apertura), .groups = "keep")
data2plot.caba %<>% inner_join(sepi.fechas, by = "sepi_apertura")
data2plot.resto %<>% inner_join(sepi.fechas, by = "sepi_apertura")

report.date <- max(sepi.fechas$ultima_fecha_sepi)

covplot <- data2plot.caba %>%
  ggplot(aes(x = ultima_fecha_sepi, y = confirmados, color = "confirmados")) +
  geom_line() +
  facet_wrap(~group.name,
             ncol = 2, scales = "free_y") +
  labs(title = paste("Evolución de casos confirmados y tests\n", top.n, " departamentos del país > 20 casos confirmados con máxima positividad - CABA", sep = "")) +
  ylab("confirmados (log)")
covplot <- covplot +
  geom_line(aes(x = ultima_fecha_sepi, y = tests, color = "tests")) +
  facet_wrap(~group.name,
             ncol = 2, scales = "free_y")
covplot <- setupTheme(covplot, report.date = report.date, x.values = sepi.fechas$ultima_fecha_sepi, x.type = "dates",
                      total.colors = 2,
                      data.provider.abv = "@msalnacion", base.size = 6)
covplot <- covplot + scale_y_log10()
#> Scale for 'y' is already present. Adding another scale for 'y', which will
#> replace the existing scale.
covplot
#> Warning: Transformation introduced infinite values in continuous y-axis

ggsave(file.path(report.dir, paste("caba-provincias-departamentos-confirmados-tests",".png", sep ="")),
       covplot,
       width = 7, height = 5, dpi = 300)
#> Warning: Transformation introduced infinite values in continuous y-axis

covplot <- data2plot.caba %>%
 ggplot(aes(x = ultima_fecha_sepi, y = positividad.porc, color = "positividad.porc")) +
 geom_line() +
 facet_wrap(~group.name , ncol = 2, scales = "free_y") +
 labs(title = paste("Porcentajes de positividad, uso de UCI, respirador y letalidad\n", top.n, " departamentos del país > 20 casos confirmados con máxima positividad - CABA", sep = ""))
covplot <- covplot +
 geom_line(aes(x = ultima_fecha_sepi, y = cuidado.intensivo.porc, color = "cuidado.intensivo.porc")) +
 facet_wrap(~group.name, ncol = 2, scales = "free_y")
covplot <- covplot  +
 geom_line(aes(x = ultima_fecha_sepi, y = respirador.porc, color = "respirador.porc"))+
 facet_wrap(~group.name, ncol = 2, scales = "free_y")
covplot <- covplot +
 geom_line(aes(x = ultima_fecha_sepi, y = letalidad.min.porc, color = "letalidad.min.porc")) +
 facet_wrap(~group.name, ncol = 2, scales = "free_y")

covplot <- setupTheme(covplot, report.date = report.date, x.values = sepi.fechas$ultima_fecha_sepi, x.type = "dates",
                     total.colors = 4,
                     data.provider.abv = "@msalnacion", base.size = 6)
covplot

ggsave(file.path(report.dir, paste("caba-provincias-departamentos-positividad",".png", sep ="")),
       covplot,
       width = 7, height = 5, dpi = 300)


covplot <- data2plot.resto %>%
  ggplot(aes(x = ultima_fecha_sepi, y = confirmados, color = "confirmados")) +
  geom_line() +
  facet_wrap(~group.name,
             ncol = 2, scales = "free_y") +
  labs(title =  paste("Evolución de casos confirmados y tests\n", top.n, " departamentos del país > 20 casos confirmados con máxima positividad - Resto", sep = "")) +
  ylab("confirmados (log)")
covplot <- covplot +
  geom_line(aes(x = ultima_fecha_sepi, y = tests, color = "tests")) +
  facet_wrap(~group.name,
             ncol = 2, scales = "free_y")
covplot <- setupTheme(covplot, report.date = report.date, x.values = sepi.fechas$ultima_fecha_sepi, x.type = "dates",
                      total.colors = 2,
                      data.provider.abv = "@msalnacion", base.size = 6)
covplot <- covplot + scale_y_log10()
#> Scale for 'y' is already present. Adding another scale for 'y', which will
#> replace the existing scale.
covplot
#> Warning: Transformation introduced infinite values in continuous y-axis

ggsave(file.path(report.dir, paste("resto-provincias-departamentos-confirmados-tests",".png", sep ="")),
       covplot,
       width = 7, height = 5, dpi = 300)
#> Warning: Transformation introduced infinite values in continuous y-axis

covplot <- data2plot.resto %>%
  ggplot(aes(x = ultima_fecha_sepi, y = positividad.porc, color = "positividad.porc")) +
  geom_line() +
  facet_wrap(~group.name , ncol = 2, scales = "free_y") +
  labs(title =  paste("Porcentajes de positividad, uso de UCI, respirador y letalidad\n", top.n, " departamentos del país > 20 casos confirmados con máxima positividad - Resto", sep = ""))

covplot <- covplot +
  geom_line(aes(x = ultima_fecha_sepi, y = cuidado.intensivo.porc, color = "cuidado.intensivo.porc")) +
  facet_wrap(~group.name, ncol = 2, scales = "free_y")
covplot <- covplot  +
  geom_line(aes(x = ultima_fecha_sepi, y = respirador.porc, color = "respirador.porc"))+
  facet_wrap(~group.name, ncol = 2, scales = "free_y")
covplot <- covplot +
  geom_line(aes(x = ultima_fecha_sepi, y = letalidad.min.porc, color = "letalidad.min.porc")) +
  facet_wrap(~group.name, ncol = 2, scales = "free_y")

covplot <- setupTheme(covplot, report.date = report.date, x.values = sepi.fechas$ultima_fecha_sepi, x.type = "dates",
                      total.colors = 4,
                      data.provider.abv = "@msalnacion", base.size = 6)
covplot
#> Warning: Removed 1 row(s) containing missing values (geom_path).
#> Warning: Removed 1 row(s) containing missing values (geom_path).

#> Warning: Removed 1 row(s) containing missing values (geom_path).

ggsave(file.path(report.dir, paste("resto-provincias-departamentos-positividad",".png", sep ="")),
       covplot,
       width = 7, height = 5, dpi = 300)
#> Warning: Removed 1 row(s) containing missing values (geom_path).

#> Warning: Removed 1 row(s) containing missing values (geom_path).

#> Warning: Removed 1 row(s) containing missing values (geom_path).

Created on 2020-06-15 by the reprex package (v0.3.0)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Assignees
No one assigned
Labels
positividad RR
Projects
None yet
Milestone
No milestone
Development

No branches or pull requests
1 participant
@kenarab