Volver al Artículo
Article Notebook
Descargar código fuente

COVID-19 en población pediátrica menor de 18 años según registros nacionales en Perú, 2020-2023

Autor/a
Afiliación

Brian Norman Peña-Calero

Laboratorio de Innovación en Salud - UPCH

Fecha de publicación

16 mayo, 2024

In [1]:
library(tidyverse)
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.1     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(arrow)

Adjuntando el paquete: 'arrow'

The following object is masked from 'package:lubridate':

    duration

The following object is masked from 'package:utils':

    timestamp
library(duckdb)
Cargando paquete requerido: DBI
library(dbplyr)

Adjuntando el paquete: 'dbplyr'

The following objects are masked from 'package:dplyr':

    ident, sql
library(innovar)
library(apyramid)
library(sf)
Linking to GEOS 3.12.1, GDAL 3.8.4, PROJ 9.3.1; sf_use_s2() is TRUE
source("03_functions/index_calculator.R")

Disponibilidad de los datos

In [2]:
con <- dbConnect(duckdb(), dbdir = "01_data/raw/covid.duckdb", read_only = TRUE)

vacunas <- tbl(con, "vacunas")
vacunas_18 <- tbl(con, "vacunas_18")
fallecidos_total <- tbl(con, "fallecidos_total")
positivos <- tbl(con, "positivos")
positivos_0723 <- tbl(con, "positivos_0723")
hospitalizados <- tbl(con, "hospitalizados")
hosp_final <- tbl(con, "hosp_final")
poblacion <- tbl(con, "poblacion")
peru_mother <- tbl(con, "peru_mother")
# pobreza <- tbl(con, "pobreza")
data(Peru)
In [3]:
fallecidos_summary <- fallecidos_total %>% 
  summarise(
    n = n(),
    min = min(fecha_fallecimiento),
    max = max(fecha_fallecimiento)
  ) %>% 
  collect() 
Warning: Missing values are always removed in SQL aggregation functions.
Use `na.rm = TRUE` to silence this warning
This warning is displayed once every 8 hours.
positivos_summary <- positivos %>% 
  summarise(
    n = n(),
    min = min(fecha_resultado),
    max = max(fecha_resultado)
  ) %>% 
  collect() 

hospitalizados_summary <- hospitalizados %>% 
  summarise(
    n = n(),
    min = min(fecha_ingreso_hosp),
    max = max(fecha_ingreso_hosp)
  ) %>% 
  collect() 

vacunas_summary <- vacunas %>% 
  summarise(
    n = n(),
    min = min(fecha_vacunacion),
    max = max(fecha_vacunacion)
  ) %>% 
  collect() %>% 
  mutate(
    across(min:max,
           ymd)
  )

max_positivos_0723 <- positivos_0723 %>% 
  summarise(max = max(fecha_resultado)) %>% 
  pull(max)

Peru <- Peru %>%  
  left_join(
    peru_mother %>% 
      as_tibble()
  )
Joining with `by = join_by(ubigeo, dep, prov, distr)`
peru_dep_sf <- Peru %>%
  group_by(dep.code, dep) %>%
  summarise() %>% 
  ungroup()
`summarise()` has grouped output by 'dep.code'. You can override using the
`.groups` argument.
peru_reg_sf <- Peru %>%
  group_by(region) %>%
  summarise() %>% 
  ungroup()

peru_macro_sf <- Peru %>%
  group_by(macrorregion) %>%
  summarise() %>% 
  ungroup()

Actualmente los datos disponibles para el análisis tienen las siguientes situaciones:

  1. Fallecidos COVID-19: Ahora mismo, esta data (Fallecidos por COVID-19 - [Ministerio de Salud - MINSA]) se encuentra actualizada en el portal de datos abiertos. Cuenta con 220 816 fallecidos que van desde 2020-03-03 al 2024-02-03.

  2. Casos positivos COVID-19: Esta base de datos ya fue corregida y actualizada recientemente en la plataforma de datos abiertos. Cuenta con 4 548 255 casos positivos que van desde 2020-03-06 al 2023-12-31. Sin embargo, tiene el inconveniente de no tener registrado el id_persona que es indispensable para poder calcular los casos nuevos positivos COVID-19. Se usará por ahora una base actualizada a junio del 2023 con algunos casos menos, pero que si tiene esta información. El enlace de descarga de esa data desde el mismo Minsa ya no se encuentra disponible, pero si está en este repositorio Github: https://github.com/jmcastagnetto/covid-19-peru-limpiar-datos-minsa/tree/main/datos/originales

  3. Hospitalizados por COVID-19: Esta data contiene a la vez información de la vacunación y fallecimiento de quienes fueron hospitalizados. Cuenta con 150 791 casos hospitalizados que van desde 2019-06-06 al 2024-01-03.

  4. Vacunación COVID-19: Esta data contiene información de vacuna. Cuenta con 91 838 312 registros de vacunación que van desde 2020-04-27 al 2023-12-30.

  5. Población Estimada: Esta data contiene las estimaciones poblacionales desde el 2020 al 2023 realizada por REUNIS. Presenta subdivisiones por distrito, edad y sexo. Sin embargo, la versión del año 2021, no tiene subdivisión por sexo, por lo que se usa la estimación realizada por el INEI que si lo contiene.

Para términos de uniformidad, temporalmente se restringirán todos los datos a junio de 2023.

Positivos - Prevalencia COVID-19

Para la estimación de la prevalencia, se obtuvo los datos poblacionales por distrito, sexo y grupo de edad para 2020, 2021, 2022 y 2023. A partir de ello, se calculó una prevalencia promedio mensual (Ecuación 1) que luego fue promediada para obtener un único valor por distrito, sexo y grupo de edad. Finalmente, se reporta la prevalencia promedio mensual por 1000 habitantes en anualidades (Ecuación 2) u olas covid, a fin de tener una lectura con menor términos decimales.

\[ \text{Prevalencia promedio mensual}_i = \frac{\text{Promedio de Número de casos en el mes del año } i}{\text{Población en el año } i} \tag{1}\]

Donde:

  • \(\text{Número de casos en el año } i\) es el número de positivos COVID-19 en un año en específico (2020-2023)
  • \(\text{Población en el año } i\) es la población que puede ser afectada por COVID-19 en un año en específico (2020-2023)

\[ \text{Prevalencia Promedio mensual por 1000 habitantes} = \left( \frac{\sum_{i=2020}^{2023} \text{Prevalencia promedio mensual}_i}{\text{Número de Años}} \right) \times 1000 \tag{2}\]

Vista general

In [4]:
positivos_0723 <- positivos_0723 %>% 
  filter(edad < 18, 
         sexo != "No registrado") %>% 
  mutate(
    overall = "overall"
  ) 

range_pos_18_0723 <- positivos_0723 %>% 
  summarise(
    min = min(fecha_resultado),
    max = max(fecha_resultado)
  ) %>% 
  collect() %>% 
  mutate(
    min = format(min, "%d-%m-%Y"),
    max = format(max, "%d-%m-%Y"),
    fecha = paste0("(", min, " a ", max, ")")
  )

Cálculo de prevalencias

In [5]:
levels <- list(
  c("overall"),
  c("grupo_edad"),
  c("sexo"),
  c("ola_covid"),
  c("ola_covid", "grupo_edad"),
  c("ola_covid", "sexo"),
  c("ola_covid", "region"),
  c("ola_covid", "macrorregion"),
  c("departamento"),
  c("departamento", "sexo"),
  c("departamento", "grupo_edad"),
  c("departamento", "sexo", "grupo_edad"),
  c("departamento", "ola_covid"),
  c("distrito"),
  c("distrito", "sexo"),
  c("distrito", "grupo_edad"),
  c("distrito", "cuartil_pobreza"),
  c("grupo_edad", "cuartil_pobreza"),
  c("sexo", "cuartil_pobreza"),
  c("ola_covid", "cuartil_pobreza"),
  c("cuartil_pobreza"),
  c("cuartil_nbi"),
  c("region"),
  c("macrorregion")
)

# Calcular la prevalencia
results_prevalencia <- index_calculator(
  data = positivos_0723,
  denom = poblacion %>% mutate(overall = "overall"), 
  levels = levels, 
  type = "month"
)

results_per_month_prevalencia <- index_calculator(
  data = positivos_0723,
  denom = poblacion %>% mutate(overall = "overall"),
  levels = levels, 
  type = "per_month"
)
In [6]:
positivos_0723_tbl <- positivos_0723 %>% 
  select(edad, overall, grupo_edad, sexo, ola_covid, region, 
         macrorregion, cuartil_pobreza, cuartil_nbi) %>% 
  collect()

labelled::var_label(positivos_0723_tbl) <- list(
  overall = "Overall",
  grupo_edad = "Age Group",
  sexo = "Sex",
  ola_covid = "COVID-19 wave",
  region = "Natural Regions",
  macrorregion = "Macroregions",
  cuartil_pobreza = "Poverty level",
  cuartil_nbi = "Unsatisfied basic needs level"
)
In [7]:
tbl_summ_positivos <- positivos_0723_tbl %>% 
  select(-edad) %>% 
  gtsummary::tbl_summary(
    type = list(
      overall ~ "dichotomous"
    ),
    value = list(overall = "overall"),
    missing_text = "No data"
  ) %>% 
  gtsummary::modify_header(label = "**Variables**") %>%
  gtsummary::bold_labels()

tbl_summ_positivos_c2 <- results_prevalencia$overall$index %>% 
  mutate(label = "Overall") %>% 
  rename(variable = overall) %>% 
  bind_rows(
    results_prevalencia$grupo_edad$index %>% 
      mutate(variable = "grupo_edad") %>% 
      rename(label = grupo_edad),
    results_prevalencia$sexo$index %>% 
      mutate(variable = "sexo") %>% 
      rename(label = sexo),
    results_prevalencia$ola_covid$index %>% 
      mutate(variable = "ola_covid") %>% 
      rename(label = ola_covid),
    results_prevalencia$region$index %>% 
      mutate(variable = "region") %>% 
      rename(label = region),
    results_prevalencia$macrorregion$index %>% 
      mutate(variable = "macrorregion") %>% 
      rename(label = macrorregion),
    results_prevalencia$cuartil_pobreza$index %>% 
      mutate(variable = "cuartil_pobreza") %>% 
      rename(label = cuartil_pobreza),
    results_prevalencia$cuartil_nbi$index %>% 
      mutate(variable = "cuartil_nbi") %>% 
      rename(label = cuartil_nbi)
  ) %>% 
  drop_na() %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  )


tbl_summ_positivos_final <- tbl_summ_positivos %>%
  gtsummary::modify_table_body(
    ~ .x %>% 
      left_join(tbl_summ_positivos_c2) %>% 
      mutate(
        label = case_when(
          variable %in% c("cuartil_pobreza", "cuartil_nbi") &
            label == "1" ~ "1 (0-19.9%)",
          variable %in% c("cuartil_pobreza", "cuartil_nbi") & 
            label == "2" ~ "2 (20-39.9%)",
          variable %in% c("cuartil_pobreza", "cuartil_nbi") & 
            label == "3" ~ "3 (40-59.9%)",
          variable %in% c("cuartil_pobreza", "cuartil_nbi") &
            label == "4" ~ "4 (60-100%)",
          .default = label
        )
      )
  ) %>% 
  gtsummary::modify_header(
    rate ~ "**Average monthly prevalence per 1000 inhabitants**"
  )
Joining with `by = join_by(variable, label)`
In [8]:
tbl_summ_positivos_final
Tabla 1: Descriptivos de casos positivos menores de 18 años (07-03-2020 a 17-06-2023)
Variables N = 315,0461 Average monthly prevalence per 1000 inhabitants
Overall 315,046 (100%) 0.810
Age Group

    Under 1 year 16,537 (5.2%) 0.826
    1 - 5 years 45,573 (14%) 0.413
    6 - 11 years 91,657 (29%) 0.706
    12 - 17 years 161,279 (51%) 1.252
Sex

    Female 159,581 (51%) 0.824
    Male 155,465 (49%) 0.796
COVID-19 wave

    1 (Mar – Oct 2020) 59,889 (19%) 0.782
    2 (Nov 2020 – Oct 2021) 72,471 (23%) 0.592
    3 (Nov 2021 – Apr 2022) 106,291 (34%) 1.844
    4 (May 2022 – Oct 2022) 58,179 (18%) 1.016
    5 (Nov 2022 – Jun 2023) 18,143 (5.8%) 0.235
    No data 73
Natural Regions

    Coast 234,478 (74%) 1.008
    Highlands 53,944 (17%) 0.488
    Jungle 26,624 (8.5%) 0.578
Macroregions

    Center 72,047 (23%) 0.833
    East 24,421 (7.8%) 0.555
    Metropolitan Lima and Callao 118,357 (38%) 1.126
    North 50,563 (16%) 0.564
    South 49,658 (16%) 0.784
Poverty level

    1 (0-19.9%) 233,362 (78%) 1.062
    2 (20-39.9%) 49,734 (17%) 0.485
    3 (40-59.9%) 15,063 (5.0%) 0.287
    4 (60-100%) 1,476 (0.5%) 0.138
    No data 15,411
Unsatisfied basic needs level

    1 (0-19.9%) 189,560 (63%) 1.118
    2 (20-39.9%) 80,980 (27%) 0.586
    3 (40-59.9%) 17,980 (6.0%) 0.334
    4 (60-100%) 11,115 (3.7%) 0.403
    No data 15,411
1 n (%)
In [9]:
tbl_summ_positivos_final %>% 
  gtsummary::as_hux_xlsx("02_output/tables/positivos_descriptivos.xlsx")

tbl_summ_positivos_final %>%
  gtsummary::as_flex_table() %>%
  flextable::save_as_docx(path = "02_output/tables/positivos_descriptivos.docx")
In [10]:
downloadthis::download_file(
  path = "02_output/tables/positivos_descriptivos.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [11]:
downloadthis::download_file(
  path = "02_output/tables/positivos_descriptivos.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [12]:
tbl_summ_positivos_edad_ola <- positivos_0723_tbl %>% 
  select(-edad) %>% 
  gtsummary::tbl_summary(
    by = ola_covid,
    type = list(
      overall ~ "dichotomous"
    ),
    value = list(overall = "overall"),
    missing_text = "Sin registro"
  ) %>% 
  gtsummary::modify_header(label = "**Variables**") %>%
  gtsummary::bold_labels()
73 observations missing `ola_covid` have been removed. To include these observations, use `forcats::fct_na_value_to_level()` on `ola_covid` column before passing to `tbl_summary()`.
ola_covid_positivos_gtsumm <- results_prevalencia$ola_covid$index %>% 
  rename(stat = ola_covid) %>% 
  mutate(label = "Overall") %>% 
  bind_rows(
    results_prevalencia$ola_covid_grupo_edad$index %>%
      rename(label = grupo_edad,
             stat = ola_covid),
    results_prevalencia$ola_covid_sexo$index %>% 
      rename(label = sexo,
             stat = ola_covid),
    results_prevalencia$ola_covid_region$index %>% 
      rename(label = region,
             stat = ola_covid),
    results_prevalencia$ola_covid_macrorregion$index %>% 
      rename(label = macrorregion,
             stat = ola_covid),
    results_prevalencia$ola_covid_cuartil_pobreza$index %>% 
      rename(label = cuartil_pobreza,
             stat = ola_covid)
  ) %>% 
  mutate(
    rate = formattable::digits(rate, 3),
    stat = as.character(stat),
    stat = case_match(
      stat,
      "1 (Mar – Oct 2020)" ~ "stat_1",
      "2 (Nov 2020 – Oct 2021)" ~ "stat_2",
      "3 (Nov 2021 – Apr 2022)" ~ "stat_3",
      "4 (May 2022 – Oct 2022)" ~ "stat_4",
      "5 (Nov 2022 – Jun 2023)" ~ "stat_5"
    )
  ) 

tbl_summ_positivos_edad_ola$table_body <- tbl_summ_positivos_edad_ola$table_body %>%
  mutate(
    across(
      gtsummary::all_stat_cols(stat_0 = FALSE),
      ~ str_remove_all(., "\\s*\\(.*?\\)\\s*")
    )
  ) %>% 
  pivot_longer(
    cols = stat_1:stat_5,
    names_to = "stat",
    values_to = "freq"
  ) %>% 
  left_join(
    ola_covid_positivos_gtsumm
  ) %>% 
  mutate(
    value = str_c(freq, ifelse(is.na(rate), "", str_c(" (", rate, ")")))
  ) %>% 
  select(-c(freq, rate)) %>% 
  pivot_wider(
    names_from = stat,
    values_from = value
  )
Joining with `by = join_by(label, stat)`
In [13]:
tbl_summ_positivos_edad_ola <- tbl_summ_positivos_edad_ola %>% 
  gtsummary::modify_footnote(
    gtsummary::all_stat_cols() ~ "n (incidence)"
  )

tbl_summ_positivos_edad_ola
Tabla 2: Descriptivos de casos positivos menores de 18 años por edad y olas COVID(07-03-2020 a 17-06-2023)
Variables 1 (Mar – Oct 2020), N = 59,8891 2 (Nov 2020 – Oct 2021), N = 72,4711 3 (Nov 2021 – Apr 2022), N = 106,2911 4 (May 2022 – Oct 2022), N = 58,1791 5 (Nov 2022 – Jun 2023), N = 18,1431
Overall 59,889 (0.782) 72,471 (0.592) 106,291 (1.844) 58,179 (1.016) 18,143 (0.235)
Age Group




    Under 1 year 5,172 (1.263) 2,687 (0.410) 4,515 (1.554) 2,391 (0.829) 1,769 (0.462)
    1 - 5 years 12,647 (0.568) 9,126 (0.272) 15,816 (0.964) 6,196 (0.378) 1,781 (0.082)
    6 - 11 years 16,363 (0.644) 17,487 (0.427) 37,793 (1.956) 16,573 (0.863) 3,429 (0.131)
    12 - 17 years 25,707 (1.036) 43,171 (1.043) 48,167 (2.537) 33,019 (1.755) 11,164 (0.439)
Sex




    Female 30,997 (0.820) 36,479 (0.590) 53,247 (1.859) 29,618 (1.042) 9,204 (0.241)
    Male 28,892 (0.745) 35,992 (0.594) 53,044 (1.829) 28,561 (0.989) 8,939 (0.229)
Natural Regions




    Coast 39,257 (0.872) 50,792 (0.694) 84,967 (2.453) 44,551 (1.294) 14,841 (0.318)
    Highlands 9,238 (0.416) 14,791 (0.407) 17,008 (1.066) 10,383 (0.657) 2,521 (0.121)
    Jungle 11,394 (1.216) 6,888 (0.523) 4,316 (0.616) 3,245 (0.460) 781 (0.083)
Macroregions




    Center 13,080 (0.750) 16,962 (0.604) 24,239 (1.923) 13,240 (1.060) 4,502 (0.270)
    East 10,435 (1.164) 6,462 (0.513) 3,977 (0.595) 2,849 (0.424) 698 (0.078)
    Metropolitan Lima and Callao 20,524 (1.050) 26,677 (0.777) 40,633 (2.591) 22,891 (1.478) 7,608 (0.361)
    North 9,196 (0.513) 11,674 (0.428) 18,917 (1.415) 8,639 (0.648) 2,120 (0.118)
    South 6,654 (0.524) 10,696 (0.524) 18,525 (1.992) 10,560 (1.140) 3,215 (0.260)
Poverty level




    1 41,858 (0.988) 50,926 (0.777) 81,317 (2.439) 45,101 (1.351) 14,099 (0.313)
    2 11,357 (0.619) 13,338 (0.402) 14,922 (0.968) 7,877 (0.515) 2,228 (0.108)
    3 4,292 (0.401) 4,175 (0.220) 4,077 (0.578) 2,121 (0.306) 398 (0.043)
    4 320 (0.148) 426 (0.106) 360 (0.227) 294 (0.188) 76 (0.048)
    Sin registro 2,062 3,606 5,615 2,786 1,342
Unsatisfied basic needs level




    1 30,151 (0.988) 41,132 (0.777) 67,921 (2.439) 38,237 (1.351) 12,081 (0.313)
    2 18,103 (0.619) 19,567 (0.402) 25,667 (0.968) 13,641 (0.515) 3,972 (0.108)
    3 4,861 (0.401) 5,211 (0.220) 4,882 (0.578) 2,491 (0.306) 533 (0.043)
    4 4,712 (0.148) 2,955 (0.106) 2,206 (0.227) 1,024 (0.188) 215 (0.048)
    Sin registro 2,062 3,606 5,615 2,786 1,342
1 n (incidence)
In [14]:
tbl_summ_positivos_edad_ola %>% 
  gtsummary::as_hux_xlsx("02_output/tables/positivos_olas_descriptivos.xlsx")

tbl_summ_positivos_edad_ola %>%
  gtsummary::as_flex_table() %>%
  flextable::save_as_docx(path = "02_output/tables/positivos_olas_descriptivos.docx")
In [15]:
downloadthis::download_file(
  path = "02_output/tables/positivos_olas_descriptivos.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [16]:
downloadthis::download_file(
  path = "02_output/tables/positivos_olas_descriptivos.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Gráfico de positivos (serie de tiempo) - Menores de 18 años

In [17]:
# 
# range_positivos_und_18 <- positivos %>% 
#   filter(edad < 18, 
#          sexo != "No registrado") %>% 
#   pull(fecha_resultado) %>%
#   range()

Sys.setlocale("LC_TIME", "English")
[1] "English_United States.1252"
positive_cases_area <- positivos_0723 %>% 
  mutate(
    fecha_round = case_when(
      fecha_round == as.Date("2024-01-01") ~  as.Date("2023-12-31"),
      .default = fecha_round
    )
  ) %>% 
  count(grupo_edad, fecha_round) %>% 
  collect() %>% 
  ggplot(
    aes(
      x = fecha_round,
      y = n,
      fill = grupo_edad
    )
  ) +
  geom_area(position = 'stack') +
  innovar::scale_fill_innova("jama") +
  scale_x_date(
    limits = c(ymd("2020-03-01"), ymd("2023-07-01")),
    breaks = seq(from = ceiling_date(ymd("2020-03-01"), "month"),
                 to = floor_date(ymd("2023-07-01"), "month"),
                 by = "2 months"), 
    # date_breaks = "2 month",
    date_labels = "%b %Y"
  ) +
  labs(
    y = NULL,
    x = NULL,
    title = "Positive cases",
    fill = "Age Group"
  ) + 
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45
    )
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-03-01"), 
    xmax = as.Date("2020-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2020-07-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "First wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-11-01"), 
    xmax = as.Date("2021-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2021-04-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Second wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2021-11-01"), 
    xmax = as.Date("2022-04-30"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-02-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Third wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2022-05-01"), 
    xmax = as.Date("2022-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-08-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Fourth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2022-11-01"), 
    xmax = as.Date("2023-07-01"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2023-03-01"),
    y = Inf, # Posición vertical del texto
    label = "Fifth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  )

positive_cases_area
Warning: Removed 4 rows containing non-finite outside the scale range
(`stat_align()`).
Figura 1: Positividad COVID Población menor de edad de acuerdo al grupo de edad y ola (07-03-2020 a 17-06-2023)

Gráfico de Incidencia (serie de tiempo) - Menores de 18 años

In [18]:
prevalence_by_age_area <- results_per_month_prevalencia$grupo_edad$index %>% 
  mutate(
    time = make_date(anio, mes, "1")
  ) %>% 
  ggplot(
    aes(
      x = time,
      y = rate,
      fill = grupo_edad
    )
  ) +
  geom_area(position = 'stack') +
  innovar::scale_fill_innova("jama") +
  scale_x_date(
    limits = c(ymd("2020-03-01"), ymd("2023-07-01")),
    breaks = seq(from = ceiling_date(ymd("2020-03-01"), "month"),
                 to = floor_date(ymd("2023-07-01"), "month"),
                 by = "2 months"), 
    # date_breaks = "2 month",
    date_labels = "%b %Y"
  ) +
  labs(
    y = NULL,
    x = NULL,
    title = "Monthly incidence per 1000 inhabitants",
    fill = "Age Group"
  ) + 
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45
    )
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-03-01"), 
    xmax = as.Date("2020-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2020-07-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "First wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-11-01"), 
    xmax = as.Date("2021-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2021-04-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Second wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2021-11-01"), 
    xmax = as.Date("2022-04-30"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-02-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Third wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2022-05-01"), 
    xmax = as.Date("2022-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-08-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Fourth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2022-11-01"), 
    xmax = as.Date("2023-07-01"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2023-03-01"),
    y = Inf, # Posición vertical del texto
    label = "Fifth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  )

prevalence_by_age_area
Warning: Removed 4 rows containing non-finite outside the scale range
(`stat_align()`).
Figura 2: Incidencia COVID Población menor de edad de acuerdo al grupo de edad y ola (07-03-2020 a 17-06-2023)

Pirámide frecuencia - Edades

In [19]:
positivos_0723_tbl %>% 
  mutate(
    edad = factor(edad)
  ) %>% 
  age_pyramid(
    age_group = "edad",
    split_by = "sexo"
  ) +
  scale_fill_brewer(palette = "Dark2") +
  labs(
    x = "Age",
    fill = "Sex",
    y = "Frequency"
  ) +
  theme_classic()
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.

In [20]:
positivos_0723_tbl %>% 
  age_pyramid(
    age_group = "grupo_edad",
    split_by = "sexo"
  ) +
  scale_fill_brewer(palette = "Dark2") +
  labs(
    x = "Age Group",
    fill = "Sex",
    y = "Frequency"
  ) +
  scale_y_continuous(
    labels = ~ scales::number(abs(.x), big.mark = ","),
    n.breaks = 10
  ) +
  theme_classic()
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for y is already present.
Adding another scale for y, which will replace the existing scale.

Pirámide proporcional - Edades

In [21]:
positivos_0723_tbl %>% 
  mutate(
    edad = factor(edad)
  ) %>% 
  age_pyramid(
    age_group = "edad",
    split_by = "sexo",
    proportional = TRUE
  ) +
   scale_fill_brewer(palette = "Dark2") +
  labs(
    x = "Age",
    fill = "Sex",
    y = "Percentage"
  ) +
  theme_classic()
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.

In [22]:
positivos_0723_tbl %>% 
  age_pyramid(
    age_group = "grupo_edad",
    split_by = "sexo",
    proportional = TRUE
  ) +
   scale_fill_brewer(palette = "Dark2") +
  labs(
    x = "Age Group",
    fill = "Sex",
    y = "Percentage"
  ) +
  theme_classic()
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.

Departamento

In [23]:
prev_dep_1k_sf <- peru_dep_sf %>% 
  rename(departamento = dep) %>% 
  inner_join(
    results_prevalencia$departamento$index
  )
Joining with `by = join_by(departamento)`
In [24]:
prev_dep_1k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap("Monthly incidence per 1000 inhabitants", 
               20)
    )
  ) +
  scale_fill_distiller(palette = "Oranges", # old: YlOrBr
                       direction = 1,
                       guide = "legend") + 
  theme_void()
Figura 3: Prevalencia COVID-19 de acuerdo al departamento (07-03-2020 a 17-06-2023)
In [25]:
In [26]:
tbl_summ_prev_dep_pre <- results_prevalencia$departamento$index %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) %>% 
  mutate(
    departamento = str_to_title(departamento)
  ) 

tbl_summ_prev_dep <- tbl_summ_prev_dep_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_prev_dep
Tabla 3: Prevalencia COVID-19 de acuerdo al departamento (07-03-2020 a 17-06-2023)
Departamento Rate
Amazonas 0.802
Ancash 0.903
Apurimac 0.587
Arequipa 1.264
Ayacucho 0.394
Cajamarca 0.452
Callao 0.782
Cusco 0.518
Huancavelica 0.466
Huanuco 0.430
Ica 1.085
Junin 0.740
La Libertad 0.520
Lambayeque 0.517
Lima 1.232
Loreto 0.459
Madre De Dios 1.333
Moquegua 2.615
Pasco 0.719
Piura 0.670
Puno 0.337
San Martin 0.657
Tacna 1.416
Tumbes 1.215
Ucayali 0.620
In [27]:
tbl_summ_prev_dep_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:2) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/prevalencia_departamento.xlsx",
                       open = FALSE)

tbl_summ_prev_dep %>%
  gt::gtsave("02_output/tables/prevalencia_departamento.docx")
In [28]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_departamento.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [29]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_departamento.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Departamento y sexo

In [30]:
results_prevalencia$departamento_sexo$index %>% 
  mutate(
    departamento = str_to_title(departamento),
    departamento = fct_reorder2(departamento, sexo, rate)
  ) %>% 
  ggplot(aes(x = departamento, y = rate, fill = sexo)) +
  geom_bar(stat = "identity", position = position_dodge()) +
  theme_bw() +
  labs(title = "Monthly incidence of COVID-19 by department and sex", 
       x = NULL, 
       y = "Monthly incidence per 1000 inhabitants",
       fill = "Sex",
       caption = paste0("Total cases reported: ", 
                        scales::number(sum(pull(results_prevalencia$departamento_sexo$index_pre,
                                                count))))) +
  innovar::scale_fill_innova("blue_fall") +
  theme(
    axis.text.x = element_text(
      angle = 45,
      hjust = 1,
      vjust = 1
    )
  )
Figura 4: Prevalencia COVID-19 de acuerdo al departamento y sexo (07-03-2020 a 17-06-2023)
In [31]:
prev_dep_sex_1k_sf <- peru_dep_sf %>% 
  rename(departamento = dep) %>% 
  inner_join(
    results_prevalencia$departamento_sexo$index
  ) %>% 
  ungroup()
Joining with `by = join_by(departamento)`
In [32]:
prev_dep_sex_1k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap(
        "Monthly incidence per 1000 inhabitants",
        20
      )
    )
  ) +
  scale_fill_distiller(palette = "Oranges", # old: YlOrBr
                       direction = 1) + 
  facet_wrap(vars(sexo)) + 
  theme_void()
Figura 5: Prevalencia COVID-19 de acuerdo al departamento y sexo (07-03-2020 a 17-06-2023)
In [33]:
In [34]:
tbl_summ_prev_dep_sex_pre <- results_prevalencia$departamento_sexo$index %>% 
  mutate(
    rate = formattable::digits(rate, 3),
    departamento = str_to_title(departamento)
  ) %>% 
  pivot_wider(
    names_from = sexo, 
    values_from = rate
  )

tbl_summ_prev_dep_sex <- tbl_summ_prev_dep_sex_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_prev_dep_sex
Tabla 4: Prevalencia COVID-19 de acuerdo al departamento y sexo (07-03-2020 a 17-06-2023)
Departamento Female Male
Amazonas 0.874 0.733
Ancash 0.969 0.862
Apurimac 0.630 0.559
Arequipa 1.252 1.308
Ayacucho 0.399 0.411
Cajamarca 0.475 0.466
Callao 0.820 0.785
Cusco 0.533 0.504
Huancavelica 0.498 0.473
Huanuco 0.469 0.414
Ica 1.115 1.083
Junin 0.768 0.731
La Libertad 0.545 0.522
Lambayeque 0.540 0.495
Lima 1.227 1.238
Loreto 0.505 0.436
Madre De Dios 1.538 1.313
Moquegua 2.590 2.641
Pasco 0.740 0.717
Piura 0.699 0.659
Puno 0.346 0.338
San Martin 0.730 0.623
Tacna 1.456 1.414
Tumbes 1.325 1.237
Ucayali 0.677 0.676
In [35]:
tbl_summ_prev_dep_sex_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:3) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/prevalencia_departamento_sexo.xlsx",
                       open = FALSE)

tbl_summ_prev_dep_sex %>%
  gt::gtsave("02_output/tables/prevalencia_departamento_sexo.docx")
In [36]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_departamento_sexo.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [37]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_departamento_sexo.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Departamento y edad

In [38]:
results_prevalencia$departamento_grupo_edad$index %>% 
  mutate(
    departamento = str_to_title(departamento),
    departamento = fct_reorder2(departamento, grupo_edad, rate)
  ) %>% 
  ggplot(aes(x = departamento, y = rate, fill = grupo_edad)) +
  geom_bar(stat = "identity") +
  theme_bw() +
  labs(title = "Monthly incidence of COVID-19 by department and age groups", 
       x = NULL, 
       y = "Monthly incidence per 1000 inhabitants",
       fill = "Sex",
       caption = paste0("Total cases reported: ", 
                        scales::number(sum(pull(results_prevalencia$departamento_grupo_edad$index_pre,
                                                count))))) +
  innovar::scale_fill_innova("blue_fall") +
  facet_wrap(vars(grupo_edad)) + 
  theme(
    axis.text.x = element_text(
      angle = 45,
      hjust = 1,
      vjust = 1
    )
  )
Figura 6: Prevalencia COVID-19 de acuerdo al departamento y edad (07-03-2020 a 17-06-2023)
In [39]:
prev_dep_edad_1k_sf <- peru_dep_sf %>% 
  rename(departamento = dep) %>% 
  inner_join(
    results_prevalencia$departamento_grupo_edad$index
  ) %>% 
  ungroup()
Joining with `by = join_by(departamento)`
In [40]:
prev_dep_edad_1k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap(
        "Monthly incidence per 1000 inhabitants",
        20
      )
    )
  ) +
  scale_fill_distiller(palette = "Oranges", # old: YlOrBr
                       direction = 1) + 
  facet_wrap(vars(grupo_edad), nrow = 1) + 
  theme_void()
Figura 7: Prevalencia COVID-19 de acuerdo al departamento y edad (07-03-2020 a 17-06-2023)
In [41]:
In [42]:
tbl_summ_prev_dep_edad_pre <- results_prevalencia$departamento_grupo_edad$index %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) %>% 
  mutate(
    departamento = str_to_title(departamento)
  ) %>% 
  pivot_wider(
    names_from = grupo_edad, 
    values_from = rate
  )

tbl_summ_prev_dep_edad <- tbl_summ_prev_dep_edad_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_prev_dep_edad
Tabla 5: Prevalencia COVID-19 de acuerdo al departamento y grupo de edad (07-03-2020 a 17-06-2023)
Departamento Under 1 Year 1 - 5 Years 6 - 11 Years 12 - 17 Years
Amazonas 1.038 0.546 0.677 1.283
Ancash 0.710 0.428 0.719 1.579
Apurimac 0.824 0.341 0.493 0.977
Arequipa 1.278 0.645 1.179 1.922
Ayacucho 0.583 0.283 0.312 0.638
Cajamarca 0.683 0.254 0.387 0.743
Callao 0.806 0.426 0.720 1.340
Cusco 0.830 0.267 0.377 0.855
Huancavelica 0.988 0.323 0.425 0.687
Huanuco 0.597 0.258 0.386 0.698
Ica 1.032 0.569 1.055 1.613
Junin 0.978 0.459 0.592 1.132
La Libertad 0.450 0.253 0.503 0.853
Lambayeque 0.487 0.232 0.469 0.876
Lima 1.200 0.578 1.151 1.902
Loreto 0.646 0.378 0.417 0.651
Madre De Dios 2.436 0.999 1.172 2.149
Moquegua 3.323 1.774 2.294 3.788
Pasco 1.362 0.465 0.616 1.121
Piura 0.759 0.376 0.676 0.982
Puno 0.844 0.248 0.253 0.470
San Martin 1.240 0.521 0.555 0.967
Tacna 1.664 0.793 1.389 2.292
Tumbes 1.712 0.857 1.179 1.800
Ucayali 0.994 0.507 0.588 1.043
In [43]:
tbl_summ_prev_dep_edad_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:5) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/prevalencia_departamento_edad.xlsx",
                       open = FALSE)

tbl_summ_prev_dep_edad %>%
  gt::gtsave("02_output/tables/prevalencia_departamento_edad.docx")
In [44]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_departamento_edad.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [45]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_departamento_edad.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Departamento, sexo y grupo de edad

In [46]:
In [47]:
tbl_summ_prev_dep_edad_sex_pre <- results_prevalencia$departamento_sexo_grupo_edad$index %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) %>% 
  pivot_wider(
    names_from = grupo_edad, 
    values_from = rate
  ) %>% 
  arrange(departamento, sexo) %>% 
  collect() %>% 
  mutate(
    departamento = str_to_title(departamento)
  ) 


tbl_summ_prev_dep_edad_sex <- tbl_summ_prev_dep_edad_sex_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )
  # gt::cols_label(
  #   departamento = gt::md("**Departamento**"),
  #   sexo = gt::md("**Sexo**")
  # ) 
  # gt::tab_style(
  #   style = gt::cell_text(weight = "bold"),
  #   locations = gt::cells_column_labels()
  # )

tbl_summ_prev_dep_edad_sex
Tabla 6: Prevalencia COVID-19 de acuerdo al departamento, edad y sexo (07-03-2020 a 17-06-2023)
Departamento Sexo Under 1 Year 1 - 5 Years 6 - 11 Years 12 - 17 Years
Amazonas Female 1.250 0.569 0.729 1.564
Amazonas Male 1.194 0.576 0.748 1.079
Ancash Female 0.815 0.445 0.702 1.768
Ancash Male 0.791 0.434 0.736 1.433
Apurimac Female 0.930 0.382 0.529 1.159
Apurimac Male 0.917 0.384 0.593 0.882
Arequipa Female 1.304 0.625 1.127 1.981
Arequipa Male 1.506 0.664 1.294 1.910
Ayacucho Female 0.692 0.284 0.310 0.761
Ayacucho Male 0.733 0.336 0.342 0.592
Cajamarca Female 0.687 0.256 0.396 0.849
Cajamarca Male 0.784 0.268 0.413 0.699
Callao Female 0.866 0.442 0.785 1.444
Callao Male 1.012 0.462 0.740 1.345
Cusco Female 0.760 0.251 0.367 0.945
Cusco Male 0.971 0.297 0.397 0.788
Huancavelica Female 1.042 0.375 0.429 0.768
Huancavelica Male 1.333 0.337 0.474 0.670
Huanuco Female 0.663 0.280 0.439 0.789
Huanuco Male 0.708 0.293 0.396 0.683
Ica Female 1.188 0.567 1.055 1.770
Ica Male 1.367 0.587 1.085 1.544
Junin Female 0.892 0.440 0.626 1.215
Junin Male 1.087 0.527 0.604 1.051
La Libertad Female 0.453 0.250 0.507 0.933
La Libertad Male 0.597 0.293 0.526 0.836
Lambayeque Female 0.515 0.232 0.467 0.992
Lambayeque Male 0.578 0.238 0.498 0.784
Lima Female 1.082 0.561 1.103 1.951
Lima Male 1.342 0.594 1.201 1.851
Loreto Female 0.732 0.475 0.477 0.800
Loreto Male 0.730 0.365 0.452 0.555
Madre De Dios Female 3.025 1.034 1.290 2.701
Madre De Dios Male 2.887 1.277 1.307 1.968
Moquegua Female 3.841 1.847 2.453 3.933
Moquegua Male 4.528 2.089 2.461 3.956
Pasco Female 1.714 0.487 0.626 1.255
Pasco Male 1.780 0.533 0.696 1.046
Piura Female 0.812 0.356 0.639 1.104
Piura Male 0.836 0.407 0.714 0.912
Puno Female 0.800 0.234 0.247 0.538
Puno Male 1.021 0.277 0.288 0.453
San Martin Female 1.265 0.555 0.554 1.200
San Martin Male 1.390 0.544 0.592 0.798
Tacna Female 1.885 0.784 1.567 2.435
Tacna Male 2.039 0.929 1.473 2.215
Tumbes Female 2.039 0.847 1.317 2.098
Tumbes Male 2.218 1.002 1.244 1.674
Ucayali Female 1.036 0.603 0.600 1.213
Ucayali Male 1.211 0.518 0.678 1.005
In [48]:
tbl_summ_prev_dep_edad_sex_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:6) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/prevalencia_departamento_edad_sexo.xlsx",
                       open = FALSE)

tbl_summ_prev_dep_edad_sex %>%
  gt::gtsave("02_output/tables/prevalencia_departamento_edad_sexo.docx")
In [49]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_departamento_edad_sexo.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [50]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_departamento_edad_sexo.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [51]:
results_prevalencia$departamento_sexo_grupo_edad$index %>% 
  mutate(
    departamento = str_to_title(departamento)
  ) %>% 
  ggplot(
    aes(
      x = departamento,
      y = rate,
      fill = sexo,
      group = sexo
    )
  ) +
  geom_area() +
  facet_wrap(vars(grupo_edad)) +
  innovar::scale_fill_innova("blue_fall") +
  labs(
    y = "Monthly incidence per 1000 inhabitants",
    x = NULL,
    title = "Monthly incidence of COVID-19 by age groups and sex",
    fill = "Sex"
  ) + 
  theme_bw() +
  theme(
    axis.text.x = element_text(
      angle = 45,
      hjust = 1,
      vjust = 1
    )
  )
Figura 8: Prevalencia COVID-19 de acuerdo al departamento, sexo y edad (07-03-2020 a 17-06-2023)

Departamento y olas

In [52]:
results_prevalencia$departamento_ola_covid$index %>% 
  drop_na(ola_covid) %>% 
  mutate(
    departamento = str_to_title(departamento),
    departamento = fct_reorder2(departamento, ola_covid, rate)
  ) %>% 
  ggplot(aes(x = departamento, y = rate, fill = ola_covid)) +
  geom_bar(stat = "identity") +
  theme_bw() +
  labs(title = "Monthly incidence of COVID-19 by department and waves", 
       x = NULL, 
       y = "Monthly incidence per 1000 inhabitants",
       fill = "Sexo",
       caption = paste0("Total cases reported: ", 
                        scales::number(sum(pull(results_prevalencia$departamento_ola_covid$index_pre,
                                                count))))) +
  innovar::scale_fill_innova("blue_fall") +
  facet_wrap(vars(ola_covid)) + 
  theme(
    axis.text.x = element_text(
      angle = 75,
      hjust = 1,
      vjust = 1
    ),
    legend.position = "bottom"
  )
Figura 9: Prevalencia COVID-19 de acuerdo al departamento y olas covid (07-03-2020 a 17-06-2023)
In [53]:
prev_dep_olas_100k <- results_prevalencia$departamento_ola_covid$index %>% 
  drop_na(ola_covid) %>% 
  bind_rows(
    results_prevalencia$departamento$index %>% 
      mutate(ola_covid = "Overall")
  ) %>% 
  mutate(
    ola_covid = str_wrap(ola_covid, 20),
    ola_covid = fct_relevel(ola_covid,
                            "Overall")
  ) %>% 
  arrange(ola_covid)


prev_mes_dep_olas_1k_sf <- peru_dep_sf %>%
  rename(departamento = dep) %>% 
  left_join(
    prev_dep_olas_100k
  ) %>%
  ungroup()
Joining with `by = join_by(departamento)`
In [54]:
prev_mes_dep_olas_1k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(str_wrap("Monthly incidence per 1000 inhabitants", 20))
  ) +
  scale_fill_distiller(palette = "Oranges", # Old: YlOrBr
                       direction = 1) + 
  facet_wrap(vars(ola_covid), nrow = 1) + 
  theme_void()
Figura 10: Prevalencia COVID-19 de acuerdo al departamento por Olas (07-03-2020 a 17-06-2023)
In [55]:
In [56]:
tbl_summ_prev_dep_ola_pre <- results_prevalencia$departamento_ola_covid$index %>% 
  drop_na(ola_covid) %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) %>% 
  mutate(
    departamento = str_to_title(departamento)
  ) %>% 
  pivot_wider(
    names_from = ola_covid, 
    values_from = rate
  )

tbl_summ_prev_dep_ola <- tbl_summ_prev_dep_ola_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_prev_dep_ola
Tabla 7: Prevalencia COVID-19 de acuerdo al departamento y Olas COVID (07-03-2020 a 17-06-2023)
Departamento 1 (Mar – Oct 2020) 2 (Nov 2020 – Oct 2021) 3 (Nov 2021 – Apr 2022) 4 (May 2022 – Oct 2022) 5 (Nov 2022 – Jun 2023)
Amazonas 1.800 0.565 1.067 0.812 0.079
Ancash 0.640 0.636 2.125 1.280 0.365
Apurimac 0.492 0.532 1.290 0.825 0.106
Arequipa 0.627 0.773 3.446 2.049 0.412
Ayacucho 0.445 0.349 0.816 0.387 0.061
Cajamarca 0.513 0.431 0.820 0.608 0.037
Callao 0.798 0.966 1.404 0.562 0.190
Cusco 0.285 0.429 1.201 0.728 0.187
Huancavelica 0.710 0.201 1.072 0.496 0.132
Huanuco 0.684 0.248 0.875 0.411 0.087
Ica 1.653 0.615 2.331 1.113 0.335
Junin 0.467 0.735 1.461 1.109 0.202
La Libertad 0.418 0.378 1.321 0.647 0.139
Lambayeque 0.520 0.323 1.214 0.582 0.195
Lima 1.082 0.809 2.943 1.662 0.412
Loreto 1.057 0.405 0.515 0.267 0.043
Madre De Dios 2.737 0.732 1.022 1.772 0.494
Moquegua 2.671 1.996 5.052 3.654 0.887
Pasco 0.751 0.513 1.435 0.915 0.259
Piura 0.547 0.480 2.006 0.643 0.098
Puno 0.219 0.199 0.893 0.488 0.119
San Martin 1.104 0.669 0.583 0.600 0.146
Tacna 1.267 0.841 4.048 1.382 0.460
Tumbes 1.724 0.920 2.141 1.300 0.389
Ucayali 1.546 0.458 0.411 0.423 0.199
In [57]:
tbl_summ_prev_dep_ola_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:6) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/prevalencia_departamento_ola.xlsx",
                       open = FALSE)

tbl_summ_prev_dep_ola %>%
  gt::gtsave("02_output/tables/prevalencia_departamento_ola.docx")
In [58]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_departamento_ola.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [59]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_departamento_ola.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Regiones

In [60]:
results_prevalencia$region$index %>% 
  ggplot(aes(x = region, y = rate, fill = region)) +
  geom_bar(stat = "identity") +
  theme_bw() +
  labs(title = "Monthly incidence of COVID-19 by natural regions", 
       x = NULL, 
       y = "Monthly incidence per 1000 inhabitants",
       fill = "Sex",
       caption = paste0("Total cases reported: ", 
                        scales::number(sum(pull(results_prevalencia$region$index_pre,
                                                count))))) +
  innovar::scale_fill_innova("blue_fall") +
  theme(
    legend.position = "bottom"
  )
Figura 11: Prevalencia COVID-19 de acuerdo a la región (07-03-2020 a 17-06-2023)
In [61]:
prev_reg_1k_sf <- peru_reg_sf %>% 
  inner_join(
    results_prevalencia$region$index
  )
Joining with `by = join_by(region)`
In [62]:
prev_reg_1k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap("Monthly incidence per 1000 inhabitants", 
               20)
    )
  ) +
  ggsflabel::geom_sf_label(aes(label = region)) +
  scale_fill_distiller(palette = "Oranges", # YlOrBr
                       direction = 1) + 
  theme_void()
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data
Figura 12: Prevalencia COVID-19 de acuerdo a la región (07-03-2020 a 17-06-2023)
In [63]:
In [64]:
tbl_summ_prev_reg_pre <- results_prevalencia$region$index %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) 

tbl_summ_prev_reg <- tbl_summ_prev_reg_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_prev_reg
Tabla 8: Prevalencia COVID-19 de acuerdo a la región (07-03-2020 a 17-06-2023)
Region Rate
Coast 1.008
Highlands 0.488
Jungle 0.578
In [65]:
tbl_summ_prev_reg_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:2) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/prevalencia_region.xlsx",
                       open = FALSE)

tbl_summ_prev_reg %>%
  gt::gtsave("02_output/tables/prevalencia_region.docx")
In [66]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_region.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [67]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_region.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Macrorregión

In [68]:
results_prevalencia$macrorregion$index %>% 
  ggplot(aes(x = macrorregion, y = rate, fill = macrorregion)) +
  geom_bar(stat = "identity") +
  theme_bw() +
  labs(title = "Monthly incidence of COVID-19 by macroregions", 
       x = NULL, 
       y = "Monthly incidence per 1000 inhabitants",
       fill = "Sex",
       caption = paste0("Total cases reported: ", 
                        scales::number(sum(pull(results_prevalencia$macrorregion$index_pre,
                                                count))))) +
  innovar::scale_fill_innova("blue_fall") +
  theme(
    legend.position = "bottom"
  )
Figura 13: Prevalencia COVID-19 de acuerdo a la macrorregión (07-03-2020 a 17-06-2023)
In [69]:
prev_macro_1k_sf <- peru_macro_sf %>% 
  inner_join(
    results_prevalencia$macrorregion$index
  )
Joining with `by = join_by(macrorregion)`
In [70]:
prev_macro_map <- prev_macro_1k_sf %>%
  mutate(
    macrorregion = case_match(
      macrorregion,
      "Metropolitan Lima and Callao" ~ "Met Lima & Callao",
      .default = macrorregion
    ),
    macrorregion = str_wrap(macrorregion, width = 15)
  ) %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  ggsflabel::geom_sf_label_repel(aes(label = macrorregion),
                                 force = 100,
                                 seed = 2024) +
  guides(
    fill = guide_legend(
      str_wrap("Monthly incidence per 1000 inhabitants", 
               20)
    )
  ) +
  scale_fill_distiller(palette = "Oranges", # Old: YlOrBr
                       direction = 1) + 
  theme_void()

prev_macro_map
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data
Figura 14: Prevalencia COVID-19 de acuerdo a la macrorregión (07-03-2020 a 17-06-2023)
In [71]:
In [72]:
tbl_summ_prev_macro_pre <- results_prevalencia$macrorregion$index %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) 

tbl_summ_prev_macro <- tbl_summ_prev_macro_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_prev_macro
Tabla 9: Prevalencia COVID-19 de acuerdo a la macrorregión (07-03-2020 a 17-06-2023)
Macrorregion Rate
Center 0.833
East 0.555
Metropolitan Lima and Callao 1.126
North 0.564
South 0.784
In [73]:
tbl_summ_prev_macro_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:2) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/prevalencia_macrorregion.xlsx",
                       open = FALSE)

tbl_summ_prev_macro %>%
  gt::gtsave("02_output/tables/prevalencia_macrorregion.docx")
In [74]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_macrorregion.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [75]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_macrorregion.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Distrito y sexo

In [76]:
prev_distr_sex_1k_sf <- Peru %>%
  inner_join(
    results_prevalencia$distrito_sexo$index
  ) %>%
  ungroup()
Joining with `by = join_by(ubigeo)`
In [77]:
prev_distr_sex_1k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate), 
          linewidth = 0.01,
          color = "grey75") +
  guides(
    fill = guide_legend(
      str_wrap(
        "Monthly incidence per 1000 inhabitants",
        20
      )
    )
  ) +
  # scale_fill_distiller(palette = "YlOrBr",
  #                      direction = 1) + 
  scale_fill_gradientn(
    colors = scales::pal_brewer("seq", "Oranges", 1)(6),
    # colors = c("#ffffcc", "#fed976", "#feb24c", "#fc4e2a", "#e31a1c", "#b10026"),
    values = scales::rescale(c(0, 25, 50, 75, 
                               100, max(prev_distr_sex_1k_sf$rate))),
    breaks = c(0, 25, 50, 75, 
               100, max(prev_distr_sex_1k_sf$rate)),
    labels = c("0", "25", "50", "75", "100", "Max"),
    limits = c(0,
               max(prev_distr_sex_1k_sf$rate))
  ) +
  facet_wrap(vars(sexo)) + 
  theme_void()
Figura 15: Prevalencia COVID-19 de acuerdo al distrito y sexo (07-03-2020 a 17-06-2023)
In [78]:
In [79]:
set.seed(2024)

tbl_summ_prev_distr_sex_pre <- results_prevalencia$distrito_sexo$index %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) %>% 
  mutate(
    across(departamento:distrito,
           str_to_title)
  ) %>% 
  pivot_wider(
    names_from = sexo, 
    values_from = rate
  ) %>% 
  slice_sample(n = 2, by = c(departamento)) 

tbl_summ_prev_distr_sex <- tbl_summ_prev_distr_sex_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_prev_distr_sex
Tabla 10: Prevalencia COVID-19 de acuerdo al distrito y sexo (07-03-2020 a 17-06-2023) [Tabla Recortada]
Ubigeo Departamento Provincia Distrito Female Male
010611 Amazonas Rodriguez De Mendoza Totora 24.735 36.316
010503 Amazonas Luya Cocabamba NA 2.481
020610 Ancash Carhuaz Tinco 2.571 3.203
022005 Ancash Yungay Quillo 0.376 0.773
030401 Apurimac Aymaraes Chalhuanca 4.480 2.090
030304 Apurimac Antabamba Juan Espinoza Medrano 4.294 4.658
040111 Arequipa Arequipa Mollebaya 1.943 1.523
040119 Arequipa Arequipa San Juan De Tarucani 6.593 5.028
050405 Ayacucho Huanta Luricocha 2.052 2.454
050701 Ayacucho Parinacochas Coracora 1.331 1.016
060203 Cajamarca Cajabamba Condebamba 0.788 0.934
060407 Cajamarca Chota Cochabamba 2.316 1.715
070102 Callao Callao Bellavista 4.073 4.150
070105 Callao Callao La Punta 6.824 6.899
080702 Cusco Chumbivilcas Capacmarca 1.946 3.652
080402 Cusco Calca Coya 2.558 1.585
090312 Huancavelica Angaraes Secclla 3.268 3.123
090722 Huancavelica Tayacaja Pichos 4.280 6.232
100101 Huanuco Huanuco Huanuco 0.844 0.865
100508 Huanuco Huamalies Punchao 1.835 1.927
110507 Ica Pisco San Clemente 0.816 0.959
110203 Ica Chincha Chavin 9.205 8.000
120203 Junin Concepcion Andamarca 0.979 1.201
120403 Junin Jauja Apata 2.323 2.686
130703 La Libertad Pacasmayo Jequetepeque 2.630 2.368
130906 La Libertad Sanchez Carrion Sanagoran 0.739 0.363
140120 Lambayeque Chiclayo Tuman 0.571 0.545
140203 Lambayeque Ferrenafe Incahuasi 0.406 0.292
150726 Lima Huarochiri Sangallaya 83.026 65.134
150902 Lima Oyon Andajes NA 23.810
160104 Loreto Maynas Indiana 1.264 1.209
160107 Loreto Maynas Napo 3.407 3.594
170104 Madre De Dios Tambopata Laberinto 2.944 3.035
170301 Madre De Dios Tahuamanu Inapari 8.508 5.758
180211 Moquegua General Sanchez Cerro Yunga 13.158 12.442
180103 Moquegua Mariscal Nieto Cuchumbaya 32.520 14.813
190304 Pasco Oxapampa Palcazu 1.247 1.863
190102 Pasco Pasco Huachon 1.705 1.992
200704 Piura Talara Lobitos 12.709 6.821
200604 Piura Sullana Lancones 1.437 1.542
210606 Puno Huancane Rosaspata NA 2.012
211207 Puno Sandia San Juan Del Oro NA 2.206
220801 San Martin Rioja Rioja 1.942 1.700
220103 San Martin Moyobamba Habana 3.920 2.976
230101 Tacna Tacna Tacna 2.896 2.915
230106 Tacna Tacna Pachia 5.183 11.628
240104 Tumbes Tumbes Pampas De Hospital 3.231 3.748
240203 Tumbes Contralmirante Villar Canoas De Punta Sal 1.191 1.020
250305 Ucayali Padre Abad Alexander Von Humboldt 0.899 0.858
250303 Ucayali Padre Abad Curimana 2.193 1.950
In [80]:
tbl_summ_prev_distr_sex_pre <- results_prevalencia$distrito_sexo$index %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) %>% 
  mutate(
    across(departamento:distrito,
           str_to_title)
  ) %>% 
  pivot_wider(
    names_from = sexo, 
    values_from = rate
  )

tbl_summ_prev_distr_sex <- tbl_summ_prev_distr_sex_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )


tbl_summ_prev_distr_sex_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:6) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/prevalencia_distrito_sexo.xlsx",
                       open = FALSE)

tbl_summ_prev_distr_sex %>%
  gt::gtsave("02_output/tables/prevalencia_distrito_sexo.docx")
In [81]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_distrito_sexo.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [82]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_distrito_sexo.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Distrito y edad

In [83]:
prev_distr_edad_mother <- peru_mother %>% 
  select(dep:ubigeo) %>% 
  collect() %>% 
  crossing(
    grupo_edad = levels(results_prevalencia$distrito_grupo_edad$index$grupo_edad)
  ) %>% 
  mutate(
    grupo_edad = fct_relevel(grupo_edad,
                             "Under 1 year",
                             "1 - 5 years",
                             "6 - 11 years")
  )

prev_distr_edad_100k <- prev_distr_edad_mother %>% 
  left_join(results_prevalencia$distrito_grupo_edad$index)
Joining with `by = join_by(ubigeo, grupo_edad)`
prev_distr_edad_1k_sf <- Peru %>%
  inner_join(
    prev_distr_edad_100k
  ) %>%
  ungroup()
Joining with `by = join_by(ubigeo, dep, prov, distr)`
In [84]:
prev_distr_edad_1k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate), 
          size = 0.01,
          color = "grey70") +
  guides(
    fill = guide_legend(
      str_wrap("Monthly incidence per 1000 inhabitants",
               20)
    )
  ) +
  # scale_fill_distiller(palette = "YlOrBr",
  #                      direction = 1) +
  # scale_fill_gradient(
  #   low = "#FEEDDE",
  #   high = "#A63603",
  #   na.value = "white"
  # ) +
  scale_fill_gradientn(
    colors = scales::pal_brewer("seq", "Oranges", 1)(6),
    # colors = c("#ffffcc", "#fed976", "#feb24c", "#fc4e2a", "#e31a1c", "#b10026"),
    values = scales::rescale(c(0, 25, 50, 75,
                               100, max(prev_distr_edad_1k_sf$rate, na.rm = TRUE))),
    breaks = c(0, 25, 50, 75,
               100, max(prev_distr_edad_1k_sf$rate, na.rm = TRUE)),
    labels = c("0", "25", "50", "75", "100", "Max"),
    limits = c(0,
               max(prev_distr_edad_1k_sf$rate, na.rm = TRUE)),
    na.value = "grey70"
  ) +
  facet_wrap(vars(grupo_edad), nrow = 1) + 
  theme_void()
Figura 16: Prevalencia COVID-19 de acuerdo al distrito y edad (07-03-2020 a 17-06-2023)
In [85]:
In [86]:
set.seed(2024)

tbl_summ_prev_distr_edad_pre <- results_prevalencia$distrito_grupo_edad$index %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) %>% 
  mutate(
    across(departamento:distrito,
           str_to_title)
  ) %>% 
  pivot_wider(
    names_from = grupo_edad, 
    values_from = rate
  ) %>% 
  slice_sample(n = 2, by = c(departamento)) 

tbl_summ_prev_distr_edad <- tbl_summ_prev_distr_edad_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_prev_distr_edad
Tabla 11: Prevalencia COVID-19 de acuerdo al distrito y grupo de edad (07-03-2020 a 17-06-2023) [Tabla Recortada]
Ubigeo Departamento Provincia Distrito Under 1 Year 1 - 5 Years 6 - 11 Years 12 - 17 Years
010611 Amazonas Rodriguez De Mendoza Totora NA NA NA 34.691
010503 Amazonas Luya Cocabamba NA NA NA 3.846
020610 Ancash Carhuaz Tinco NA 5.764 3.030 3.580
022005 Ancash Yungay Quillo NA 0.715 NA 0.787
030401 Apurimac Aymaraes Chalhuanca 11.905 3.059 2.180 7.216
030304 Apurimac Antabamba Juan Espinoza Medrano NA 4.673 NA 11.825
040111 Arequipa Arequipa Mollebaya 16.949 2.970 1.328 4.481
040119 Arequipa Arequipa San Juan De Tarucani NA NA 9.157 12.381
050405 Ayacucho Huanta Luricocha 8.130 3.266 2.010 3.484
050701 Ayacucho Parinacochas Coracora NA 1.146 1.192 2.067
060203 Cajamarca Cajabamba Condebamba 4.691 0.702 1.475 1.157
060407 Cajamarca Chota Cochabamba 11.236 1.946 1.826 2.772
070102 Callao Callao Bellavista 4.602 2.672 4.106 6.111
070105 Callao Callao La Punta 19.608 NA 13.525 14.205
080702 Cusco Chumbivilcas Capacmarca NA NA 5.144 2.822
080402 Cusco Calca Coya NA 3.058 NA 3.012
090312 Huancavelica Angaraes Secclla NA 5.597 5.682 2.045
090722 Huancavelica Tayacaja Pichos NA 4.348 29.046 6.703
100101 Huanuco Huanuco Huanuco 1.534 0.637 0.731 1.402
100508 Huanuco Huamalies Punchao 15.385 6.920 NA 3.058
110507 Ica Pisco San Clemente 2.003 0.808 1.129 1.400
110203 Ica Chincha Chavin NA 18.109 14.454 11.111
120203 Junin Concepcion Andamarca 8.696 NA NA 2.218
120403 Junin Jauja Apata NA NA 2.646 5.139
130703 La Libertad Pacasmayo Jequetepeque 15.179 2.928 3.027 3.915
130906 La Libertad Sanchez Carrion Sanagoran NA 0.532 0.602 0.641
140120 Lambayeque Chiclayo Tuman 2.053 0.695 0.667 0.787
140203 Lambayeque Ferrenafe Incahuasi NA NA 0.590 0.524
150726 Lima Huarochiri Sangallaya 125.000 57.439 105.392 130.142
150902 Lima Oyon Andajes NA NA NA 31.250
160104 Loreto Maynas Indiana 3.650 1.760 1.365 1.589
160107 Loreto Maynas Napo 9.907 5.460 3.771 3.805
170104 Madre De Dios Tambopata Laberinto 16.000 4.573 3.396 4.286
170301 Madre De Dios Tahuamanu Inapari 20.000 6.760 9.331 13.123
180211 Moquegua General Sanchez Cerro Yunga NA 17.279 11.494 23.325
180103 Moquegua Mariscal Nieto Cuchumbaya NA NA 50.000 51.656
190304 Pasco Oxapampa Palcazu 5.872 1.312 1.726 2.797
190102 Pasco Pasco Huachon NA 4.237 3.008 2.137
200704 Piura Talara Lobitos NA NA 8.264 18.895
200604 Piura Sullana Lancones 4.484 1.561 2.362 2.274
210606 Puno Huancane Rosaspata NA NA NA 3.145
211207 Puno Sandia San Juan Del Oro 16.949 NA NA 4.180
220801 San Martin Rioja Rioja 5.768 1.860 1.369 2.868
220103 San Martin Moyobamba Habana NA 4.831 5.943 6.418
230101 Tacna Tacna Tacna 4.890 1.680 3.095 4.215
230106 Tacna Tacna Pachia 25.000 9.059 10.000 5.128
240104 Tumbes Tumbes Pampas De Hospital 8.352 3.956 4.532 4.919
240203 Tumbes Contralmirante Villar Canoas De Punta Sal NA 1.439 1.761 1.992
250305 Ucayali Padre Abad Alexander Von Humboldt NA NA NA 1.445
250303 Ucayali Padre Abad Curimana 14.620 3.092 1.793 2.774
In [87]:
tbl_summ_prev_distr_edad_pre <- results_prevalencia$distrito_grupo_edad$index %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) %>% 
  mutate(
    across(departamento:distrito,
           str_to_title)
  ) %>% 
  pivot_wider(
    names_from = grupo_edad, 
    values_from = rate
  ) 

tbl_summ_prev_distr_edad <- tbl_summ_prev_distr_edad_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )


tbl_summ_prev_distr_edad_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:6) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/prevalencia_distrito_edad.xlsx",
                       open = FALSE)

tbl_summ_prev_distr_edad %>%
  gt::gtsave("02_output/tables/prevalencia_distrito_edad.docx")
In [88]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_distrito_edad.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [89]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_distrito_edad.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Distrital y pobreza

In [90]:
library(biscale)
In [91]:
prev_distr_pobr_1k_sf <- Peru %>%
  inner_join(
    results_prevalencia$distrito_cuartil_pobreza$index
  ) %>%
  ungroup()
Joining with `by = join_by(ubigeo)`
In [92]:
prev_distr_pobr_biscale <- bi_class(prev_distr_pobr_1k_sf,
  x = rate,
  y = cuartil_pobreza,
  style = "quantile", dim = 4
)
In [93]:
custom_pal <- c(
  "1-1" = "#dae7f3", # Azul muy claro - Bajo en COVID, bajo en pobreza
  "2-1" = "#b6cee1", # Azul medio claro - Bajo en COVID, moderado en pobreza
  "3-1" = "#92b5cf", # Azul medio - Bajo en COVID, alto en pobreza
  "4-1" = "#6e9cbd", # Azul oscuro - Bajo en COVID, muy alto en pobreza
  
  
  "1-2" = "#d8f2bc", # Verde muy claro - Alto en COVID, bajo en pobreza
  "2-2" = "#a9d985", # Verde medio claro - Alto en COVID, moderado en pobreza
  "3-2" = "#7bc04e", # Verde medio - Alto en COVID, alto en pobreza
  "4-2" = "#4ca717", # Verde oscuro - Alto en COVID, muy alto en pobreza
  
  
  "1-3" = "#f8d4a0", # Naranja muy claro - Bajo en pobreza, bajo en COVID
  "2-3" = "#f6b86c", # Naranja medio claro - Moderado en pobreza, bajo en COVID
  "3-3" = "#f59b38", # Naranja medio - Alto en pobreza, bajo en COVID
  "4-3" = "#f37e04", # Naranja oscuro - Muy alto en pobreza, bajo en COVID
  

  
  "1-4" = "#f8bfcb", # Rosa muy claro - Muy alto en COVID, bajo en pobreza
  "2-4" = "#f196a0", # Rosa medio claro - Muy alto en COVID, moderado en pobreza
  "3-4" = "#ea6d75", # Rosa medio - Muy alto en COVID, alto en pobreza
  "4-4" = "#e3444a"  # Rosa oscuro - Muy alto en COVID, muy alto en pobreza
)

legend <- bi_legend(
  pal = custom_pal,
  dim = 4,
  xlab = "Incidence",
  ylab = "Poverty Quartiles",
  size = 5
)

ggmap <- prev_distr_pobr_biscale %>%
  ggplot() +
  geom_sf(aes(fill = bi_class), 
          linewidth = 0.01,
          show.legend = FALSE) +
  bi_scale_fill(pal = custom_pal, dim = 4) +
  # bi_scale_color(pal = "GrPink", dim = 3) +
  bi_theme()

library(cowplot)

Adjuntando el paquete: 'cowplot'
The following object is masked from 'package:lubridate':

    stamp
finalPlot <- ggdraw(ggmap) +
  # draw_plot(ggmap, 0, 0, 1.5, 1.5) +
  draw_plot(legend, 0.1, 0.25, 0.27, 0.27)
finalPlot
Figura 17: Prevalencia COVID-19 de acuerdo al distrito y cuartil de pobreza(07-03-2020 a 17-06-2023)
In [94]:
positivos_quartiles <- results_prevalencia$distrito_cuartil_pobreza$index %>% 
  select(prevalencia_promedio = rate, departamento, cuartil_pobreza) %>% 
  gtsummary::tbl_summary(
    by = cuartil_pobreza
  ) %>% 
  gtsummary::add_overall(last = TRUE) %>% 
  gtsummary::modify_header(label = "**Variables**") %>%
  gtsummary::bold_labels()
25 observations missing `cuartil_pobreza` have been removed. To include these observations, use `forcats::fct_na_value_to_level()` on `cuartil_pobreza` column before passing to `tbl_summary()`.
In [95]:
positivos_quartiles
Tabla 12: Cuartiles de pobreza y casos positivos menores de 18 años (07-03-2020 a 17-06-2023)
Variables 1, N = 4181 2, N = 6461 3, N = 5311 4, N = 1011 Overall, N = 1,6961
prevalencia_promedio 1.7 (1.0, 3.7) 1.9 (1.0, 4.0) 1.3 (0.8, 2.7) 0.8 (0.5, 1.7) 1.6 (0.9, 3.3)
departamento




    AMAZONAS 2 (0.5%) 37 (5.7%) 33 (6.2%) 2 (2.0%) 74 (4.4%)
    ANCASH 15 (3.6%) 68 (11%) 55 (10%) 10 (9.9%) 148 (8.7%)
    APURIMAC 2 (0.5%) 25 (3.9%) 40 (7.5%) 0 (0%) 67 (4.0%)
    AREQUIPA 59 (14%) 32 (5.0%) 8 (1.5%) 0 (0%) 99 (5.8%)
    AYACUCHO 5 (1.2%) 35 (5.4%) 49 (9.2%) 10 (9.9%) 99 (5.8%)
    CAJAMARCA 1 (0.2%) 11 (1.7%) 51 (9.6%) 53 (52%) 116 (6.8%)
    CALLAO 4 (1.0%) 2 (0.3%) 0 (0%) 0 (0%) 6 (0.4%)
    CUSCO 13 (3.1%) 54 (8.4%) 38 (7.2%) 1 (1.0%) 106 (6.3%)
    HUANCAVELICA 5 (1.2%) 41 (6.3%) 37 (7.0%) 3 (3.0%) 86 (5.1%)
    HUANUCO 8 (1.9%) 32 (5.0%) 33 (6.2%) 1 (1.0%) 74 (4.4%)
    ICA 41 (9.8%) 1 (0.2%) 0 (0%) 0 (0%) 42 (2.5%)
    JUNIN 29 (6.9%) 78 (12%) 11 (2.1%) 0 (0%) 118 (7.0%)
    LA LIBERTAD 11 (2.6%) 25 (3.9%) 29 (5.5%) 10 (9.9%) 75 (4.4%)
    LAMBAYEQUE 23 (5.5%) 12 (1.9%) 2 (0.4%) 1 (1.0%) 38 (2.2%)
    LIMA 103 (25%) 45 (7.0%) 1 (0.2%) 0 (0%) 149 (8.8%)
    LORETO 2 (0.5%) 12 (1.9%) 38 (7.2%) 1 (1.0%) 53 (3.1%)
    MADRE DE DIOS 11 (2.6%) 0 (0%) 0 (0%) 0 (0%) 11 (0.6%)
    MOQUEGUA 11 (2.6%) 8 (1.2%) 0 (0%) 0 (0%) 19 (1.1%)
    PASCO 2 (0.5%) 12 (1.9%) 14 (2.6%) 1 (1.0%) 29 (1.7%)
    PIURA 13 (3.1%) 27 (4.2%) 20 (3.8%) 4 (4.0%) 64 (3.8%)
    PUNO 2 (0.5%) 29 (4.5%) 64 (12%) 4 (4.0%) 99 (5.8%)
    SAN MARTIN 21 (5.0%) 48 (7.4%) 7 (1.3%) 0 (0%) 76 (4.5%)
    TACNA 12 (2.9%) 7 (1.1%) 0 (0%) 0 (0%) 19 (1.1%)
    TUMBES 13 (3.1%) 0 (0%) 0 (0%) 0 (0%) 13 (0.8%)
    UCAYALI 10 (2.4%) 5 (0.8%) 1 (0.2%) 0 (0%) 16 (0.9%)
1 Median (IQR); n (%)
In [96]:
positivos_quartiles %>% 
  gtsummary::as_hux_xlsx("02_output/tables/prevalencia_distritos_pobreza_descriptivos_by_dep.xlsx")

positivos_quartiles %>%
  gtsummary::as_flex_table() %>%
  flextable::save_as_docx(path = "02_output/tables/prevalencia_distritos_pobreza_descriptivos_by_dep.docx")
In [97]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_distritos_pobreza_descriptivos_by_dep.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [98]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_distritos_pobreza_descriptivos_by_dep.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [99]:
results_per_month_prevalencia$cuartil_pobreza$index %>% 
  drop_na() %>% 
  mutate(
    time = make_date(anio, mes, "1")
  ) %>% 
  ggplot(
    aes(x = time,
        y = rate,
        color = cuartil_pobreza)
  ) +
  geom_line(linewidth = 1) +
  innovar::scale_color_innova("jama") +
  scale_x_date(
    limits = c(ymd("2020-03-01"), ymd("2023-07-01")),
    breaks = seq(from = ceiling_date(ymd("2020-03-01"), "month"),
                 to = floor_date(ymd("2023-07-01"), "month"),
                 by = "2 months"), 
    # date_breaks = "2 month",
    date_labels = "%b %Y"
  ) +
  labs(
    y = NULL,
    x = NULL,
    title = "Monthly incidence of COVID-19",
    color = "Poverty Quartiles"
  ) + 
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45
    )
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-03-01"), 
    xmax = as.Date("2020-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2020-07-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "First wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-11-01"), 
    xmax = as.Date("2021-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2021-04-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Second wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2021-11-01"), 
    xmax = as.Date("2022-04-30"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-02-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Third wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2022-05-01"), 
    xmax = as.Date("2022-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-08-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Fourth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2022-11-01"), 
    xmax = as.Date("2023-07-01"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2023-03-01"),
    y = Inf, # Posición vertical del texto
    label = "Fifth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  )
Figura 18: Prevalencia COVID-19 de acuerdo al cuartil de pobreza(07-03-2020 a 17-06-2023)

Distrito Lima

In [100]:
total_cases_distr_lim_callao <- results_prevalencia$distrito$index_pre %>% 
  filter(provincia %in% c("LIMA", "CALLAO")) %>% 
  pull(count) %>% 
  sum()

results_prevalencia$distrito$index %>% 
  filter(provincia %in% c("LIMA", "CALLAO")) %>% 
  mutate(
    distrito = str_to_title(distrito), 
    distrito = fct_reorder(distrito, rate)
  ) %>% 
  ggplot(aes(y = distrito, x = rate)) +
  geom_bar(stat = "identity",
           color = "black",
           fill = "grey80") +
  theme_bw() +
  labs(title = "Monthly incidence of COVID-19 by districts of metropolitan lima", 
       x = NULL, 
       y = "Monthly incidence per 1000 inhabitants",
       caption = paste0("Total cases reported: ", 
                        scales::number(total_cases_distr_lim_callao))) +
  innovar::scale_fill_innova("blue_fall") +
  theme(
    legend.position = "bottom"
  )
Figura 19: Prevalencia COVID-19 de acuerdo a los distritos de lima metropolitana (07-03-2020 a 17-06-2023)
In [101]:
prev_lima_distr_1k_sf <- Peru %>% 
  inner_join(
    results_prevalencia$distrito$index %>% 
      filter(provincia %in% c("LIMA", "CALLAO"))
  )
Joining with `by = join_by(ubigeo)`
In [102]:
prev_lima_distr_1k_sf %>%
  mutate(
    label = case_when(
      rate > 5 ~ str_to_title(distrito)
    )
  ) %>% 
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap("Monthly incidence per 1000 inhabitants", 
               20)
    )
  ) +
  ggsflabel::geom_sf_label_repel(aes(label = label),
                                 force = 10,
                                 size = 2.45,
                                 box.padding = 0.75,
                                 seed = 2024) +
  scale_fill_distiller(palette = "Oranges", # Old: YlOrBr
                       direction = 1) + 
  theme_void()
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data
Warning: Removed 43 rows containing missing values or values outside the scale range
(`geom_label_repel()`).
Figura 20: Prevalencia COVID-19 de acuerdo a los distritos de lima metropolitana (07-03-2020 a 17-06-2023)
In [103]:
In [104]:
tbl_summ_prev_lima_distr_pre <- results_prevalencia$distrito$index %>% 
      filter(provincia %in% c("LIMA", "CALLAO")) %>% 
  mutate(
    across(
      departamento:distrito,
      str_to_title
    ),
    rate = formattable::digits(rate, 3)
  ) %>% 
  select(-departamento)

tbl_summ_prev_lima_distr <- tbl_summ_prev_lima_distr_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_prev_lima_distr
Tabla 13: Prevalencia COVID-19 de acuerdo a los distritos de lima metropolitana (07-03-2020 a 17-06-2023)
Ubigeo Provincia Distrito Rate
070101 Callao Callao 0.801
070102 Callao Bellavista 3.890
070104 Callao La Perla 1.065
070105 Callao La Punta 5.831
070106 Callao Ventanilla 0.483
070107 Callao Mi Peru 0.459
150101 Lima Lima 5.294
150102 Lima Ancon 0.439
150103 Lima Ate 0.692
150104 Lima Barranco 2.611
150105 Lima Brena 1.485
150106 Lima Carabayllo 0.445
150107 Lima Chaclacayo 2.267
150108 Lima Chorrillos 1.045
150109 Lima Cieneguilla 0.987
150110 Lima Comas 0.676
150111 Lima El Agustino 1.038
150112 Lima Independencia 0.723
150113 Lima Jesus Maria 9.348
150114 Lima La Molina 2.844
150115 Lima La Victoria 1.459
150116 Lima Lince 2.933
150117 Lima Los Olivos 1.048
150118 Lima Lurigancho 0.772
150119 Lima Lurin 0.659
150120 Lima Magdalena Del Mar 8.608
150121 Lima Pueblo Libre 2.776
150122 Lima Miraflores 4.366
150123 Lima Pachacamac 0.943
150124 Lima Pucusana 1.240
150125 Lima Puente Piedra 0.425
150126 Lima Punta Hermosa 0.929
150127 Lima Punta Negra 1.820
150128 Lima Rimac 1.172
150129 Lima San Bartolo 2.044
150130 Lima San Borja 3.594
150131 Lima San Isidro 5.130
150132 Lima San Juan De Lurigancho 0.550
150133 Lima San Juan De Miraflores 0.827
150134 Lima San Luis 1.712
150135 Lima San Martin De Porres 0.726
150136 Lima San Miguel 2.326
150137 Lima Santa Anita 0.794
150138 Lima Santa Maria Del Mar 5.405
150139 Lima Santa Rosa 0.478
150140 Lima Santiago De Surco 2.310
150141 Lima Surquillo 2.539
150142 Lima Villa El Salvador 0.735
150143 Lima Villa Maria Del Triunfo 0.818
In [105]:
tbl_summ_prev_lima_distr_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:4) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/prevalencia_lima_distrito.xlsx",
                       open = FALSE)

tbl_summ_prev_lima_distr %>%
  gt::gtsave("02_output/tables/prevalencia_lima_distrito.docx")
In [106]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_lima_distrito.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [107]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_lima_distrito.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Fallecidos - Mortalidad

In [108]:
fallecidos_total <- fallecidos_total %>% 
  filter(
    edad_declarada < 18,
    fecha_fallecimiento <= max_positivos_0723
  ) %>% 
  mutate(
    dep.code = str_sub(ubigeo, 1, 2),
    overall = "overall"
  ) 

range_fallecidos <- fallecidos_total %>% 
  summarise(
    min = min(fecha_fallecimiento),
    max = max(fecha_fallecimiento)
  ) %>% 
  collect() %>% 
  mutate(
    min = format(min, "%d-%m-%Y"),
    max = format(max, "%d-%m-%Y"),
    fecha = paste0("(", min, " a ", max, ")")
  )

Vista general

Cálculo de mortalidad

In [109]:
levels <- list(
  c("overall"),
  c("grupo_edad"),
  c("sexo"),
  c("grupo_edad", "sexo"),
  c("ola_covid"),
  c("ola_covid", "grupo_edad"),
  c("ola_covid", "sexo"),
  c("ola_covid", "region"),
  c("ola_covid", "macrorregion"),
  c("departamento"),
  c("departamento", "sexo"),
  c("departamento", "grupo_edad"),
  c("departamento", "sexo", "grupo_edad"),
  c("departamento", "ola_covid"),
  c("distrito"),
  c("distrito", "sexo"),
  c("distrito", "grupo_edad"),
  c("distrito", "cuartil_pobreza"),
  c("grupo_edad", "cuartil_pobreza"),
  c("sexo", "cuartil_pobreza"),
  c("ola_covid", "cuartil_pobreza"),
  c("cuartil_pobreza"),
  c("cuartil_nbi"),
  c("region"),
  c("macrorregion")
)

# Calcular la mortalidad
results_mortalidad <- index_calculator(
  data = fallecidos_total, 
  denom = poblacion %>% mutate(overall = "overall"), 
  levels = levels, 
  type = "month",
  std = 100000
)

results_per_month_mortalidad <- index_calculator(
  data = fallecidos_total, 
  denom = poblacion %>% mutate(overall = "overall"), 
  levels = levels, 
  type = "per_month",
  std = 100000
)

Cálculo de letalidad

In [110]:
# Calcular la letalidad
results_letalidad_mensual <- index_calculator(
  data = fallecidos_total, 
  denom = positivos_0723 %>% 
    mutate(cantidad = 1), 
  levels = levels, 
  type = "month",
  std = 100
)

results_per_month_letalidad <- index_calculator(
  data = fallecidos_total, 
  denom = positivos_0723 %>% 
    mutate(cantidad = 1), 
  levels = levels, 
  type = "per_month",
  std = 100
)

results_letalidad_overall <- index_calculator(
  data = fallecidos_total, 
  denom = positivos_0723 %>% 
    mutate(cantidad = 1), 
  levels = levels, 
  type = "overall",
  std = 100
)
In [111]:
fallecidos_total_df <- fallecidos_total %>% 
  select(overall, edad_declarada, grupo_edad, sexo, ola_covid, region, 
         macrorregion, cuartil_pobreza, cuartil_nbi) %>% 
  collect()

labelled::var_label(fallecidos_total_df) <- list(
  overall = "Overall",
  grupo_edad = "Age Group",
  sexo = "Sex",
  ola_covid = "COVID-19 wave",
  region = "Natural Regions",
  macrorregion = "Macroregions",
  cuartil_pobreza = "Poverty level",
  cuartil_nbi = "Unsatisfied basic needs level"
)
In [112]:
tbl_summ_fallecidos_g <- fallecidos_total_df %>% 
  select(-edad_declarada) %>% 
  gtsummary::tbl_summary(
    type = list(
      overall ~ "dichotomous"
    ),
    value = list(overall = "overall"),
    missing_text = "Sin registro"
  ) %>% 
  gtsummary::modify_header(label = "**Variables**") %>%
  gtsummary::bold_labels()

tbl_summ_fallecidos_c2 <- results_mortalidad$overall$index %>% 
  mutate(label = "Overall") %>% 
  rename(variable = overall) %>% 
  bind_rows(
    results_mortalidad$grupo_edad$index %>% 
      mutate(variable = "grupo_edad") %>% 
      rename(label = grupo_edad),
    results_mortalidad$sexo$index %>% 
      mutate(variable = "sexo") %>% 
      rename(label = sexo),
    results_mortalidad$ola_covid$index %>% 
      mutate(variable = "ola_covid") %>% 
      rename(label = ola_covid),
    results_mortalidad$region$index %>% 
      mutate(variable = "region") %>% 
      rename(label = region),
    results_mortalidad$macrorregion$index %>% 
      mutate(variable = "macrorregion") %>% 
      rename(label = macrorregion),
    results_mortalidad$cuartil_pobreza$index %>% 
      mutate(variable = "cuartil_pobreza") %>% 
      rename(label = cuartil_pobreza),
    results_mortalidad$cuartil_nbi$index %>% 
      mutate(variable = "cuartil_nbi") %>% 
      rename(label = cuartil_nbi)
  ) %>% 
  drop_na() %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  )

tbl_summ_fallecidos_c3 <- results_letalidad_mensual$overall$index %>% 
  mutate(label = "Overall") %>% 
  rename(variable = overall) %>% 
  bind_rows(
    results_letalidad_mensual$grupo_edad$index %>% 
      mutate(variable = "grupo_edad") %>% 
      rename(label = grupo_edad),
    results_letalidad_mensual$sexo$index %>% 
      mutate(variable = "sexo") %>% 
      rename(label = sexo),
    results_letalidad_mensual$ola_covid$index %>% 
      mutate(variable = "ola_covid") %>% 
      rename(label = ola_covid),
    results_letalidad_mensual$region$index %>% 
      mutate(variable = "region") %>% 
      rename(label = region),
    results_letalidad_mensual$macrorregion$index %>% 
      mutate(variable = "macrorregion") %>% 
      rename(label = macrorregion),
    results_letalidad_mensual$cuartil_pobreza$index %>% 
      mutate(variable = "cuartil_pobreza") %>% 
      rename(label = cuartil_pobreza),
    results_letalidad_mensual$cuartil_nbi$index %>% 
      mutate(variable = "cuartil_nbi") %>% 
      rename(label = cuartil_nbi)
  ) %>% 
  drop_na() %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) %>% 
  rename(letalidad_mensual = rate)

tbl_summ_fallecidos_c4 <- results_letalidad_overall$overall$index %>% 
  mutate(label = "Overall") %>% 
  rename(variable = overall) %>% 
  bind_rows(
    results_letalidad_overall$grupo_edad$index %>% 
      mutate(variable = "grupo_edad") %>% 
      rename(label = grupo_edad),
    results_letalidad_overall$sexo$index %>% 
      mutate(variable = "sexo") %>% 
      rename(label = sexo),
    results_letalidad_overall$ola_covid$index %>% 
      mutate(variable = "ola_covid") %>% 
      rename(label = ola_covid),
    results_letalidad_overall$region$index %>% 
      mutate(variable = "region") %>% 
      rename(label = region),
    results_letalidad_overall$macrorregion$index %>% 
      mutate(variable = "macrorregion") %>% 
      rename(label = macrorregion),
    results_letalidad_overall$cuartil_pobreza$index %>% 
      mutate(variable = "cuartil_pobreza") %>% 
      rename(label = cuartil_pobreza),
    results_letalidad_overall$cuartil_nbi$index %>% 
      mutate(variable = "cuartil_nbi") %>% 
      rename(label = cuartil_nbi)
  ) %>% 
  drop_na() %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) %>% 
  rename(letalidad_overall = rate)


tbl_summ_fallecidos_final <- tbl_summ_fallecidos_g %>%
  gtsummary::modify_table_body(
    ~ .x %>% 
      left_join(tbl_summ_fallecidos_c2) %>% 
      left_join(tbl_summ_fallecidos_c3) %>% 
      left_join(tbl_summ_fallecidos_c4) %>% 
      mutate(
        label = case_when(
          variable %in% c("cuartil_pobreza", "cuartil_nbi") &
            label == "1" ~ "1 (0-19.9%)",
          variable %in% c("cuartil_pobreza", "cuartil_nbi") & 
            label == "2" ~ "2 (20-39.9%)",
          variable %in% c("cuartil_pobreza", "cuartil_nbi") & 
            label == "3" ~ "3 (40-59.9%)",
          variable %in% c("cuartil_pobreza", "cuartil_nbi") &
            label == "4" ~ "4 (60-100%)",
          .default = label
        )
      )
  ) %>% 
  gtsummary::modify_header(
    rate ~ "**Average monthly mortality per 100K habitants**",
    letalidad_mensual ~ "**Average monthly lethality per 100 cases**",
    letalidad_overall ~ "**Lethality per 100 cases**"
  )
Joining with `by = join_by(variable, label)`
Joining with `by = join_by(variable, label)`
Joining with `by = join_by(variable, label)`
In [113]:
tbl_summ_fallecidos_final
Tabla 14: Descriptivos de fallecidos menores de 18 años (14-03-2020 a 13-06-2023)
Variables N = 1,6161 Average monthly mortality per 100K habitants Average monthly lethality per 100 cases Lethality per 100 cases
Overall 1,616 (100%) 0.412 0.084 0.513
Age Group



    Under 1 year 251 (16%) 1.327 0.178 1.518
    1 - 5 years 496 (31%) 0.470 0.188 1.088
    6 - 11 years 393 (24%) 0.300 0.095 0.429
    12 - 17 years 476 (29%) 0.375 0.051 0.295
Sex



    Female 729 (45%) 0.374 0.069 0.457
    Male 887 (55%) 0.450 0.100 0.571
COVID-19 wave



    1 (Mar – Oct 2020) 589 (36%) 0.769 0.123 0.983
    2 (Nov 2020 – Oct 2021) 588 (36%) 0.482 0.152 0.811
    3 (Nov 2021 – Apr 2022) 230 (14%) 0.397 0.097 0.216
    4 (May 2022 – Oct 2022) 144 (8.9%) 0.251 0.041 0.248
    5 (Nov 2022 – Jun 2023) 65 (4.0%) 0.081 0.196 0.358
Natural Regions



    Coast 998 (62%) 0.427 0.073 0.426
    Highlands 366 (23%) 0.351 0.106 0.678
    Jungle 252 (16%) 0.668 0.367 0.947
Macroregions



    Center 312 (19%) 0.363 0.073 0.433
    East 232 (14%) 0.644 0.370 0.950
    Metropolitan Lima and Callao 491 (30%) 0.466 0.084 0.415
    North 358 (22%) 0.430 0.123 0.708
    South 223 (14%) 0.418 0.070 0.449
Poverty level



    1 (0-19.9%) 1,022 (63%) 0.470 0.080 0.438
    2 (20-39.9%) 388 (24%) 0.394 0.117 0.780
    3 (40-59.9%) 174 (11%) 0.395 0.168 1.155
    4 (60-100%) 32 (2.0%) 0.642 0.482 2.168
Unsatisfied basic needs level



    1 (0-19.9%) 727 (45%) 0.434 0.071 0.384
    2 (20-39.9%) 567 (35%) 0.404 0.112 0.700
    3 (40-59.9%) 219 (14%) 0.490 0.209 1.218
    4 (60-100%) 103 (6.4%) 0.529 0.108 0.927
1 n (%)
In [114]:
tbl_summ_fallecidos_final %>% 
  gtsummary::as_hux_xlsx("02_output/tables/fallecidos_descriptivos.xlsx")

tbl_summ_fallecidos_final %>%
  gtsummary::as_flex_table() %>%
  flextable::save_as_docx(path = "02_output/tables/fallecidos_descriptivos.docx")
In [115]:
downloadthis::download_file(
  path = "02_output/tables/fallecidos_descriptivos.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [116]:
downloadthis::download_file(
  path = "02_output/tables/fallecidos_descriptivos.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [117]:
tbl_summ_fallecidos_olas <- fallecidos_total_df %>% 
  select(-edad_declarada) %>% 
  gtsummary::tbl_summary(
    by = ola_covid,
    type = list(
      overall ~ "dichotomous"
    ),
    value = list(overall = "overall"),
    missing_text = "Sin registro"
  ) %>% 
  gtsummary::modify_header(label = "**Variables**") %>%
  gtsummary::bold_labels()



ola_covid_fallecidos_gtsumm <- results_mortalidad$ola_covid$index %>% 
  rename(stat = ola_covid) %>% 
  mutate(label = "Overall") %>% 
  bind_rows(
    results_mortalidad$ola_covid_grupo_edad$index %>%
      rename(label = grupo_edad,
             stat = ola_covid),
    results_mortalidad$ola_covid_sexo$index %>% 
      rename(label = sexo,
             stat = ola_covid),
    results_mortalidad$ola_covid_region$index %>% 
      rename(label = region,
             stat = ola_covid),
    results_mortalidad$ola_covid_macrorregion$index %>% 
      rename(label = macrorregion,
             stat = ola_covid),
    results_mortalidad$ola_covid_cuartil_pobreza$index %>% 
      rename(label = cuartil_pobreza,
             stat = ola_covid)
  ) %>% 
  mutate(
    rate = formattable::digits(rate, 3),
    stat = as.character(stat),
    stat = case_match(
      stat,
      "1 (Mar – Oct 2020)" ~ "stat_1",
      "2 (Nov 2020 – Oct 2021)" ~ "stat_2",
      "3 (Nov 2021 – Apr 2022)" ~ "stat_3",
      "4 (May 2022 – Oct 2022)" ~ "stat_4",
      "5 (Nov 2022 – Jun 2023)" ~ "stat_5"
    )
  ) 

tbl_summ_fallecidos_olas$table_body <- tbl_summ_fallecidos_olas$table_body %>%
  mutate(
    across(
      gtsummary::all_stat_cols(stat_0 = FALSE),
      ~ str_remove_all(., "\\s*\\(.*?\\)\\s*")
    )
  ) %>% 
  pivot_longer(
    cols = stat_1:stat_5,
    names_to = "stat",
    values_to = "freq"
  ) %>% 
  left_join(
    ola_covid_fallecidos_gtsumm
  ) %>% 
  mutate(
    value = str_c(freq, ifelse(is.na(rate), "", str_c(" (", rate, ")")))
  ) %>% 
  select(-c(freq, rate)) %>% 
  pivot_wider(
    names_from = stat,
    values_from = value
  )
Joining with `by = join_by(label, stat)`
In [118]:
tbl_summ_fallecidos_olas <- tbl_summ_fallecidos_olas %>% 
  gtsummary::modify_footnote(
    gtsummary::all_stat_cols() ~ "n (mortality)"
  )

tbl_summ_fallecidos_olas
Tabla 15: Descriptivos de fallecidos menores de 18 años por olas, sexo y grupo de edad (14-03-2020 a 13-06-2023)
Variables 1 (Mar – Oct 2020), N = 5891 2 (Nov 2020 – Oct 2021), N = 5881 3 (Nov 2021 – Apr 2022), N = 2301 4 (May 2022 – Oct 2022), N = 1441 5 (Nov 2022 – Jun 2023), N = 651
Overall 589 (0.769) 588 (0.482) 230 (0.397) 144 (0.251) 65 (0.081)
Age Group




    Under 1 year 80 (1.954) 73 (1.099) 53 (1.819) 36 (1.498) 9 (0.314)
    1 - 5 years 199 (0.894) 182 (0.541) 63 (0.383) 33 (0.242) 19 (0.101)
    6 - 11 years 160 (0.629) 137 (0.336) 51 (0.263) 25 (0.130) 20 (0.073)
    12 - 17 years 150 (0.605) 196 (0.478) 63 (0.328) 50 (0.266) 17 (0.072)
Sex




    Female 286 (0.756) 246 (0.400) 114 (0.396) 59 (0.208) 24 (0.061)
    Male 303 (0.782) 342 (0.565) 116 (0.399) 85 (0.294) 41 (0.101)
Natural Regions




    Coast 361 (0.802) 367 (0.505) 135 (0.387) 86 (0.250) 49 (0.100)
    Highlands 104 (0.535) 138 (0.379) 73 (0.458) 41 (0.259) 10 (0.066)
    Jungle 124 (1.324) 83 (0.762) 22 (0.319) 17 (0.289) 6 (0.121)
Macroregions




    Center 116 (0.665) 103 (0.369) 52 (0.409) 28 (0.224) 13 (0.089)
    East 117 (1.305) 77 (0.740) 18 (0.275) 14 (0.250) 6 (0.127)
    Metropolitan Lima and Callao 170 (0.870) 175 (0.515) 66 (0.417) 46 (0.297) 34 (0.151)
    North 126 (0.703) 139 (0.509) 52 (0.388) 32 (0.288) 9 (0.065)
    South 60 (0.472) 94 (0.462) 42 (0.543) 24 (0.259) 3 (0.096)
Poverty level




    1 392 (0.926) 361 (0.552) 133 (0.399) 87 (0.261) 49 (0.104)
    2 142 (0.677) 140 (0.422) 58 (0.374) 34 (0.267) 14 (0.088)
    3 45 (0.420) 72 (0.372) 34 (0.473) 21 (0.364) 2 (0.173)
    4 10 (0.647) 15 (0.622) 5 (0.959) 2 (0.384) 0
Unsatisfied basic needs level




    1 258 (0.926) 262 (0.552) 106 (0.399) 64 (0.261) 37 (0.104)
    2 195 (0.677) 198 (0.422) 89 (0.374) 60 (0.267) 25 (0.088)
    3 87 (0.420) 92 (0.372) 23 (0.473) 14 (0.364) 3 (0.173)
    4 49 (0.647) 36 (0.622) 12 (0.959) 6 (0.384) 0
1 n (mortality)
In [119]:
tbl_summ_fallecidos_olas %>% 
  gtsummary::as_hux_xlsx("02_output/tables/fallecidos_olas_descriptivos.xlsx")

tbl_summ_fallecidos_olas %>%
  gtsummary::as_flex_table() %>%
  flextable::save_as_docx(path = "02_output/tables/fallecidos_olas_descriptivos.docx")
In [120]:
downloadthis::download_file(
  path = "02_output/tables/fallecidos_olas_descriptivos.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [121]:
downloadthis::download_file(
  path = "02_output/tables/fallecidos_olas_descriptivos.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Gráfico de muertes (serie de tiempo) - Menores de 18 años

In [122]:
range_fallecidos_und_18 <- fallecidos_total %>%
  summarise(
    min = min(fecha_fallecimiento),
    max = max(fecha_fallecimiento)
  ) %>% 
  collect()

deaths_cases_area <- fallecidos_total %>% 
  count(clasificacion_def, fecha_round) %>% 
  mutate(
    clasificacion_def = case_match(
      clasificacion_def,
      "Criterio serológico" ~ "Serological Criterion",
      "Criterio radiológico" ~ "Radiological Criterion",
      "Criterio SINADEF" ~ "SINADEF Criterion",
      "Criterio virológico" ~ "Virological Criterion",
      "Criterio nexo epidemiológico" ~ "Epidemiological Link Criterion",
      "Criterio clínico" ~ "Clinical Criterion",
      "Criterio investigación Epidemiológica" ~ "Epidemiological Investigation Criterion",
      .default = NA_character_
    )
  ) %>% 
  collect() %>% 
  ggplot(
    aes(
      x = fecha_round,
      y = n,
      fill = clasificacion_def
    )
  ) +
  geom_area(position = 'stack') +
  innovar::scale_fill_innova("jama") +
  # scale_x_date(
  #   limits = c(ymd("2020-03-01"), ymd("2023-10-31")),
  #   breaks = scales::date_breaks("2 month"), # Cambiar a "6 months" para menos frecuencia
  #   labels = scales::date_format("%b %Y") # Formato de fecha, %b es la abreviatura de mes, %Y es el año
  # ) + 
  scale_x_date(
    limits = c(ymd("2020-03-01"), ymd("2023-07-01")),
    breaks = seq(from = ceiling_date(ymd("2020-03-01"), "month"),
                 to = floor_date(ymd("2023-07-01"), "month"),
                 by = "2 months"), 
    # date_breaks = "2 month",
    date_labels = "%b %Y"
  ) +
  labs(
    y = NULL,
    x = NULL,
    title = "Deaths by COVID-19 under 18 years old",
    fill = "Classification Criteria"
  ) + 
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45
    )
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-03-01"), 
    xmax = as.Date("2020-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2020-07-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "First wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-11-01"), 
    xmax = as.Date("2021-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2021-04-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Second wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2021-11-01"), 
    xmax = as.Date("2022-04-30"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-02-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Third wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2022-05-01"), 
    xmax = as.Date("2022-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-08-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Fourth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2022-11-01"), 
    xmax = range_fallecidos_und_18$max, 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2023-03-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Fifth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  )

deaths_cases_area

Gráfico de muertes (serie de tiempo) - Grupo Etáreo

In [123]:
deaths_cases_by_age_area <- fallecidos_total %>%
  count(grupo_edad, fecha_round) %>% 
  collect() %>% 
  ggplot(
    aes(
      x = fecha_round,
      y = n,
      fill = grupo_edad
    )
  ) +
  geom_area(position = 'stack') +
  innovar::scale_fill_innova("jama") +
  # scale_x_date(
  #   limits = c(ymd("2020-03-01"), ymd("2023-10-31")),
  #   breaks = scales::date_breaks("2 month"), # Cambiar a "6 months" para menos frecuencia
  #   labels = scales::date_format("%b %Y") # Formato de fecha, %b es la abreviatura de mes, %Y es el año
  # ) + 
  scale_x_date(
    limits = c(ymd("2020-03-01"), ymd("2023-07-01")),
    breaks = seq(from = ceiling_date(ymd("2020-03-01"), "month"),
                 to = floor_date(ymd("2023-07-01"), "month"),
                 by = "2 months"), 
    # date_breaks = "2 month",
    date_labels = "%b %Y"
  ) +
  labs(
    y = NULL,
    x = NULL,
    title = "Deaths",
    fill = "Age Group"
  ) + 
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45
    )
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-03-01"), 
    xmax = as.Date("2020-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2020-07-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "First wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-11-01"), 
    xmax = as.Date("2021-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2021-04-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Second wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2021-11-01"), 
    xmax = as.Date("2022-04-30"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-02-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Third wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2022-05-01"), 
    xmax = as.Date("2022-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-08-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Fourth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2022-11-01"), 
    xmax = as.Date("2023-07-01"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2023-03-01"),
    y = Inf, # Posición vertical del texto
    label = "Fifth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  )

deaths_cases_by_age_area

Gráfico Mortalidad (serie de tiempo)

In [124]:
mortality_cases_by_age_area <- results_per_month_mortalidad$grupo_edad$index %>% 
  mutate(
    time = make_date(anio, mes, "1")
  ) %>% 
  ggplot(
    aes(
      x = time,
      y = rate,
      fill = grupo_edad
    )
  ) +
  geom_area(position = 'stack') +
  innovar::scale_fill_innova("jama") +
  scale_x_date(
    limits = c(ymd("2020-03-01"), ymd("2023-07-01")),
    breaks = seq(from = ceiling_date(ymd("2020-03-01"), "month"),
                 to = floor_date(ymd("2023-07-01"), "month"),
                 by = "2 months"), 
    # date_breaks = "2 month",
    date_labels = "%b %Y"
  ) +
  labs(
    y = NULL,
    x = NULL,
    title = "Monthly mortality per 100 000 inhabitants",
    fill = "Age Group"
  ) + 
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45
    )
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-03-01"), 
    xmax = as.Date("2020-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2020-07-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "First wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-11-01"), 
    xmax = as.Date("2021-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2021-04-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Second wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2021-11-01"), 
    xmax = as.Date("2022-04-30"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-02-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Third wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2022-05-01"), 
    xmax = as.Date("2022-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-08-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Fourth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2022-11-01"), 
    xmax = as.Date("2023-07-01"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2023-03-01"),
    y = Inf, # Posición vertical del texto
    label = "Fifth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  )

mortality_cases_by_age_area

Gráfico Letalidad (serie de tiempo)

In [125]:
lethality_cases_by_age_area <- results_per_month_letalidad$grupo_edad$index %>% 
  mutate(
    time = make_date(anio, mes, "1")
  ) %>% 
  ggplot(
    aes(
      x = time,
      y = rate,
      fill = grupo_edad
    )
  ) +
  geom_area(position = 'stack') +
  innovar::scale_fill_innova("jama") +
  scale_x_date(
    limits = c(ymd("2020-03-01"), ymd("2023-07-01")),
    breaks = seq(from = ceiling_date(ymd("2020-03-01"), "month"),
                 to = floor_date(ymd("2023-07-01"), "month"),
                 by = "2 months"), 
    # date_breaks = "2 month",
    date_labels = "%b %Y"
  ) +
  labs(
    y = NULL,
    x = NULL,
    title = "Monthly lethality per 100 cases",
    fill = "Age Group"
  ) + 
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45
    )
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-03-01"), 
    xmax = as.Date("2020-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2020-07-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "First wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-11-01"), 
    xmax = as.Date("2021-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2021-04-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Second wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2021-11-01"), 
    xmax = as.Date("2022-04-30"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-02-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Third wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2022-05-01"), 
    xmax = as.Date("2022-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-08-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Fourth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2022-11-01"), 
    xmax = as.Date("2023-07-01"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2023-03-01"),
    y = Inf, # Posición vertical del texto
    label = "Fifth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  )

lethality_cases_by_age_area

Pirámide frecuencia - Edades

In [126]:
fallecidos_total_df %>% 
  mutate(
    edad_declarada = factor(edad_declarada)
  ) %>% 
  age_pyramid(
    age_group = "edad_declarada",
    split_by = "sexo"
  ) +
  scale_fill_brewer(palette = "Dark2") +
  labs(
    x = "Age",
    fill = "Sex",
    y = "Frequency"
  ) +
  theme_classic()
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.

In [127]:
fallecidos_total_df %>% 
  age_pyramid(
    age_group = "grupo_edad",
    split_by = "sexo"
  ) +
  scale_fill_brewer(palette = "Dark2") +
  labs(
    x = "Age Group",
    fill = "Sex",
    y = "Frequency"
  ) +
  theme_classic()
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.

Pirámide proporcional - Edades

In [128]:
fallecidos_total_df %>% 
  mutate(
    edad_declarada = factor(edad_declarada)
  ) %>% 
  age_pyramid(
    age_group = "edad_declarada",
    split_by = "sexo",
    proportional = TRUE
  ) +
   scale_fill_brewer(palette = "Dark2") +
  labs(
    x = "Age",
    fill = "Sex",
    y = "Percentage"
  ) +
  theme_classic()
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.

In [129]:
fallecidos_total_df %>% 
  age_pyramid(
    age_group = "grupo_edad",
    split_by = "sexo",
    proportional = TRUE
  ) +
   scale_fill_brewer(palette = "Dark2") +
  labs(
    x = "Age Group",
    fill = "Sex",
    y = "Percentage"
  ) +
  theme_classic()
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.

Departamento

In [130]:
fallecidos_dep_100k_sf <- peru_dep_sf %>%
  rename(departamento = dep) %>% 
  left_join(
    results_mortalidad$departamento$index
  ) %>%
  ungroup()
Joining with `by = join_by(departamento)`
In [131]:
fallecidos_dep_100k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap("Monthly mortality per 100 000 inhabitants",
               20)
    )
  ) +
  scale_fill_distiller(palette = "Oranges", # Old: YlOrBr
                       direction = 1) + 
  theme_void()
Figura 21: Mortalidad COVID-19 por 100K habitantes de acuerdo al departamento (14-03-2020 a 13-06-2023)
In [132]:
In [133]:
tbl_summ_mort_dep_pre <- results_mortalidad$departamento$index %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) %>% 
  mutate(
    departamento = str_to_title(departamento)
  ) 

tbl_summ_mort_dep <- tbl_summ_mort_dep_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_mort_dep
Tabla 16: Mortalidad COVID-19 por 100K habitantes de acuerdo al departamento (07-03-2020 a 17-06-2023)
Departamento Rate
Amazonas 1.018
Ancash 0.470
Apurimac 0.955
Arequipa 0.521
Ayacucho 0.534
Cajamarca 0.437
Callao 0.775
Cusco 0.552
Huancavelica 1.110
Huanuco 0.598
Ica 0.805
Junin 0.606
La Libertad 0.425
Lambayeque 0.831
Lima 0.465
Loreto 0.716
Madre De Dios 2.599
Moquegua 2.099
Pasco 1.457
Piura 0.662
Puno 0.641
San Martin 0.610
Tacna 1.519
Tumbes 1.710
Ucayali 2.335
In [134]:
tbl_summ_mort_dep_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:2) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/mortalidad_departamento.xlsx",
                       open = FALSE)

tbl_summ_mort_dep %>%
  gt::gtsave("02_output/tables/mortalidad_departamento.docx")
In [135]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_departamento.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [136]:
downloadthis::download_file(
  path = "02_output/tables/prevalencia_departamento.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Departamento y sexo

In [137]:
mortalidad_dep_sex_100k_sf <- peru_dep_sf %>% 
  rename(departamento = dep) %>% 
  inner_join(
    results_mortalidad$departamento_sexo$index
  ) 
Joining with `by = join_by(departamento)`
In [138]:
mortalidad_dep_sex_100k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap("Monthly mortality per 100 000 inhabitants",
               20)
    )
  ) +
  scale_fill_distiller(palette = "Oranges", # Old: "YlOrBr"
                       direction = 1) + 
  facet_wrap(vars(sexo)) + 
  theme_void()
Figura 22: Mortalidad COVID-19 por 100K habitantes de acuerdo al departamento y sexo (14-03-2020 a 13-06-2023)
In [139]:
In [140]:
tbl_summ_mort_dep_sex_pre <- results_mortalidad$departamento_sexo$index %>% 
  mutate(
    rate = formattable::digits(rate, 3),
    departamento = str_to_title(departamento)
  ) %>% 
  pivot_wider(
    names_from = sexo, 
    values_from = rate
  )


tbl_summ_mort_dep_sex <- tbl_summ_mort_dep_sex_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_mort_dep_sex
Tabla 17: Mortalidad COVID-19 por 100K habitantes de acuerdo al departamento (14-03-2020 a 13-06-2023)
Departamento Female Male
Amazonas 1.692 1.371
Ancash 0.619 0.757
Apurimac 1.586 1.281
Arequipa 0.833 0.827
Ayacucho 1.074 0.915
Cajamarca 0.573 0.631
Callao 0.991 1.122
Cusco 0.698 0.767
Huancavelica 1.353 1.916
Huanuco 0.821 0.926
Ica 1.115 1.170
Junin 0.758 0.869
La Libertad 0.670 0.585
Lambayeque 0.986 1.203
Lima 0.467 0.524
Loreto 0.889 1.035
Madre De Dios 4.496 4.207
Moquegua 4.329 4.163
Pasco 2.594 2.841
Piura 0.797 0.827
Puno 1.036 0.772
San Martin 0.960 0.940
Tacna 3.037 2.526
Tumbes 3.753 2.597
Ucayali 3.125 2.848
In [141]:
tbl_summ_mort_dep_sex_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:3) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/mortalidad_departamento_sexo.xlsx",
                       open = FALSE)

tbl_summ_mort_dep_sex %>%
  gt::gtsave("02_output/tables/mortalidad_departamento_sexo.docx")
In [142]:
downloadthis::download_file(
  path = "02_output/tables/mortalidad_departamento_sexo.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [143]:
downloadthis::download_file(
  path = "02_output/tables/mortalidad_departamento_sexo.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Departamento y edad

In [144]:
mortalidad_dep_edad_100k_sf <- peru_dep_sf %>% 
  rename(departamento = dep) %>% 
  inner_join(
    results_mortalidad$departamento_grupo_edad$index
  ) 
Joining with `by = join_by(departamento)`
In [145]:
mortalidad_dep_edad_100k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap("Monthly mortality per 100 000 inhabitants",
               20)
    )
  ) +
  scale_fill_distiller(palette = "YlOrBr",
                       direction = 1) + 
  facet_wrap(vars(grupo_edad), nrow = 1) + 
  theme_void()
Figura 23: Mortalidad COVID-19 por 100K habitantes de acuerdo al departamento y grupo de edad (14-03-2020 a 13-06-2023)
In [146]:
In [147]:
tbl_summ_mort_dep_edad_pre <- results_mortalidad$departamento_grupo_edad$index %>% 
  mutate(
    rate = formattable::digits(rate, 3),
    departamento = str_to_title(departamento)
  ) %>% 
  pivot_wider(
    names_from = grupo_edad, 
    values_from = rate
  )


tbl_summ_mort_dep_edad <- tbl_summ_mort_dep_edad_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_mort_dep_edad
Tabla 18: Mortalidad COVID-19 por 100K habitantes de acuerdo al departamento y grupo de edad(14-03-2020 a 13-06-2023)
Departamento Under 1 Year 1 - 5 Years 6 - 11 Years 12 - 17 Years
Amazonas 11.234 2.223 2.408 2.673
Ancash 5.072 1.272 0.876 0.952
Apurimac 12.428 3.131 1.776 2.317
Arequipa 6.678 1.082 0.978 1.198
Ayacucho 8.207 1.527 1.241 1.221
Cajamarca 5.587 0.772 0.662 0.757
Callao 7.197 1.412 1.267 1.480
Cusco 5.216 1.235 0.914 0.756
Huancavelica 12.845 3.703 2.122 2.469
Huanuco 7.352 1.739 1.092 1.341
Ica 9.803 1.789 1.204 1.225
Junin 4.985 1.114 0.817 0.802
La Libertad 4.217 0.809 0.775 0.800
Lambayeque 7.289 1.560 1.111 1.046
Lima 2.095 0.553 0.416 0.468
Loreto 4.486 1.198 0.950 1.401
Madre De Dios 45.537 6.442 5.939 6.484
Moquegua 43.234 7.552 6.114 6.429
Pasco 22.171 3.716 3.976 3.763
Piura 4.540 1.269 0.792 0.792
Puno 9.375 1.140 0.905 1.077
San Martin 5.910 1.618 1.118 1.165
Tacna 27.020 NA 3.144 3.646
Tumbes NA 4.526 5.350 4.038
Ucayali 9.795 4.613 3.602 2.112
In [148]:
tbl_summ_mort_dep_edad_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:5) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/mortalidad_departamento_edad.xlsx",
                       open = FALSE)

tbl_summ_mort_dep_edad %>%
  gt::gtsave("02_output/tables/mortalidad_departamento_edad.docx")
In [149]:
downloadthis::download_file(
  path = "02_output/tables/mortalidad_departamento_edad.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [150]:
downloadthis::download_file(
  path = "02_output/tables/mortalidad_departamento_edad.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Departamento y olas

In [151]:
mortalidad_dep_olas_mother <- crossing(
  ola_covid = levels(results_mortalidad$departamento_ola_covid$index$ola_covid),
  departamento = unique(results_mortalidad$departamento_ola_covid$index$departamento)
)

mortalidad_dep_olas_100k <- mortalidad_dep_olas_mother %>% 
  left_join(results_mortalidad$departamento_ola_covid$index) %>% 
  bind_rows(
    results_mortalidad$departamento$index %>% 
      mutate(ola_covid = "Overall")
  ) %>% 
  mutate(
    ola_covid = str_wrap(ola_covid, 20),
    ola_covid = fct_relevel(ola_covid,
                            "Overall")
  ) %>% 
  arrange(ola_covid)
Joining with `by = join_by(ola_covid, departamento)`
mortalidad_dep_olas_100k_sf <- peru_dep_sf %>%
  rename(departamento = dep) %>% 
  left_join(
    mortalidad_dep_olas_100k
  ) %>%
  ungroup()
Joining with `by = join_by(departamento)`
In [152]:
mortalidad_dep_olas_100k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap("Monthly mortality per 100 000 inhabitants",
               20)
    )
  ) +
  # scale_fill_distiller(palette = "YlOrBr",
  #                      direction = 1) + 
    scale_fill_gradientn(
    colors = scales::pal_brewer("seq", "Oranges", 1)(4),
    values = scales::rescale(c(0, 1, 2, 3, max(mortalidad_dep_olas_100k_sf$rate, na.rm = TRUE))),
    breaks = c(0, 1, 2, 3, max(mortalidad_dep_olas_100k_sf$rate, na.rm = TRUE)),
    labels = c("0", "1", "2", "3", "Max"),
    limits = c(0,
               max(mortalidad_dep_olas_100k_sf$rate, na.rm = TRUE))
  ) +
  facet_wrap(vars(ola_covid), nrow = 1) + 
  theme_void()
Figura 24: Mortalidad COVID-19 por 100K habitantes de acuerdo al departamento y Olas COVID (14-03-2020 a 13-06-2023)
In [153]:
In [154]:
tbl_summ_mort_dep_ola_pre <- mortalidad_dep_olas_100k %>% 
  mutate(
    rate = formattable::digits(rate, 3),
    departamento = str_to_title(departamento)
  ) %>% 
  pivot_wider(
    names_from = ola_covid, 
    values_from = rate
  )


tbl_summ_mort_dep_ola <- tbl_summ_mort_dep_ola_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_mort_dep_ola
Tabla 19: Mortalidad COVID-19 por 100K habitantes de acuerdo al departamento y Olas COVID(14-03-2020 a 13-06-2023)
Departamento Overall 1 (Mar – Oct 2020) 2 (Nov 2020 – Oct 2021) 3 (Nov 2021 – Apr 2022) 4 (May 2022 – Oct 2022) 5 (Nov 2022 – Jun 2023)
Amazonas 1.018 1.511 1.115 0.770 0.604 0.611
Ancash 0.470 0.765 0.381 0.490 0.424 0.278
Apurimac 0.955 0.644 0.970 1.364 0.682 NA
Arequipa 0.521 0.465 0.690 0.450 0.249 0.234
Ayacucho 0.534 0.541 0.482 0.650 0.434 0.459
Cajamarca 0.437 0.469 0.434 0.547 0.393 0.277
Callao 0.775 0.761 0.957 0.695 0.697 0.349
Cusco 0.552 0.879 0.554 0.760 0.228 0.234
Huancavelica 1.110 1.762 0.976 0.918 NA 0.862
Huanuco 0.598 0.704 0.620 0.518 0.363 0.388
Ica 0.805 1.035 0.870 0.351 0.648 0.469
Junin 0.606 0.808 0.552 0.716 0.376 NA
La Libertad 0.425 0.699 0.304 0.545 0.297 0.164
Lambayeque 0.831 1.060 1.100 0.504 0.315 0.239
Lima 0.465 0.939 0.470 0.417 0.282 0.158
Loreto 0.716 1.158 0.668 0.547 0.240 0.227
Madre De Dios 2.599 2.331 3.118 3.580 1.790 NA
Moquegua 2.099 2.117 2.073 2.135 2.135 NA
Pasco 1.457 1.642 1.639 1.135 NA 1.136
Piura 0.662 0.871 0.738 0.430 0.345 NA
Puno 0.641 1.046 0.409 0.821 0.638 0.285
San Martin 0.610 0.776 0.737 0.320 0.630 0.305
Tacna 1.519 2.269 1.276 1.133 NA NA
Tumbes 1.710 2.108 1.578 1.309 1.309 1.309
Ucayali 2.335 3.874 1.401 NA 0.683 NA
In [155]:
tbl_summ_mort_dep_ola_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:6) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/mortalidad_departamento_ola.xlsx",
                       open = FALSE)

tbl_summ_mort_dep_ola %>%
  gt::gtsave("02_output/tables/mortalidad_departamento_ola.docx")
In [156]:
downloadthis::download_file(
  path = "02_output/tables/mortalidad_departamento_ola.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [157]:
downloadthis::download_file(
  path = "02_output/tables/mortalidad_departamento_ola.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Regiones

In [158]:
mortalidad_reg_100k_sf <- peru_reg_sf %>%
  left_join(
    results_mortalidad$region$index
  ) 
Joining with `by = join_by(region)`
In [159]:
mortalidad_reg_100k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap("Monthly mortality per 100 000 inhabitants",
               20)
    )
  ) +
  ggsflabel::geom_sf_label(aes(label = region)) +
  scale_fill_distiller(palette = "Oranges", # Old: YlOrBr
                       direction = 1) + 
  theme_void()
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data
Figura 25: Mortalidad COVID-19 por 100K habitantes de acuerdo a la región (14-03-2020 a 13-06-2023)
In [160]:
In [161]:
tbl_summ_mort_reg_pre <- results_mortalidad$region$index %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  )


tbl_summ_mort_reg <- tbl_summ_mort_reg_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_mort_reg
Tabla 20: Mortalidad COVID-19 por 100K habitantes de acuerdo a la región(14-03-2020 a 13-06-2023)
Region Rate
Coast 0.427
Highlands 0.351
Jungle 0.668
In [162]:
tbl_summ_mort_reg_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:2) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/mortalidad_region.xlsx",
                       open = FALSE)

tbl_summ_mort_reg %>%
  gt::gtsave("02_output/tables/mortalidad_region.docx")
In [163]:
downloadthis::download_file(
  path = "02_output/tables/mortalidad_region.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [164]:
downloadthis::download_file(
  path = "02_output/tables/mortalidad_region.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Macrorregiones

In [165]:
mortalidad_macro_100k_sf <- peru_macro_sf %>%
  left_join(
    results_mortalidad$macrorregion$index
  ) 
Joining with `by = join_by(macrorregion)`
In [166]:
mort_macro_map <- mortalidad_macro_100k_sf %>%
  mutate(
    macrorregion = str_wrap(macrorregion, width = 15)
  ) %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  ggsflabel::geom_sf_label_repel(aes(label = macrorregion),
                                 force = 100,
                                 seed = 2024) +
  guides(
    fill = guide_legend(
      str_wrap("Monthly mortality per 100 000 inhabitants", 
               20)
    )
  ) +
  scale_fill_distiller(palette = "Oranges", # Old: YlOrBr
                       direction = 1) + 
  theme_void()

mort_macro_map
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data
Figura 26: Mortalidad COVID-19 por 100K habitantes de acuerdo a la macrorregión (14-03-2020 a 13-06-2023)
In [167]:
In [168]:
tbl_summ_mort_macro_pre <- results_mortalidad$macrorregion$index %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  )


tbl_summ_mort_macro <- tbl_summ_mort_macro_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_mort_macro
Tabla 21: Mortalidad COVID-19 por 100K habitantes de acuerdo a la macrorregión(14-03-2020 a 13-06-2023)
Macrorregion Rate
Center 0.363
East 0.644
Metropolitan Lima and Callao 0.466
North 0.430
South 0.418
In [169]:
tbl_summ_mort_macro_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:2) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/mortalidad_macrorregion.xlsx",
                       open = FALSE)

tbl_summ_mort_macro %>%
  gt::gtsave("02_output/tables/mortalidad_departamento_macrorregion.docx")
In [170]:
downloadthis::download_file(
  path = "02_output/tables/mortalidad_departamento_edad.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [171]:
downloadthis::download_file(
  path = "02_output/tables/mortalidad_departamento_edad.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Macrorregiones - Letalidad

In [172]:
letalidad_macro_100k_sf <- peru_macro_sf %>%
  left_join(
    results_letalidad_overall$macrorregion$index
  ) 
Joining with `by = join_by(macrorregion)`
In [173]:
let_macro_map <- letalidad_macro_100k_sf %>%
  mutate(
    macrorregion = str_wrap(macrorregion, width = 15)
  ) %>% 
  ggplot() +
  geom_sf(aes(fill = rate)) +
  ggsflabel::geom_sf_label_repel(aes(label = macrorregion),
                                 force = 100,
                                 seed = 2024) +
  guides(
    fill = guide_legend(
      str_wrap("Lethality per 100 cases", 
               20)
    )
  ) +
  scale_fill_distiller(palette = "YlOrBr",
                       direction = 1) + 
  theme_void()

let_macro_map
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data
Figura 27: Letalidad COVID-19 por 100K habitantes de acuerdo a la macrorregión (14-03-2020 a 13-06-2023)

Distrital y pobreza

In [174]:
results_per_month_mortalidad$cuartil_pobreza$index %>% 
  drop_na() %>% 
  mutate(
    time = make_date(anio, mes, "1")
  ) %>% 
  ggplot(
    aes(x = time,
        y = rate,
        color = cuartil_pobreza)
  ) +
  geom_line(linewidth = 1) +
  innovar::scale_color_innova("jama") +
  scale_x_date(
    limits = c(ymd("2020-03-01"), ymd("2023-07-01")),
    breaks = seq(from = ceiling_date(ymd("2020-03-01"), "month"),
                 to = floor_date(ymd("2023-07-01"), "month"),
                 by = "2 months"), 
    # date_breaks = "2 month",
    date_labels = "%b %Y"
  ) +
  labs(
    y = NULL,
    x = NULL,
    title = "Mortality COVID-19 under 18 years old",
    color = "Poverty Quartiles"
  ) + 
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45
    )
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-03-01"), 
    xmax = as.Date("2020-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2020-07-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "First wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-11-01"), 
    xmax = as.Date("2021-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2021-04-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Second wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2021-11-01"), 
    xmax = as.Date("2022-04-30"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-02-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Third wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2022-05-01"), 
    xmax = as.Date("2022-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-08-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Fourth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2022-11-01"), 
    xmax = as.Date("2023-07-01"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2023-03-01"),
    y = Inf, # Posición vertical del texto
    label = "Fifth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  )
Figura 28: Mortalidad COVID-19 de acuerdo al cuartil de pobreza(14-03-2020 a 13-06-2023)

Distrito Lima

In [175]:
total_mort_distr_lim_callao <- results_mortalidad$distrito$index_pre %>% 
  filter(provincia %in% c("LIMA", "CALLAO")) %>% 
  pull(count) %>% 
  sum()

results_mortalidad$distrito$index %>% 
  filter(provincia %in% c("LIMA", "CALLAO")) %>% 
  mutate(
    distrito = str_to_title(distrito), 
    distrito = fct_reorder(distrito, rate)
  ) %>% 
  ggplot(aes(y = distrito, x = rate)) +
  geom_bar(stat = "identity",
           color = "black",
           fill = "grey80") +
  theme_bw() +
  labs(title = "Mortality COVID-19 in Metropolitan Lima", 
       x = NULL, 
       y = "Monthly mortality per 100 000 inhabitants",
       caption = paste0("Total deaths reported: ", 
                        scales::number(total_mort_distr_lim_callao))) +
  innovar::scale_fill_innova("blue_fall") +
  theme(
    legend.position = "bottom"
  )
Figura 29: Mortalidad COVID-19 de acuerdo a los distritos de lima metropolitana (14-03-2020 a 13-06-2023)
In [176]:
mort_lima_distr_1k_sf <- Peru %>% 
  inner_join(
    results_mortalidad$distrito$index %>% 
      filter(provincia %in% c("LIMA", "CALLAO"))
  )
Joining with `by = join_by(ubigeo)`
In [177]:
mort_lima_distr_1k_sf %>%
  mutate(
    label = case_when(
      rate > 10 ~ str_to_title(distrito)
    )
  ) %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap("Monthly mortality per 100 000 inhabitants", 
               20)
    )
  ) +
  ggsflabel::geom_sf_label_repel(aes(label = label),
                                 force = 10,
                                 size = 2.45,
                                 box.padding = 0.75,
                                 seed = 2024) +
  # scale_fill_distiller(palette = "YlOrBr",
  #                      direction = 1) + 
  scale_fill_gradientn(
    colors = scales::pal_brewer("seq", "Oranges", 1)(5),
    values = scales::rescale(c(0, 15, 30, 50, max(mort_lima_distr_1k_sf$rate, na.rm = TRUE))),
    breaks = c(0, 15, 30, 50, max(mort_lima_distr_1k_sf$rate, na.rm = TRUE)),
    labels = c("0", "15", "30", "50", "Max"),
    limits = c(0,
               max(mort_lima_distr_1k_sf$rate, na.rm = TRUE))
  ) +
  theme_void()
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data
Warning: Removed 39 rows containing missing values or values outside the scale range
(`geom_label_repel()`).
Figura 30: Mortalidad COVID-19 de acuerdo a los distritos de lima metropolitana (14-03-2020 a 13-06-2023)
In [178]:
In [179]:
tbl_summ_mort_lima_distr_pre <- results_mortalidad$distrito$index %>% 
      filter(provincia %in% c("LIMA", "CALLAO")) %>% 
  mutate(
    across(
      departamento:distrito,
      str_to_title
    ),
    rate = formattable::digits(rate, 3)
  ) %>% 
  select(-departamento)

tbl_summ_mort_lima_distr <- tbl_summ_mort_lima_distr_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_mort_lima_distr
Tabla 22: Mortalidad COVID-19 de acuerdo a los distritos de lima metropolitana (14-03-2020 a 13-06-2023)
Ubigeo Provincia Distrito Rate
070101 Callao Callao 1.491
070102 Callao Bellavista 6.214
070103 Callao Carmen De La Legua Reynoso 9.212
070104 Callao La Perla 8.304
070105 Callao La Punta 191.205
070106 Callao Ventanilla 1.009
070107 Callao Mi Peru 7.510
150101 Lima Lima 2.874
150102 Lima Ancon 5.237
150103 Lima Ate 0.808
150104 Lima Barranco 16.049
150105 Lima Brena 6.917
150106 Lima Carabayllo 1.115
150107 Lima Chaclacayo 8.199
150108 Lima Chorrillos 1.506
150109 Lima Cieneguilla 9.741
150110 Lima Comas 0.828
150111 Lima El Agustino 2.655
150112 Lima Independencia 2.099
150113 Lima Jesus Maria 6.746
150114 Lima La Molina 2.613
150115 Lima La Victoria 3.441
150116 Lima Lince 13.056
150117 Lima Los Olivos 1.515
150118 Lima Lurigancho 1.646
150119 Lima Lurin 3.601
150120 Lima Magdalena Del Mar 7.306
150122 Lima Miraflores 6.576
150123 Lima Pachacamac 2.613
150125 Lima Puente Piedra 1.150
150128 Lima Rimac 3.141
150130 Lima San Borja 5.662
150132 Lima San Juan De Lurigancho 0.751
150133 Lima San Juan De Miraflores 1.427
150134 Lima San Luis 7.285
150135 Lima San Martin De Porres 0.871
150136 Lima San Miguel 3.206
150137 Lima Santa Anita 2.004
150140 Lima Santiago De Surco 1.665
150141 Lima Surquillo 5.151
150142 Lima Villa El Salvador 0.997
150143 Lima Villa Maria Del Triunfo 1.195
In [180]:
tbl_summ_mort_lima_distr_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:4) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/mortalidad_lima_distrito.xlsx",
                       open = FALSE)

tbl_summ_mort_lima_distr %>%
  gt::gtsave("02_output/tables/mortalidad_lima_distrito.docx")
In [181]:
downloadthis::download_file(
  path = "02_output/tables/mortalidad_lima_distrito.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [182]:
downloadthis::download_file(
  path = "02_output/tables/mortalidad_lima_distrito.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Incidencia mensual del COVID-19

In [183]:
incidencia_positivos <- positivos_0723 %>% 
  mutate(
    #fecha_resultado_floor = floor_date(fecha_resultado, unit = "month"),
    mes = month(fecha_resultado_floor)
  )
In [184]:
n_incidencia_positivos <- incidencia_positivos %>% 
  count() %>% 
  pull(n)

n_wo_id <- incidencia_positivos %>% 
  filter(is.na(id_persona)) %>% 
  count() %>% 
  pull(n)

Los datos utilizados para incidencia positivos tienen datos hasta julio de 2023. Se tiene registro de 315 046 casos positivos menores de 18 años. Para poder analizar la incidencia necesitamos saber que si un caso positivos es nuevo o es una reinfección que no se puede considerar aún como caso nuevo. Se tendrá como criterio 3 meses de espacio entre infecciones. Lamentablemente, incluso en estos datos, hay 12 495 registros sin id_persona.

Criterios para casos positivos y de reinfección:

  • Hasta 1 mes (30 días), se considera una misma infección.
  • Espacio de 3 meses a más (90 días), se considera una nueva infección (reinfección)
  • Reportar cantidad de casos que se encuentren entre 1 mes y menos de 3 meses (entre día 31 y 89), con su respectivo método.
In [185]:
incidencia_positivos %>% 
  count(caso_intermedio)
# Source:   SQL [3 x 2]
# Database: DuckDB v0.10.1 [brian@Windows 10 x64:R 4.4.0/D:\Github\covid-analisis-ninos\01_data\raw\covid.duckdb]
  caso_intermedio      n
  <lgl>            <dbl>
1 FALSE           302236
2 TRUE               245
3 NA               12565
In [186]:
# incidencia_positivos %>% 
#   filter(anio == 2020,
#          !is.na(id_persona)) %>% 
#   group_by(fecha_resultado_floor) %>%
#   summarise(
#     casos_sin_reinfecciones = n_distinct(id_persona),
#     casos_con_reinfeccioens = n()
#   ) %>% 
#   ungroup() %>% 
#   arrange(fecha_resultado_floor) %>% 
#   collect()
# 
# incidencia_positivos %>% 
#   filter(anio == 2020, !is.na(id_persona)) %>% 
#   group_by(fecha_resultado_floor) %>%
#   add_count(id_persona) %>% 
#   filter(n > 1) %>% 
#   select(departamento:fecha_resultado, id_persona)

# incidencia_positivos %>% 
#   filter(anio == 2020) %>% 
#   count(fecha_resultado_floor) %>%
#   ungroup() %>% 
#   arrange(fecha_resultado_floor) %>% 
#   collect()
#   
#   count(
#     across(c(fecha_resultado_floor, departamento:distrito, grupo_edad, sexo))
#   )

Tasa de hospitalización

In [187]:
hospitalizados <- hosp_final %>%
  filter(edad < 18,
         fecha_ingreso_hosp <= max_positivos_0723) %>% 
  mutate(
    mes = month(fecha_ingreso_hosp),
    overall = "overall"
  ) 

range_hospi <- hospitalizados %>% 
  summarise(
    min = min(fecha_ingreso_hosp),
    max = max(fecha_ingreso_hosp)
  ) %>% 
  collect() %>% 
  mutate(
    min = format(min, "%d-%m-%Y"),
    max = format(max, "%d-%m-%Y"),
    fecha = paste0("(", min, " a ", max, ")")
  )

Vista general

Cálculo de Tasa de hospitalización

In [188]:
levels <- list(
  c("overall"),
  c("grupo_edad"),
  c("sexo"),
  c("ola_covid"),
  c("ola_covid", "grupo_edad"),
  c("ola_covid", "sexo"),
  c("ola_covid", "region"),
  c("ola_covid", "macrorregion"),
  c("departamento"),
  c("departamento", "sexo"),
  c("departamento", "grupo_edad"),
  c("departamento", "sexo", "grupo_edad"),
  c("departamento", "ola_covid"),
  c("distrito"),
  c("distrito", "sexo"),
  c("distrito", "grupo_edad"),
  c("distrito", "cuartil_pobreza"),
  c("grupo_edad", "cuartil_pobreza"),
  c("sexo", "cuartil_pobreza"),
  c("ola_covid", "cuartil_pobreza"),
  c("cuartil_pobreza"),
  c("region"),
  c("macrorregion")
)

# Calcular la tasa de hospitalizaciones
results_hospi <- index_calculator(
  data = hospitalizados, 
  denom = positivos_0723 %>% 
    mutate(cantidad = 1), 
  levels = levels, 
  type = "overall",
  std = 100
)

results_per_month_hospi <- index_calculator(
  data = hospitalizados, 
  denom = positivos_0723 %>% 
    mutate(cantidad = 1), 
  levels = levels, 
  type = "per_month",
  std = 100
)
In [189]:
hospi_total_df <- hospitalizados %>% 
  select(edad, grupo_edad, sexo, ola_covid, region, 
         macrorregion, cuartil_pobreza) %>% 
  collect()
In [190]:
tbl_summ_hospi_g <- hospi_total_df %>% 
  select(grupo_edad, sexo, ola_covid, region, 
         macrorregion, cuartil_pobreza) %>% 
  gtsummary::tbl_summary(
    label = list(
      grupo_edad = "Grupo de Edad",
      sexo = "Sexo",
      ola_covid = "Ola Covid",
      region = "Regiones naturales",
      macrorregion = "Macrorregiones",
      cuartil_pobreza = "Cuartil de Pobreza"
    ),
    missing_text = "Sin registro"
  ) %>% 
  gtsummary::modify_header(label = "**Variables**") %>%
  gtsummary::bold_labels()

tbl_summ_hospi_c2 <- results_hospi$grupo_edad$index %>% 
  rename(label = grupo_edad) %>% 
  bind_rows(
    results_hospi$sexo$index %>% 
      rename(label = sexo) 
  ) %>% 
  bind_rows(
    results_hospi$ola_covid$index %>% 
      rename(label = ola_covid)
  ) %>% 
  bind_rows(
    results_hospi$region$index %>% 
      rename(label = region)
  ) %>% 
  bind_rows(
    results_hospi$macrorregion$index %>% 
      rename(label = macrorregion)
  ) %>% 
  bind_rows(
    results_hospi$cuartil_pobreza$index %>% 
      rename(label = cuartil_pobreza)
  ) %>%
  drop_na() 


tbl_summ_hospi_final <- tbl_summ_hospi_g %>%
  gtsummary::modify_table_body(
    ~ .x %>% 
      left_join(tbl_summ_hospi_c2) %>% 
      mutate(
        label = case_when(
          variable == "cuartil_pobreza" & label == "1" ~ "1 (0-19.9%)",
          variable == "cuartil_pobreza" & label == "2" ~ "2 (20-39.9%)",
          variable == "cuartil_pobreza" & label == "3" ~ "3 (40-59.9%)",
          variable == "cuartil_pobreza" & label == "4" ~ "4 (60-100%)",
          .default = label
        )
      )
  ) %>% 
  gtsummary::modify_header(
    rate ~ "**Tasa de Hospitalización por 1000 positivos**"
  ) %>%
  gtsummary::modify_fmt_fun(
    rate ~ scales::number_format(accuracy = 0.001)
  )
Joining with `by = join_by(label)`
In [191]:
tbl_summ_hospi_final
Tabla 23: Descriptivos de Hospitalizados menores de 18 años (24-03-2020 a 16-06-2023)
Variables N = 6,9361 Tasa de Hospitalización por 1000 positivos
Grupo de Edad

    Under de 1 year 0 (0%)
    1 - 5 years 2,350 (34%) 5.157
    6 - 11 years 2,637 (38%) 2.877
    12 - 17 years 1,949 (28%) 1.208
Sexo

    Female 3,097 (45%) 1.941
    Male 3,839 (55%) 2.469
Ola Covid

    1 (Mar – Oct 2020) 1,217 (18%) 2.032
    2 (Nov 2020 – Oct 2021) 2,326 (34%) 3.210
    3 (Nov 2021 – Apr 2022) 2,018 (29%) 1.899
    4 (May 2022 – Oct 2022) 1,075 (15%) 1.848
    5 (Nov 2022 – Jun 2023) 300 (4.3%) 1.654
Regiones naturales

    Coast 5,368 (77%) 2.289
    Highlands 917 (13%) 1.700
    Jungle 651 (9.4%) 2.445
Macrorregiones

    Center 1,053 (15%) 1.462
    East 613 (8.8%) 2.510
    Metropolitan Lima and Callao 4,202 (61%) 3.550
    North 633 (9.1%) 1.252
    South 435 (6.3%) 0.876
Cuartil de Pobreza

    1 (0-19.9%) 4,323 (62%) 1.852
    2 (20-39.9%) 2,217 (32%) 4.458
    3 (40-59.9%) 342 (4.9%) 2.270
    4 (60-100%) 54 (0.8%) 3.659
1 n (%)
In [192]:
tbl_summ_hospi_final %>% 
  gtsummary::as_hux_xlsx("02_output/tables/hospitalizacion_descriptivos.xlsx")

tbl_summ_hospi_final %>%
  gtsummary::as_flex_table() %>%
  flextable::save_as_docx(path = "02_output/tables/hospitalizacion_descriptivos.docx")
In [193]:
downloadthis::download_file(
  path = "02_output/tables/hospitalizacion_descriptivos.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [194]:
downloadthis::download_file(
  path = "02_output/tables/hospitalizacion_descriptivos.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [195]:
tbl_summ_hospi_olas <- hospi_total_df %>% 
  select(grupo_edad, sexo, ola_covid, region, 
         macrorregion, cuartil_pobreza) %>% 
  gtsummary::tbl_summary(
    by = ola_covid,
    label = list(
      grupo_edad = "Grupo de Edad",
      sexo = "Sexo",
      ola_covid = "Ola Covid",
      region = "Regiones naturales",
      macrorregion = "Macrorregiones",
      cuartil_pobreza = "Cuartil de Pobreza"
    ),
    missing_text = "Sin registro"
  ) %>% 
  gtsummary::modify_header(label = "**Variables**") %>%
  gtsummary::bold_labels()


ola_covid_hospi_gtsumm <- results_hospi$ola_covid_grupo_edad$index %>%
  rename(label = grupo_edad,
         stat = ola_covid) %>% 
  bind_rows(
    results_hospi$ola_covid_sexo$index %>% 
      rename(label = sexo,
             stat = ola_covid),
    results_hospi$ola_covid_region$index %>% 
      rename(label = region,
             stat = ola_covid),
    results_hospi$ola_covid_macrorregion$index %>% 
      rename(label = macrorregion,
             stat = ola_covid),
    results_hospi$ola_covid_cuartil_pobreza$index %>% 
      rename(label = cuartil_pobreza,
             stat = ola_covid)
  ) %>% 
  mutate(
    rate = round(rate, 3),
    stat = as.character(stat),
    stat = case_match(
      stat,
      "Ola 1 (Marzo-Octubre 2020)" ~ "stat_1",
      "Ola 2 (Noviembre-Octubre 2021)" ~ "stat_2",
      "Ola 3 (Noviembre-Abril 2022)" ~ "stat_3",
      "Ola 4 (Mayo-Octubre 2022)" ~ "stat_4",
      "Ola 5 (Noviembre-Diciembre 2023)" ~ "stat_5"
    )
  ) 

tbl_summ_hospi_olas$table_body <- tbl_summ_hospi_olas$table_body %>%
  mutate(
    across(
      gtsummary::all_stat_cols(stat_0 = FALSE),
      ~ str_remove_all(., "\\s*\\(.*?\\)\\s*")
    )
  ) %>% 
  pivot_longer(
    cols = stat_1:stat_5,
    names_to = "stat",
    values_to = "freq"
  ) %>% 
  left_join(
    ola_covid_hospi_gtsumm
  ) %>% 
  mutate(
    value = str_c(freq, ifelse(is.na(rate), "", str_c(" (", rate, ")")))
  ) %>% 
  select(-c(freq, rate)) %>% 
  pivot_wider(
    names_from = stat,
    values_from = value
  )
Joining with `by = join_by(label, stat)`
In [196]:
tbl_summ_hospi_olas <- tbl_summ_hospi_olas %>% 
  gtsummary::modify_footnote(
    gtsummary::all_stat_cols() ~ "n (prevalencia)"
  )

tbl_summ_hospi_olas
Tabla 24: Descriptivos de hospitalizados menores de 18 años por olas (24-03-2020 a 16-06-2023)
Variables 1 (Mar – Oct 2020), N = 1,2171 2 (Nov 2020 – Oct 2021), N = 2,3261 3 (Nov 2021 – Apr 2022), N = 2,0181 4 (May 2022 – Oct 2022), N = 1,0751 5 (Nov 2022 – Jun 2023), N = 3001
Grupo de Edad




    Under de 1 year 0 0 0 0 0
    1 - 5 years 246 654 846 498 106
    6 - 11 years 522 926 673 372 144
    12 - 17 years 449 746 499 205 50
Sexo




    Female 537 1,007 898 499 156
    Male 680 1,319 1,120 576 144
Regiones naturales




    Coast 742 1,727 1,669 958 272
    Highlands 190 340 283 83 21
    Jungle 285 259 66 34 7
Macrorregiones




    Center 191 315 345 185 17
    East 270 246 65 25 7
    Metropolitan Lima and Callao 481 1,404 1,311 761 245
    North 192 220 164 44 13
    South 83 141 133 60 18
Cuartil de Pobreza




    1 861 1,481 1,144 597 240
    2 285 684 758 440 50
    3 59 135 105 34 9
    4 12 26 11 4 1
1 n (prevalencia)
In [197]:
tbl_summ_hospi_olas %>% 
  gtsummary::as_hux_xlsx("02_output/tables/hospitalizados_olas_descriptivos.xlsx")

tbl_summ_hospi_olas %>%
  gtsummary::as_flex_table() %>%
  flextable::save_as_docx(path = "02_output/tables/hospitalizados_olas_descriptivos.docx")
In [198]:
downloadthis::download_file(
  path = "02_output/tables/hospitalizados_olas_descriptivos.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [199]:
downloadthis::download_file(
  path = "02_output/tables/hospitalizados_olas_descriptivos.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Gráfico de hospitalización (serie de tiempo) - Menores de 18 años

In [200]:
# 
# range_positivos_und_18 <- positivos %>% 
#   filter(edad < 18, 
#          sexo != "No registrado") %>% 
#   pull(fecha_resultado) %>%
#   range()

hospitalizados %>% 
  to_arrow() %>% 
  mutate(
    fecha_round = ceiling_date(fecha_ingreso_hosp, unit = "month")
  ) %>%
  compute() %>% 
  to_duckdb() %>% 
  # mutate(
  #   fecha_round = case_when(
  #     fecha_round == as.Date("2024-01-01") ~  as.Date("2023-12-31"),
  #     .default = fecha_round
  #   )
  # ) %>% 
  count(grupo_edad, fecha_round) %>% 
  collect() %>% 
  ggplot(
    aes(
      x = fecha_round,
      y = n,
      fill = grupo_edad
    )
  ) +
  geom_area(position = 'stack') +
  innovar::scale_fill_innova("jama") +
  scale_x_date(
    limits = c(ymd("2020-03-07"), ymd("2023-07-01")),
    breaks = seq(from = ceiling_date(ymd("2020-03-07"), "month"),
                 to = floor_date(ymd("2023-07-01"), "month"),
                 by = "2 months"), 
    # date_breaks = "2 month",
    date_labels = "%b %Y"
  ) +
  labs(
    y = NULL,
    x = NULL,
    title = "Hospitalizados COVID Población Menor de 18 años",
    fill = "Grupo de Edad"
  ) + 
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45
    )
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-03-01"), 
    xmax = as.Date("2020-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2020-07-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Primera ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-11-01"), 
    xmax = as.Date("2021-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2021-04-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Segunda ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2021-11-01"), 
    xmax = as.Date("2022-04-30"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-02-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Tercera ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2022-05-01"), 
    xmax = as.Date("2022-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-08-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Cuarta ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2022-11-01"), 
    xmax = as.Date("2023-07-01"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2023-03-01"),
    y = Inf, # Posición vertical del texto
    label = "Quinta ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  )
Warning: Removed 1 row containing missing values or values outside the scale range
(`geom_rect()`).
Figura 31: Hospitalización COVID-19 de acuerdo a la edad y ola covid (24-03-2020 a 16-06-2023)

Gráfico Tasa de hospitalización (serie de tiempo)

In [201]:
per_month_hospi_under_1 <- tibble(
  grupo_edad = "Under 1 year",
  time = seq(from = as.Date("2020-03-01"), to = as.Date("2023-07-01"), by = "month"),
  rate = 0
)

hospi_rate_by_age_area <- results_per_month_hospi$grupo_edad$index %>% 
  mutate(
    time = make_date(anio, mes, "1")
  ) %>% 
  bind_rows(
    per_month_hospi_under_1
  ) %>%  
  ggplot(
    aes(
      x = time,
      y = rate,
      fill = grupo_edad
    )
  ) +
  geom_area(position = 'stack') +
  # scale_fill_manual(
  #   values = c(
  #     "#0b4e60",  "#2c9bb4", "#dae2bc", "#8c3a33"
  #   ), 
  #   na.value = "#0b4e60", 
  #   drop = FALSE
  # ) +
  innovar::scale_fill_innova("jama", drop = FALSE) +
  scale_x_date(
    limits = c(ymd("2020-03-01"), ymd("2023-07-01")),
    breaks = seq(from = ceiling_date(ymd("2020-03-01"), "month"),
                 to = floor_date(ymd("2023-07-01"), "month"),
                 by = "2 months"), 
    # date_breaks = "2 month",
    date_labels = "%b %Y"
  ) +
  labs(
    y = NULL,
    x = NULL,
    title = "Monthly hospital admissions per 100 cases",
    fill = "Age Group"
  ) + 
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45
    )
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-03-01"), 
    xmax = as.Date("2020-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2020-07-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "First wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-11-01"), 
    xmax = as.Date("2021-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2021-04-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Second wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2021-11-01"), 
    xmax = as.Date("2022-04-30"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-02-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Third wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2022-05-01"), 
    xmax = as.Date("2022-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-08-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Fourth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2022-11-01"), 
    xmax = as.Date("2023-07-01"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2023-03-01"),
    y = Inf, # Posición vertical del texto
    label = "Fifth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  )

hospi_rate_by_age_area

Pirámide frecuencia - Edades

In [202]:
hospi_total_df %>% 
  mutate(
    edad = factor(edad)
  ) %>% 
  age_pyramid(
    age_group = "edad",
    split_by = "sexo"
  ) +
  scale_fill_brewer(palette = "Dark2") +
  labs(
    x = "Edad",
    fill = "Sexo",
    y = "Frecuencia"
  ) +
  theme_classic()
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.

In [203]:
hospi_total_df %>% 
  age_pyramid(
    age_group = "grupo_edad",
    split_by = "sexo"
  ) +
  scale_fill_brewer(palette = "Dark2") +
  labs(
    x = "Grupo de Edad",
    fill = "Sexo",
    y = "Frecuencia"
  ) +
  theme_classic()
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.

Pirámide proporcional - Edades

In [204]:
hospi_total_df %>% 
  mutate(
    edad = factor(edad)
  ) %>% 
  age_pyramid(
    age_group = "edad",
    split_by = "sexo",
    proportional = TRUE
  ) +
   scale_fill_brewer(palette = "Dark2") +
  labs(
    x = "Edad",
    fill = "Sexo",
    y = "Porcentaje"
  ) +
  theme_classic()
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.

In [205]:
hospi_total_df %>% 
  age_pyramid(
    age_group = "grupo_edad",
    split_by = "sexo",
    proportional = TRUE
  ) +
   scale_fill_brewer(palette = "Dark2") +
  labs(
    x = "Grupo de Edad",
    fill = "Sexo",
    y = "Porcentaje"
  ) +
  theme_classic()
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.

Tasa de Hospitalización

In [206]:
results_hospi$departamento_sexo_grupo_edad$index %>% 
  mutate(
    departamento = str_to_title(departamento)
  ) %>% 
  ggplot(
    aes(
      x = departamento,
      y = rate,
      fill = sexo,
      group = sexo
    )
  ) +
  geom_area() +
  facet_wrap(vars(grupo_edad),
             nrow = 2) +
  innovar::scale_fill_innova("jama") +
  labs(
    y = NULL,
    x = NULL,
    title = "Tasa de hospitalización por 1000 positivos COVID Población Menor de 18 años",
    fill = "Sexo"
  ) + 
  theme_bw() +
  theme(
    axis.text.x = element_text(
      angle = 45,
      hjust = 1,
      vjust = 1
    )
  )
Figura 32: Tasa de Hospitalización por 1000 positivos COVID-19 de acuerdo al departamento, sexo y edad (24-03-2020 a 16-06-2023)

Departamento

In [207]:
tasa_hospi_dep_sf <- peru_dep_sf %>% 
  rename(departamento = dep) %>% 
  inner_join(
    results_hospi$departamento$index
  ) 
Joining with `by = join_by(departamento)`
In [208]:
tasa_hospi_dep_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap(
        "Hospital admissions per 100 cases",
        20
      )
    )
  ) +
  scale_fill_distiller(palette = "Oranges", # Old: "YlOrBr",
                       direction = 1) + 
  theme_void()
Figura 33: Tasa de Hospitalización por 100 positivos COVID-19 de acuerdo al departamento (24-03-2020 a 16-06-2023)
In [209]:
In [210]:
tbl_summ_hosp_dep_pre <- results_hospi$departamento$index %>% 
  mutate(
    rate = formattable::digits(rate, 3)
  ) %>% 
  mutate(
    departamento = str_to_title(departamento)
  ) 

tbl_summ_hosp_dep <- tbl_summ_hosp_dep_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_hosp_dep
Tabla 25: Tasa de Hospitalización COVID-19 de acuerdo al departamento (07-03-2020 a 17-06-2023)
Departamento Rate
Amazonas 1.577
Ancash 4.497
Apurimac 1.874
Arequipa 0.104
Ayacucho 0.492
Cajamarca 3.227
Callao 2.164
Cusco 2.764
Huancavelica 2.102
Huanuco 1.501
Ica 0.466
Junin 0.829
La Libertad 0.201
Lambayeque 0.475
Lima 3.207
Loreto 0.643
Madre De Dios 1.725
Moquegua 0.537
Pasco 1.452
Piura 1.511
Puno 0.307
San Martin 4.209
Tacna 0.498
Tumbes 0.299
Ucayali 3.933
In [211]:
tbl_summ_hosp_dep_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:2) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/tasa_hospitalizacion_departamento.xlsx",
                       open = FALSE)

tbl_summ_hosp_dep %>%
  gt::gtsave("02_output/tables/tasa_hospitalizacion_departamento.docx")
In [212]:
downloadthis::download_file(
  path = "02_output/tables/tasa_hospitalizacion_departamento.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [213]:
downloadthis::download_file(
  path = "02_output/tables/tasa_hospitalizacion_departamento.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Departamento y Sexo

In [214]:
tasa_hospi_dep_sex_sf <- peru_dep_sf %>% 
  rename(departamento = dep) %>% 
  inner_join(
    results_hospi$departamento_sexo$index
  ) %>%
  ungroup()
Joining with `by = join_by(departamento)`
In [215]:
tasa_hospi_dep_sex_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap(
        "Hospital admissions per 100 cases",
        20
      )
    )
  ) +
  scale_fill_distiller(palette = "Oranges",  #"YlOrBr",
                       direction = 1) + 
  facet_wrap(vars(sexo)) + 
  theme_void()
Figura 34: Tasa de Hospitalización por 100 positivos COVID-19 de acuerdo al departamento y sexo(24-03-2020 a 16-06-2023)
In [216]:
results_hospi$departamento_sexo$index %>% 
  mutate(
    departamento = str_to_title(departamento),
    departamento = fct_reorder(departamento, rate, .desc = TRUE)
    # departamento = fct_reorder2(departamento, sexo, tasa_hospi_mes)
  ) %>%
  ggplot(aes(x = departamento, y = rate, fill = sexo)) +
  geom_bar(stat = "identity", position = position_dodge()) +
  theme_bw() +
  labs(title = "Hospital admissions COVID-19 by department and sex", 
       x = NULL, 
       y = "Hospital admissions per 100 cases",
       fill = "Sex",
       caption = paste0("Total hospital admissions: ", 
                        scales::number(sum(pull(results_hospi$departamento_sexo$index_pre, count))))) +
  innovar::scale_fill_innova("blue_fall") +
  theme(
    axis.text.x = element_text(
      angle = 45,
      hjust = 1,
      vjust = 1
    )
  )
Figura 35: Tasa de Hospitalización por 100 positivos COVID-19 de acuerdo al departamento y sexo (24-03-2020 a 16-06-2023)

Departamento y Edad

In [217]:
tasa_hospi_dep_edad_sf <- peru_dep_sf %>% 
  rename(departamento = dep) %>% 
  inner_join(
    results_hospi$departamento_grupo_edad$index
  ) %>%
  ungroup()
Joining with `by = join_by(departamento)`
In [218]:
tasa_hospi_dep_edad_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap(
        "Hospital admissions per 100 cases",
        20
      )
    )
  ) +
  scale_fill_distiller(palette = "Oranges", # Old: "YlOrBr",
                       direction = 1) + 
  facet_wrap(vars(grupo_edad),
             nrow = 1) + 
  theme_void()
Figura 36: Tasa de Hospitalización por 100 positivos COVID-19 de acuerdo al departamento y grupo de edad(24-03-2020 a 16-06-2023)

Departamento y Olas

In [219]:
tasa_hospi_dep_olas_mother <- crossing(
  ola_covid = levels(results_hospi$departamento_ola_covid$index$ola_covid),
  departamento = unique(results_hospi$departamento_ola_covid$index$departamento)
)

tasa_hospi_dep_olas <- tasa_hospi_dep_olas_mother %>% 
  left_join(results_hospi$departamento_ola_covid$index) %>% 
  bind_rows(
    results_hospi$departamento$index %>% 
      mutate(ola_covid = "Overall")
  ) %>% 
  mutate(
    ola_covid = str_wrap(ola_covid, 20),
    ola_covid = fct_relevel(ola_covid,
                            "Overall")
  ) %>% 
  arrange(ola_covid)
Joining with `by = join_by(ola_covid, departamento)`
tasa_hospi_dep_olas_sf <- peru_dep_sf %>%
  rename(departamento = dep) %>% 
  left_join(
    tasa_hospi_dep_olas
  ) %>%
  ungroup()
Joining with `by = join_by(departamento)`
In [220]:
tasa_hospi_dep_olas_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap(
        "Hospital admissions per 100 cases",
        20
      )
    )
  ) +
  scale_fill_distiller(palette = "Oranges", #Old: "YlOrBr",
                       direction = 1) + 
  facet_wrap(vars(ola_covid), nrow = 1) + 
  theme_void()
Figura 37: Tasa de Hospitalización por 1000 positivos COVID-19 de acuerdo al departamento y ola (24-03-2020 a 16-06-2023)

Region

In [221]:
tasa_hospi_reg_sf <- peru_reg_sf %>% 
  inner_join(
    results_hospi$region$index
  ) 
Joining with `by = join_by(region)`
In [222]:
tasa_hospi_reg_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap(
        "Hospital admissions per 100 cases",
        20
      )
    )
  ) +
  ggsflabel::geom_sf_label(aes(label = region)) +
  scale_fill_distiller(palette = "Oranges", #Old: "YlOrBr",
                       direction = 1) + 
  theme_void()
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data
Figura 38: Tasa de Hospitalización por 100 positivos COVID-19 de acuerdo a la región (24-03-2020 a 16-06-2023)

Macrorregión

In [223]:
tasa_hospi_macro_sf <- peru_macro_sf %>% 
  inner_join(
    results_hospi$macrorregion$index
  ) 
Joining with `by = join_by(macrorregion)`
In [224]:
hospi_macro_map <- tasa_hospi_macro_sf %>%
  mutate(
    macrorregion = str_wrap(macrorregion, width = 15)
  ) %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  ggsflabel::geom_sf_label_repel(aes(label = macrorregion),
                                 force = 100,
                                 seed = 2024) +
  guides(
    fill = guide_legend(
      str_wrap("Hospital admissions per 100 cases", 
               20)
    )
  ) +
  scale_fill_distiller(palette = "Oranges", # Old: YlOrBr
                       direction = 1) + 
  theme_void()

hospi_macro_map
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data
Figura 39: Tasa de Hospitalización por 1000 positivos COVID-19 de acuerdo a la macrorregión (24-03-2020 a 16-06-2023)

Distrital y pobreza

In [225]:
results_per_month_hospi$cuartil_pobreza$index %>% 
  drop_na() %>% 
  mutate(
    time = make_date(anio, mes, "1")
  ) %>% 
  ggplot(
    aes(x = time,
        y = rate,
        color = cuartil_pobreza)
  ) +
  geom_line(linewidth = 1) +
  innovar::scale_color_innova("jama") +
  scale_x_date(
    limits = c(ymd("2020-03-01"), ymd("2023-07-01")),
    breaks = seq(from = ceiling_date(ymd("2020-03-01"), "month"),
                 to = floor_date(ymd("2023-07-01"), "month"),
                 by = "2 months"), 
    # date_breaks = "2 month",
    date_labels = "%b %Y"
  ) +
  labs(
    y = NULL,
    x = NULL,
    title = "Hospital admissions COVID-19 under 18 years old",
    color = "Poverty Quartiles"
  ) + 
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45
    )
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-03-01"), 
    xmax = as.Date("2020-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2020-07-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "First wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-11-01"), 
    xmax = as.Date("2021-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2021-04-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Second wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2021-11-01"), 
    xmax = as.Date("2022-04-30"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-02-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Third wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2022-05-01"), 
    xmax = as.Date("2022-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-08-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Fourth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2022-11-01"), 
    xmax = as.Date("2023-07-01"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2023-03-01"),
    y = Inf, # Posición vertical del texto
    label = "Fifth wave", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  )
Figura 40: Mortalidad COVID-19 de acuerdo al cuartil de pobreza(14-03-2020 a 13-06-2023)

Distrito Lima

In [226]:
total_hospi_distr_lim_callao <- results_hospi$distrito$index_pre %>% 
  filter(provincia %in% c("LIMA", "CALLAO")) %>% 
  pull(count) %>% 
  sum()

results_hospi$distrito$index %>% 
  filter(provincia %in% c("LIMA", "CALLAO")) %>% 
  drop_na() %>% 
  mutate(
    distrito = str_to_title(distrito), 
    distrito = fct_reorder(distrito, rate)
  ) %>% 
  ggplot(aes(y = distrito, x = rate)) +
  geom_bar(stat = "identity",
           color = "black",
           fill = "grey80") +
  theme_bw() +
  labs(title = "Hospital admissions COVID-19 in Metropolitan Lima", 
       x = NULL, 
       y = "Hospital admissions per 100 cases",
       caption = paste0("Total hospital admissions: ", 
                        scales::number(total_hospi_distr_lim_callao))) +
  innovar::scale_fill_innova("blue_fall") +
  theme(
    legend.position = "bottom"
  )
Figura 41: Tasa de Hospitalización COVID-19 de acuerdo a los distritos de lima metropolitana (24-03-2020 a 16-06-2023)
In [227]:
tasa_hospi_lima_distr_1k_sf <- Peru %>% 
  inner_join(
    results_hospi$distrito$index %>% 
      filter(provincia %in% c("LIMA", "CALLAO"))
  )
Joining with `by = join_by(ubigeo)`
In [228]:
tasa_hospi_lima_distr_1k_sf %>%
  mutate(
    label = case_when(
      rate > 25 ~ str_to_title(distrito)
    )
  ) %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap("Hospital admissions per 100 cases", 
               20)
    )
  ) +
  ggsflabel::geom_sf_label_repel(aes(label = label),
                                 force = 10,
                                 size = 2.45,
                                 box.padding = 0.75,
                                 seed = 2024) +
  scale_fill_distiller(palette = "YlOrBr",
                       direction = 1) + 
  theme_void()
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data
Warning: Removed 48 rows containing missing values or values outside the scale range
(`geom_label_repel()`).
Figura 42: Tasa de Hospitalización COVID-19 de acuerdo a los distritos de lima metropolitana (24-03-2020 a 16-06-2023)
In [229]:
In [230]:
tbl_summ_tasa_hospi_lima_distr_pre <- results_hospi$distrito$index %>% 
      filter(provincia %in% c("LIMA", "CALLAO")) %>% 
  mutate(
    across(
      departamento:distrito,
      str_to_title
    ),
    rate = formattable::digits(rate, 3)
  ) %>% 
  select(-departamento)

tbl_summ_tasa_hospi_lima_distr <- tbl_summ_tasa_hospi_lima_distr_pre %>% 
  rename_with(
    .fn = ~ paste0("**", str_to_title(.x), "**")
  ) %>% 
  gt::gt() %>% 
  gt::cols_label(
    .fn = gt::md,
    .process_units = TRUE
  )

tbl_summ_tasa_hospi_lima_distr
Tabla 26: Tasa de Hospitalización COVID-19 de acuerdo a los distritos de lima metropolitana (24-03-2020 a 16-06-2023)
Ubigeo Provincia Distrito Rate
070101 Callao Callao 2.327
070102 Callao Bellavista 0.870
070103 Callao Carmen De La Legua Reynoso NA
070104 Callao La Perla 0.937
070106 Callao Ventanilla 3.471
070107 Callao Mi Peru 3.256
150101 Lima Lima 3.184
150102 Lima Ancon 4.301
150103 Lima Ate 2.615
150104 Lima Barranco 0.951
150105 Lima Brena 16.426
150106 Lima Carabayllo 2.786
150107 Lima Chaclacayo 0.620
150108 Lima Chorrillos 1.923
150109 Lima Cieneguilla 3.906
150110 Lima Comas 2.839
150111 Lima El Agustino 1.860
150112 Lima Independencia 5.366
150113 Lima Jesus Maria 0.384
150114 Lima La Molina 0.292
150115 Lima La Victoria 2.023
150116 Lima Lince 1.149
150117 Lima Los Olivos 3.042
150118 Lima Lurigancho 2.291
150119 Lima Lurin 14.056
150120 Lima Magdalena Del Mar 0.251
150121 Lima Pueblo Libre 0.496
150122 Lima Miraflores 0.357
150123 Lima Pachacamac 7.502
150124 Lima Pucusana 13.415
150125 Lima Puente Piedra 5.234
150126 Lima Punta Hermosa 13.253
150127 Lima Punta Negra 6.098
150128 Lima Rimac 7.053
150129 Lima San Bartolo 9.821
150130 Lima San Borja 1.491
150131 Lima San Isidro 0.195
150132 Lima San Juan De Lurigancho 4.658
150133 Lima San Juan De Miraflores 3.851
150134 Lima San Luis 1.077
150135 Lima San Martin De Porres 5.082
150136 Lima San Miguel 0.787
150137 Lima Santa Anita 2.585
150138 Lima Santa Maria Del Mar 5.263
150139 Lima Santa Rosa 6.742
150140 Lima Santiago De Surco 0.482
150141 Lima Surquillo 1.001
150142 Lima Villa El Salvador 31.365
150143 Lima Villa Maria Del Triunfo 7.358
In [231]:
tbl_summ_tasa_hospi_lima_distr_pre %>% 
  rename_with(
    .fn = str_to_title
  ) %>% 
  huxtable::as_hux() %>% 
  huxtable::set_bold(1, 1:4) %>% 
  huxtable::quick_xlsx(file = "02_output/tables/tasa_hospitalizacion_lima_distrito.xlsx",
                       open = FALSE)

tbl_summ_tasa_hospi_lima_distr %>%
  gt::gtsave("02_output/tables/tasa_hospitalizacion_lima_distrito.docx")
In [232]:
downloadthis::download_file(
  path = "02_output/tables/tasa_hospitalizacion_lima_distrito.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [233]:
downloadthis::download_file(
  path = "02_output/tables/tasa_hospitalizacion_lima_distrito.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Tasa de Vacunación

In [234]:
range_vacu <- vacunas_18 %>% 
  summarise(
    min = min(fecha_vacunacion),
    max = max(fecha_vacunacion)
  ) %>% 
  collect() %>% 
  mutate(
    min = format(min, "%d-%m-%Y"),
    max = format(max, "%d-%m-%Y"),
    fecha = paste0("(", min, " a ", max, ")")
  )

Vista General

Cálculo de prevalencias

In [235]:
levels <- list(
  c("dosis"),
  c("grupo_edad"),
  c("sexo"),
  c("ola_covid"),
  c("ola_covid", "grupo_edad"),
  c("departamento"),
  c("departamento", "sexo"),
  c("departamento", "grupo_edad"),
  c("departamento", "sexo", "grupo_edad"),
  c("departamento", "ola_covid"),
  c("distrito"),
  c("distrito", "sexo"),
  c("distrito", "grupo_edad"),
  c("distrito", "cuartil_pobreza"),
  c("grupo_edad", "cuartil_pobreza"),
  c("sexo", "cuartil_pobreza"),
  c("ola_covid", "cuartil_pobreza"),
  c("cuartil_pobreza"),
  c("region"),
  c("region", "grupo_edad"),
  c("macrorregion"),
  c("macrorregion", "grupo_edad"),
  c("grupo_edad", "dosis"),
  c("sexo", "dosis"),
  c("ola_covid", "dosis"),
  c("ola_covid", "grupo_edad", "dosis"),
  c("departamento", "dosis"),
  c("departamento", "sexo", "dosis"),
  c("departamento", "grupo_edad", "dosis"),
  c("departamento", "sexo", "grupo_edad", "dosis"),
  c("departamento", "ola_covid", "dosis"),
  c("distrito", "dosis"),
  c("distrito", "sexo", "dosis"),
  c("distrito", "grupo_edad", "dosis"),
  c("distrito", "cuartil_pobreza", "dosis"),
  c("grupo_edad", "cuartil_pobreza", "dosis"),
  c("sexo", "cuartil_pobreza", "dosis"),
  c("ola_covid", "cuartil_pobreza", "dosis"),
  c("cuartil_pobreza", "dosis"),
  c("region", "dosis"),
  c("region", "grupo_edad", "dosis"),
  c("macrorregion", "dosis"),
  c("macrorregion", "grupo_edad", "dosis")
)

# Calcular la tasa de vacunacion
results_vacunas <- index_calculator(
  data = vacunas_18, 
  denom = poblacion, 
  levels = levels, 
  type = "month"
)
In [236]:
vacunas_18_descr_tbl <- vacunas_18 %>% 
  select(edad, grupo_edad, sexo, ola_covid, region, 
         macrorregion, cuartil_pobreza,
         dosis) %>% 
  collect() 
In [237]:
tbl_summ_vacunas_g <- vacunas_18_descr_tbl %>% 
  select(-edad) %>% 
  gtsummary::tbl_summary(
    label = list(
      grupo_edad = "Grupo de Edad",
      sexo = "Sexo",
      ola_covid = "Ola Covid",
      region = "Regiones naturales",
      macrorregion = "Macrorregiones",
      cuartil_pobreza = "Cuartil de Pobreza",
      dosis = "Dosis"
    )
  ) %>% 
  gtsummary::modify_header(label = "**Variables**") %>%
  gtsummary::bold_labels()


tbl_summ_vacunas_c2 <- results_vacunas$grupo_edad$index %>% 
  rename(label = grupo_edad) %>% 
  mutate(variable = "grupo_edad") %>% 
  bind_rows(
    results_vacunas$sexo$index %>% 
      mutate(variable = "sexo") %>% 
      rename(label = sexo) 
  ) %>% 
  bind_rows(
    results_vacunas$ola_covid$index %>% 
      mutate(variable = "ola_covid") %>% 
      rename(label = ola_covid)
  ) %>% 
  bind_rows(
    results_vacunas$region$index %>% 
      mutate(variable = "region") %>% 
      rename(label = region)
  ) %>% 
  bind_rows(
    results_vacunas$macrorregion$index %>% 
      mutate(variable = "macrorregion") %>% 
      rename(label = macrorregion)
  ) %>% 
  bind_rows(
    results_vacunas$cuartil_pobreza$index %>% 
      mutate(variable = "cuartil_pobreza") %>% 
      rename(label = cuartil_pobreza)
  ) %>%
  bind_rows(
    results_vacunas$dosis$index %>% 
      mutate(dosis = as.character(dosis),
             variable = "dosis") %>% 
      rename(label = dosis)
  ) %>%
  drop_na() 


tbl_summ_vacunas_final <- tbl_summ_vacunas_g %>%
  gtsummary::modify_table_body(
    ~ .x %>% 
      left_join(tbl_summ_vacunas_c2) %>% 
      mutate(
        label = case_when(
          variable == "cuartil_pobreza" & label == "1" ~ "1 (0-19.9%)",
          variable == "cuartil_pobreza" & label == "2" ~ "2 (20-39.9%)",
          variable == "cuartil_pobreza" & label == "3" ~ "3 (40-59.9%)",
          variable == "cuartil_pobreza" & label == "4" ~ "4 (60-100%)",
          .default = label
        )
      )
  ) %>% 
  gtsummary::modify_header(
    rate ~ "**Tasa de Dosis de Vacunas aplicadas por 1000 habitantes**"
  ) %>%
  gtsummary::modify_fmt_fun(
    rate ~ scales::number_format(accuracy = 0.001)
  )
Joining with `by = join_by(variable, label)`
In [238]:
tbl_summ_vacunas_final
Tabla 27: Descriptivos de vacunación menores de 18 años (03-01-2021 a 17-06-2023)
Variables N = 16,476,9301 Tasa de Dosis de Vacunas aplicadas por 1000 habitantes
Grupo de Edad

    Under de 1 year 0 (0%)
    1 - 5 years 1,551,230 (9.4%) 19.696
    6 - 11 years 6,497,793 (39%) 69.705
    12 - 17 years 8,426,703 (51%) 83.787
    Unknown 1,204
Sexo

    Female 8,295,629 (50%) 58.422
    Male 8,181,301 (50%) 55.573
Ola Covid

    1 (Mar – Oct 2020) 0 (0%)
    2 (Nov 2020 – Oct 2021) 624,093 (3.8%) 6.055
    3 (Nov 2021 – Apr 2022) 11,485,452 (70%) 194.524
    4 (May 2022 – Oct 2022) 3,164,458 (19%) 55.242
    5 (Nov 2022 – Jun 2023) 1,202,927 (7.3%) 15.176
Regiones naturales

    Coast 10,954,135 (66%) 61.939
    Highlands 3,824,666 (23%) 47.939
    Jungle 1,698,129 (10%) 51.148
Macrorregiones

    Center 3,827,433 (23%) 61.177
    East 1,626,746 (9.9%) 51.405
    Metropolitan Lima and Callao 4,997,873 (30%) 61.655
    North 3,919,708 (24%) 60.187
    South 2,105,170 (13%) 45.349
Cuartil de Pobreza

    1 (0-19.9%) 10,219,266 (62%) 61.335
    2 (20-39.9%) 4,184,132 (25%) 54.946
    3 (40-59.9%) 1,689,543 (10%) 45.863
    4 (60-100%) 379,623 (2.3%) 49.993
    Unknown 4,366
Dosis

    1 7,457,839 (45%) 25.228
    2 6,341,776 (38%) 22.241
    3 2,640,530 (16%) 9.823
    4 35,901 (0.2%) 0.164
    5 660 (<0.1%) 0.008
    8 200 (<0.1%) 0.001
    9 24 (<0.1%) 0.000
1 n (%)
In [239]:
tbl_summ_vacunas_final %>% 
  gtsummary::as_hux_xlsx("02_output/tables/vacunas_descriptivos.xlsx")

tbl_summ_vacunas_final %>%
  gtsummary::as_flex_table() %>%
  flextable::save_as_docx(path = "02_output/tables/vacunas_descriptivos.docx")
In [240]:
downloadthis::download_file(
  path = "02_output/tables/vacunas_descriptivos.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [241]:
downloadthis::download_file(
  path = "02_output/tables/vacunas_descriptivos.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [242]:
In [243]:
tbl_summ_vacunas_olas <- vacunas_18_descr_tbl %>% 
  select(-edad) %>% 
  gtsummary::tbl_summary(
    by = ola_covid,
    label = list(
      grupo_edad = "Grupo de Edad",
      sexo = "Sexo",
      ola_covid = "Ola Covid",
      dosis = "Dosis"
    )
  ) %>% 
  gtsummary::modify_header(label = "**Variables**") %>%
  gtsummary::bold_labels()

tbl_summ_vacunas_olas
Tabla 28: Descriptivos de vacunación menores de 18 años por olas (03-01-2021 a 17-06-2023)
Variables 1 (Mar – Oct 2020), N = 01 2 (Nov 2020 – Oct 2021), N = 624,0931 3 (Nov 2021 – Apr 2022), N = 11,485,4521 4 (May 2022 – Oct 2022), N = 3,164,4581 5 (Nov 2022 – Jun 2023), N = 1,202,9271
Grupo de Edad




    Under de 1 year 0 (NA%) 0 (0%) 0 (0%) 0 (0%) 0 (0%)
    1 - 5 years 0 (NA%) 186 (<0.1%) 669,737 (5.8%) 301,115 (9.5%) 580,192 (48%)
    6 - 11 years 0 (NA%) 1,921 (0.3%) 4,863,069 (42%) 1,215,875 (38%) 416,928 (35%)
    12 - 17 years 0 (NA%) 621,117 (100%) 5,952,321 (52%) 1,647,460 (52%) 205,805 (17%)
    Unknown 0 869 325 8 2
Sexo




    Female 0 (NA%) 319,569 (51%) 5,752,025 (50%) 1,612,830 (51%) 611,205 (51%)
    Male 0 (NA%) 304,524 (49%) 5,733,427 (50%) 1,551,628 (49%) 591,722 (49%)
region




    Coast 0 (NA%) 434,934 (70%) 7,792,013 (68%) 1,946,537 (62%) 780,651 (65%)
    Highlands 0 (NA%) 181,262 (29%) 2,532,631 (22%) 820,631 (26%) 290,142 (24%)
    Jungle 0 (NA%) 7,897 (1.3%) 1,160,808 (10%) 397,290 (13%) 132,134 (11%)
macrorregion




    Center 0 (NA%) 130,603 (21%) 2,519,247 (22%) 848,169 (27%) 329,414 (27%)
    East 0 (NA%) 7,857 (1.3%) 1,112,026 (9.7%) 378,813 (12%) 128,050 (11%)
    Metropolitan Lima and Callao 0 (NA%) 119,044 (19%) 3,749,656 (33%) 784,067 (25%) 345,106 (29%)
    North 0 (NA%) 144,791 (23%) 2,742,765 (24%) 749,305 (24%) 282,847 (24%)
    South 0 (NA%) 221,798 (36%) 1,361,758 (12%) 404,104 (13%) 117,510 (9.8%)
cuartil_pobreza




    1 0 (NA%) 523,019 (84%) 7,216,666 (63%) 1,837,886 (58%) 641,695 (53%)
    2 0 (NA%) 79,594 (13%) 2,912,858 (25%) 849,427 (27%) 342,253 (28%)
    3 0 (NA%) 17,460 (2.8%) 1,100,109 (9.6%) 396,710 (13%) 175,264 (15%)
    4 0 (NA%) 3,483 (0.6%) 252,953 (2.2%) 79,656 (2.5%) 43,531 (3.6%)
    Unknown 0 537 2,866 779 184
Dosis




    1 0 (NA%) 539,332 (86%) 5,964,066 (52%) 500,204 (16%) 454,237 (38%)
    2 0 (NA%) 84,696 (14%) 5,244,815 (46%) 710,017 (22%) 302,248 (25%)
    3 0 (NA%) 61 (<0.1%) 276,516 (2.4%) 1,949,593 (62%) 414,360 (34%)
    4 0 (NA%) 2 (<0.1%) 25 (<0.1%) 4,533 (0.1%) 31,341 (2.6%)
    5 0 (NA%) 0 (0%) 1 (<0.1%) 0 (0%) 659 (<0.1%)
    8 0 (NA%) 1 (<0.1%) 21 (<0.1%) 101 (<0.1%) 77 (<0.1%)
    9 0 (NA%) 1 (<0.1%) 8 (<0.1%) 10 (<0.1%) 5 (<0.1%)
1 n (%)
In [244]:
tbl_summ_vacunas_olas %>% 
  gtsummary::as_hux_xlsx("02_output/tables/vacunas_olas_descriptivos.xlsx")

tbl_summ_vacunas_olas %>%
  gtsummary::as_flex_table() %>%
  flextable::save_as_docx(path = "02_output/tables/vacunas_olas_descriptivos.docx")
In [245]:
downloadthis::download_file(
  path = "02_output/tables/fallecidos_olas_descriptivos.xlsx",
  button_label = "Descargar tabla en Excel",
  button_type = "success",
  has_icon = TRUE,
  icon = "fa fa-save"
)
In [246]:
downloadthis::download_file(
  path = "02_output/tables/fallecidos_olas_descriptivos.docx",
  button_label = "Descargar tabla en Word",
  button_type = "primary",
  has_icon = TRUE,
  icon = "fa fa-save"
)

Gráfico de vacunación (serie de tiempo) - Menores de 18 años

Se restringió la visualización de dosis de 1 a 5.

In [247]:
summ_vacunas_dosis_fecha <- vacunas_18 %>% 
  to_arrow() %>%
  mutate(
    fecha_round = ceiling_date(fecha_vacunacion, unit = "month"),
    .after = fecha_vacunacion
  ) %>%
  filter(dosis %in% 1:5) %>% 
  count(dosis, fecha_round) %>% 
  collect()

summ_vacunas_dosis_fecha %>% 
  ggplot(
    aes(
      x = fecha_round,
      y = n,
      fill = as.factor(dosis)
    )
  ) +
  geom_area(position = 'stack') +
  innovar::scale_fill_innova("jama") +
  # scale_x_date(
  #   limits = c(ymd("2020-03-01"), ymd("2023-10-31")),
  #   breaks = scales::date_breaks("2 month"), # Cambiar a "6 months" para menos frecuencia
  #   labels = scales::date_format("%b %Y") # Formato de fecha, %b es la abreviatura de mes, %Y es el año
  # ) + 
  scale_x_date(
    limits = c(ymd("2020-03-01"), ymd("2023-07-01")),
    breaks = seq(from = ceiling_date(ymd("2020-03-01"), "month"),
                 to = floor_date(ymd("2023-07-01"), "month"),
                 by = "2 months"), 
    # date_breaks = "2 month",
    date_labels = "%b %Y"
  ) +
  scale_y_continuous(
    labels = scales::number_format()
  ) +
  labs(
    y = NULL,
    x = NULL,
    title = "Vacunación COVID Población Menor de 18 años",
    fill = "Dosis"
  ) + 
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45
    )
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-03-01"), 
    xmax = as.Date("2020-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2020-07-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Primera ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-11-01"), 
    xmax = as.Date("2021-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2021-04-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Segunda ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2021-11-01"), 
    xmax = as.Date("2022-04-30"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-02-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Tercera ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2022-05-01"), 
    xmax = as.Date("2022-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-08-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Cuarta ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2022-11-01"), 
    xmax = dmy(range_vacu$max), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2023-03-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Quinta ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  )
Figura 43: Vacunación COVID Población menor de edad de acuerdo a la dosis y ola (03-01-2021 a 17-06-2023)

Gráfico de vacunación (serie de tiempo) - Grupo Etáreo

In [248]:
summ_vacunas_edad_fecha <- vacunas_18 %>% 
  to_arrow() %>%
  mutate(
    fecha_round = ceiling_date(fecha_vacunacion, unit = "month"),
    .after = fecha_vacunacion
  ) %>%
  count(grupo_edad, fecha_round) %>% 
  collect() 

summ_vacunas_edad_fecha %>% 
  ggplot(
    aes(
      x = fecha_round,
      y = n,
      fill = grupo_edad
    )
  ) +
  geom_area(position = 'stack') +
  innovar::scale_fill_innova("jama") +
  # scale_x_date(
  #   limits = c(ymd("2020-03-01"), ymd("2023-10-31")),
  #   breaks = scales::date_breaks("2 month"), # Cambiar a "6 months" para menos frecuencia
  #   labels = scales::date_format("%b %Y") # Formato de fecha, %b es la abreviatura de mes, %Y es el año
  # ) + 
  scale_x_date(
    limits = c(ymd("2020-03-01"), ymd("2023-07-01")),
    breaks = seq(from = ceiling_date(ymd("2020-03-01"), "month"),
                 to = floor_date(ymd("2023-07-01"), "month"),
                 by = "2 months"), 
    # date_breaks = "2 month",
    date_labels = "%b %Y"
  ) +
  scale_y_continuous(
    labels = scales::number_format()
  ) +
  labs(
    y = NULL,
    x = NULL,
    title = "Fallecidos COVID Población Menor de 18 años",
    fill = "Criterio de Clasificación"
  ) + 
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45
    )
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-03-01"), 
    xmax = as.Date("2020-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2020-07-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Primera ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2020-11-01"), 
    xmax = as.Date("2021-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2021-04-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Segunda ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2021-11-01"), 
    xmax = as.Date("2022-04-30"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-02-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Tercera ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) + 
  annotate(
    geom = "rect",
    xmin = as.Date("2022-05-01"), 
    xmax = as.Date("2022-10-31"), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2022-08-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Cuarta ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  ) +
  annotate(
    geom = "rect",
    xmin = as.Date("2022-11-01"), 
    xmax = dmy(range_vacu$max), 
    ymin = 0, # El rectángulo se extiende hasta la parte inferior del gráfico
    ymax = Inf, # El rectángulo se extiende hasta la parte superior del gráfico
    color = "black", # Color de la línea
    fill = NA, # Sin relleno
    linetype = "dashed", # Tipo de línea discontinua
    linewidth = 0.5 # Grosor de la línea
  ) + 
  annotate(
    geom = "text", 
    x = as.Date("2023-03-01"), # Punto medio aproximado de la Ola 2
    y = Inf, # Posición vertical del texto
    label = "Quinta ola", 
    color = "black",
    size = 4, # Tamaño del texto
    vjust = 2 # Ajuste vertical para colocar el texto encima del rectángulo
  )
Figura 44: Vacunación COVID Población menor de edad de acuerdo al grupo etáreo y ola (03-01-2021 a 17-06-2023)

Pirámide frecuencia - Edades

In [249]:
library(patchwork)

Adjuntando el paquete: 'patchwork'
The following object is masked from 'package:cowplot':

    align_plots
create_age_pyramids <- function(data, age, by, proportional = FALSE, 
                                scale_adjust = 7, angle.axis = NULL) {
  plots <- list()
  
  for (dosis in 1:5) {
    # Filtra por dosis y crea el gráfico
    p <- data %>%
      filter(dosis == dosis) %>%
      age_pyramid(age_group = !!rlang::enquo(age), 
                  split_by = !!rlang::enquo(by),
                  proportional = proportional) +
      scale_fill_brewer(palette = "Dark2") +
      labs(
        subtitle = paste("Dosis", dosis),
        x = NULL,
        fill = "Sexo",
        y = NULL
      ) +
      theme_classic() +
      theme(
        axis.text.x = element_text(
          angle = angle.axis,
          vjust = 0.5,
          hjust = 0.5
        )
      )
    
    if (!proportional) {
      p <- p + 
        scale_y_continuous(
        labels = ~ scales::number(abs(.x)),
        n.breaks = scale_adjust
      ) 
    }
    
    if (dosis %in% 1:2) {
      p <- p +
        theme(
          axis.text.x = element_blank(),
          axis.ticks.x = element_blank()
        )
    }
    
    plots[[dosis]] <- p
  }
  
  # Combina todos los gráficos en uno solo usando patchwork
  combined_plot <- reduce(plots, `+`) +
    plot_layout(guides = 'collect') &
    labs(x = "Edad", y = "Frecuencia") +
    theme(legend.position = 'bottom')

  return(combined_plot)
}
In [250]:
vacunas_18_descr_tbl %>% 
  mutate(edad = factor(edad)) %>%
  create_age_pyramids(age = edad,
                      by = sexo)
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for y is already present.
Adding another scale for y, which will replace the existing scale.
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for y is already present.
Adding another scale for y, which will replace the existing scale.
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for y is already present.
Adding another scale for y, which will replace the existing scale.
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for y is already present.
Adding another scale for y, which will replace the existing scale.
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for y is already present.
Adding another scale for y, which will replace the existing scale.

In [251]:
vacunas_18_descr_tbl %>% 
  create_age_pyramids(age = grupo_edad, 
                      by = sexo, 
                      scale_adjust = 6,
                      angle.axis = 20)
Warning: 1204 missing rows were removed (1204 values from `grupo_edad` and 0
values from `sexo`).
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for y is already present.
Adding another scale for y, which will replace the existing scale.
Warning: 1204 missing rows were removed (1204 values from `grupo_edad` and 0
values from `sexo`).
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for y is already present.
Adding another scale for y, which will replace the existing scale.
Warning: 1204 missing rows were removed (1204 values from `grupo_edad` and 0
values from `sexo`).
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for y is already present.
Adding another scale for y, which will replace the existing scale.
Warning: 1204 missing rows were removed (1204 values from `grupo_edad` and 0
values from `sexo`).
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for y is already present.
Adding another scale for y, which will replace the existing scale.
Warning: 1204 missing rows were removed (1204 values from `grupo_edad` and 0
values from `sexo`).
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for y is already present.
Adding another scale for y, which will replace the existing scale.

Pirámide proporcional - Edades

In [252]:
vacunas_18_descr_tbl %>% 
  mutate(edad = factor(edad)) %>%
  create_age_pyramids(age = edad,
                      by = sexo,
                      proportional = TRUE)
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.

In [253]:
vacunas_18_descr_tbl %>% 
  create_age_pyramids(age = grupo_edad,
                      by = sexo,
                      proportional = TRUE,
                      angle.axis = 45)
Warning: 1204 missing rows were removed (1204 values from `grupo_edad` and 0
values from `sexo`).
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Warning: 1204 missing rows were removed (1204 values from `grupo_edad` and 0
values from `sexo`).
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Warning: 1204 missing rows were removed (1204 values from `grupo_edad` and 0
values from `sexo`).
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Warning: 1204 missing rows were removed (1204 values from `grupo_edad` and 0
values from `sexo`).
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Warning: 1204 missing rows were removed (1204 values from `grupo_edad` and 0
values from `sexo`).
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.

Departamento, edad y Dosis

In [254]:
vac_dep_edad_dosis_1k_mother <- crossing(
  departamento = unique(results_vacunas$departamento_grupo_edad_dosis$index$departamento),
  grupo_edad = unique(results_vacunas$departamento_grupo_edad_dosis$index$grupo_edad),
  dosis = 1:5
)

vac_dep_edad_dosis_1k <- vac_dep_edad_dosis_1k_mother %>% 
  left_join(results_vacunas$departamento_grupo_edad_dosis$index)
Joining with `by = join_by(departamento, grupo_edad, dosis)`
vac_dep_dosis_1k_mother <- crossing(
  departamento = unique(results_vacunas$departamento_dosis$index$departamento),
  dosis = 1:5
)

vac_dep_dosis_1k <- vac_dep_dosis_1k_mother %>% 
  left_join(results_vacunas$departamento_dosis$index)
Joining with `by = join_by(departamento, dosis)`
vac_dep_edad_dosis_1k_sf <- peru_dep_sf %>% 
  rename(departamento = dep) %>% 
  inner_join(
    vac_dep_edad_dosis_1k %>% 
      bind_rows(
        vac_dep_dosis_1k %>% 
          mutate(grupo_edad = "Total")
      ) %>% 
      mutate(
        grupo_edad = fct_relevel(
          grupo_edad,
          "Menos de 1 año",
          "1 - 5 años",
          "6 - 11 años",
          "12 - 17 años",
          "Total"
        )
      )
  ) %>% 
  ungroup()
Warning: There was 1 warning in `mutate()`.
ℹ In argument: `grupo_edad = fct_relevel(...)`.
Caused by warning:
! 4 unknown levels in `f`: Menos de 1 año, 1 - 5 años, 6 - 11 años, and 12 - 17
años
Joining with `by = join_by(departamento)`
In [255]:
vac_dep_edad_dosis_1k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap(
        "Tasa de Vacunación por 1000 habitantes",
        20
      )
    )
  ) +
  scale_fill_distiller(palette = "BuGn",
                       direction = 1,
                       na.value = "grey70") + 
  facet_grid(
    vars(dosis),
    vars(grupo_edad),
    labeller = labeller(grupo_edad = label_wrap_gen(10))
  ) +
  theme_void()
Figura 45: Tasa de Vacunación COVID-19 de acuerdo al departamento, edad y dosis (03-01-2021 a 17-06-2023)

Departamento y edad

In [256]:
vac_dep_edad_1k_mother <- crossing(
  departamento = unique(results_vacunas$departamento_grupo_edad$index$departamento),
  grupo_edad = unique(results_vacunas$departamento_grupo_edad$index$grupo_edad)
)

vac_dep_edad_1k <- vac_dep_edad_1k_mother %>% 
  left_join(results_vacunas$departamento_grupo_edad$index)
Joining with `by = join_by(departamento, grupo_edad)`
vac_dep_edad_1k_sf <- peru_dep_sf %>% 
  rename(departamento = dep) %>% 
  inner_join(
    vac_dep_edad_1k
  ) %>% 
  ungroup()
Joining with `by = join_by(departamento)`
In [257]:
vac_dep_edad_1k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap(
        "Tasa de Vacunación por 1000 habitantes",
        20
      )
    )
  ) +
  scale_fill_distiller(palette = "BuGn",
                       direction = 1,
                       na.value = "grey70") + 
  facet_wrap(
    vars(grupo_edad),
    labeller = labeller(grupo_edad = label_wrap_gen(10))
  ) +
  theme_void()
Figura 46: Tasa de Vacunación COVID-19 de acuerdo al departamento y edad (03-01-2021 a 17-06-2023)

Departamento y dosis

In [258]:
vac_dep_dosis_1k_sf <- peru_dep_sf %>% 
  rename(departamento = dep) %>% 
  inner_join(
    vac_dep_dosis_1k
  ) %>% 
  ungroup()
Joining with `by = join_by(departamento)`
In [259]:
vac_dep_dosis_1k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap(
        "Tasa de Vacunación por 1000 habitantes",
        20
      )
    )
  ) +
  scale_fill_distiller(palette = "BuGn",
                       direction = 1,
                       na.value = "grey70") + 
  facet_wrap(
    vars(dosis)
  ) +
  theme_void()
Figura 47: Tasa de Vacunación COVID-19 de acuerdo al departamento y dosis (03-01-2021 a 17-06-2023)

Region, edad vs Dosis

In [260]:
vac_reg_edad_dosis_1k_mother <- crossing(
  region = unique(results_vacunas$region_grupo_edad_dosis$index$region),
  grupo_edad = unique(results_vacunas$region_grupo_edad_dosis$index$grupo_edad),
  dosis = 1:5
)

vac_reg_edad_dosis_1k <- vac_reg_edad_dosis_1k_mother %>% 
  left_join(results_vacunas$region_grupo_edad_dosis$index)
Joining with `by = join_by(region, grupo_edad, dosis)`
vac_reg_dosis_1k_mother <- crossing(
  region = unique(results_vacunas$region_dosis$index$region),
  dosis = 1:5
)

vac_reg_dosis_1k <- vac_reg_dosis_1k_mother %>% 
  left_join(results_vacunas$region_dosis$index)
Joining with `by = join_by(region, dosis)`
vac_reg_edad_dosis_1k_sf <- peru_reg_sf %>% 
  inner_join(
    vac_reg_edad_dosis_1k %>% 
      bind_rows(
        vac_reg_dosis_1k %>% 
          mutate(grupo_edad = "Total")
      ) %>% 
      mutate(
        grupo_edad = fct_relevel(
          grupo_edad,
          "Menos de 1 año",
          "1 - 5 años",
          "6 - 11 años",
          "12 - 17 años",
          "Total"
        )
      )
  ) %>% 
  ungroup()
Warning: There was 1 warning in `mutate()`.
ℹ In argument: `grupo_edad = fct_relevel(...)`.
Caused by warning:
! 4 unknown levels in `f`: Menos de 1 año, 1 - 5 años, 6 - 11 años, and 12 - 17
años
Joining with `by = join_by(region)`
In [261]:
vac_reg_edad_dosis_1k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap(
        "Tasa de Vacunación por 1000 habitantes",
        20
      )
    )
  ) +
  scale_fill_distiller(palette = "BuGn",
                       direction = 1,
                       na.value = "grey70") + 
  facet_grid(
    vars(dosis),
    vars(grupo_edad),
    labeller = labeller(grupo_edad = label_wrap_gen(10))
  ) +
  theme_void()
Figura 48: Tasa de Vacunación COVID-19 de acuerdo a la región, edad y dosis (03-01-2021 a 17-06-2023)

Mapa de Tasa de Vacunación - 1000 habitantes Macrorregión, edad vs Dosis

In [262]:
pob_anio_macro_edad <- poblacion %>% 
  group_by(anio, macrorregion, grupo_edad) %>% 
  summarise(
    pob = sum(cantidad)
  ) %>% 
  window_order(anio, macrorregion, grupo_edad) %>% 
  ungroup() 

vac_mes_macro_edad_dosis <- vacunas_18 %>% 
  filter(dosis %in% 1:5) %>% 
  count(
    anio, mes, macrorregion, grupo_edad, dosis
  )

vac_mes_macro_edad_dosis_adic <- vac_mes_macro_edad_dosis %>% 
  left_join(
    pob_anio_macro_edad
  ) 
Joining with `by = join_by(anio, macrorregion, grupo_edad)`
vac_macro_edad_dosis_1k <- vac_mes_macro_edad_dosis_adic %>% 
  mutate(
    vacunacion_mes = n/pob
  ) %>% 
  group_by(across(macrorregion:dosis)) %>% 
  summarise(
    vacunacion_mes = mean(vacunacion_mes, na.rm = TRUE)*1000
  ) %>% 
  ungroup() %>% 
  collect() 
`summarise()` has grouped output by "macrorregion" and "grupo_edad". You can
override using the `.groups` argument.
`summarise()` has grouped output by "anio" and "macrorregion". You can override
using the `.groups` argument.
vac_macro_edad_dosis_1k_mother <- crossing(
  macrorregion = unique(vac_macro_edad_dosis_1k$macrorregion),
  grupo_edad = unique(vac_macro_edad_dosis_1k$grupo_edad),
  dosis = 1:5
)


vac_macro_edad_dosis_1k <- vac_macro_edad_dosis_1k_mother %>% 
  left_join(vac_macro_edad_dosis_1k)
Joining with `by = join_by(macrorregion, grupo_edad, dosis)`
vac_macro_edad_dosis_1k_sf <- peru_macro_sf %>% 
  inner_join(
    vac_macro_edad_dosis_1k
  ) %>% 
  ungroup()
Joining with `by = join_by(macrorregion)`
In [263]:
vac_macro_edad_dosis_1k_mother <- crossing(
  macrorregion = unique(results_vacunas$macrorregion_grupo_edad_dosis$index$macrorregion),
  grupo_edad = unique(results_vacunas$macrorregion_grupo_edad_dosis$index$grupo_edad),
  dosis = 1:5
)

vac_macro_edad_dosis_1k <- vac_macro_edad_dosis_1k_mother %>% 
  left_join(results_vacunas$macrorregion_grupo_edad_dosis$index)
Joining with `by = join_by(macrorregion, grupo_edad, dosis)`
vac_macro_dosis_1k_mother <- crossing(
  macrorregion = unique(results_vacunas$macrorregion_dosis$index$macrorregion),
  dosis = 1:5
)

vac_macro_dosis_1k <- vac_macro_dosis_1k_mother %>% 
  left_join(results_vacunas$macrorregion_dosis$index)
Joining with `by = join_by(macrorregion, dosis)`
vac_macro_edad_dosis_1k_sf <- peru_macro_sf %>% 
  inner_join(
    vac_macro_edad_dosis_1k %>% 
      bind_rows(
        vac_macro_dosis_1k %>% 
          mutate(grupo_edad = "Total")
      ) %>% 
      mutate(
        grupo_edad = fct_relevel(
          grupo_edad,
          "Menos de 1 año",
          "1 - 5 años",
          "6 - 11 años",
          "12 - 17 años",
          "Total"
        )
      )
  ) %>% 
  ungroup()
Warning: There was 1 warning in `mutate()`.
ℹ In argument: `grupo_edad = fct_relevel(...)`.
Caused by warning:
! 4 unknown levels in `f`: Menos de 1 año, 1 - 5 años, 6 - 11 años, and 12 - 17
años
Joining with `by = join_by(macrorregion)`
In [264]:
vac_macro_edad_dosis_1k_sf %>%
  ggplot() +
  geom_sf(aes(fill = rate)) +
  guides(
    fill = guide_legend(
      str_wrap(
        "Tasa de Vacunación por 1000 habitantes",
        20
      )
    )
  ) +
  scale_fill_distiller(palette = "BuGn",
                       direction = 1,
                       na.value = "grey70") + 
  facet_grid(
    vars(dosis),
    vars(grupo_edad),
    labeller = labeller(grupo_edad = label_wrap_gen(10))
  ) +
  theme_void()
Figura 49: Tasa de Vacunación COVID-19 de acuerdo a la macrorregión, edad y dosis (03-01-2021 a 17-06-2023)

Gráficos para ID Week

In [265]:
library(patchwork)
In [266]:
plots_area_index <- (prevalence_by_age_area + mortality_cases_by_age_area) /
(lethality_cases_by_age_area + hospi_rate_by_age_area) +
  plot_layout(guides = 'collect') +
    # labs(x = "Edad", y = "Frecuencia") +
    theme(legend.position = 'bottom') +
  plot_annotation(tag_levels = 'A')

plots_area_index
Warning: Removed 4 rows containing non-finite outside the scale range
(`stat_align()`).

In [267]:
ggsave(
  "plots_area_index.png",
  plot = plots_area_index,
  dpi = 400,
  bg = "white",
  width = 13,
  height = 9.5
)
In [268]:
plots_map_index <- (prev_macro_map + mort_macro_map) /
(let_macro_map + hospi_macro_map) +
  plot_annotation(tag_levels = 'A')

plots_map_index
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data
Warning in st_point_on_surface.sfc(data$geometry): st_point_on_surface may not
give correct results for longitude/latitude data

In [269]:
ggsave(
  "plots_map_index.png",
  plot = plots_map_index,
  dpi = 400,
  bg = "white",
  width = 8.5,
  height = 8
)
In [270]:
dbDisconnect(con, shutdown=TRUE)