Vigilancia epidemiologica con flexdashboard en tiempo real de la formula 1 México 2023, conectada a google sheet y hojas externas de excel

---
title: "Vig. Epi.F1 2023, Dr. Willebaldo Mantilla Rios `r format(Sys.time(), '%d/%m/%y %I:%M %p')`"
output: 
  flexdashboard::flex_dashboard:
    theme:
      bg: "#EEF9F8"
      fg: "#CA0020" 
      primary: "#1B6D39"
    orientation: rows
    vertical_layout: fill
    logo: F23.png
    source_code: embed
---
Vigilancia epidemiologica con flexdashboard en tiempo real de la formula 1 México 2023, conectada a google sheet y hojas externas de excel

<style>
.my-custom-row-1 {
  height: 10%;
}

.my-custom-row-2 {
  height: 90%;
}
</style>

```{r  include=FALSE, librerias}
# Bibliotecas generales y de configuración
library(treemapify)
library(ggplot2)
library(rio)
library(here)
library(tidyverse)
library(plotly)
library(readxl)
library(plotly)
library(pacman)
library(googleVis)
library(lubridate)

```

General {data-icon="fa-signal"}
===================================== 

```{r setup, include=FALSE}
library(flexdashboard)

atenciones_medicas = function(...) return(2842)
atenciones_urgencias = function(...) return(69)
traslados = function(...) return(5)
alertamientos = function(...) return(0)
```

Row {data-height=45% .my-custom-row-1}
-----------------------------------------------------------------------

### Atenciones medicas acumuladas 
```{r fig.width=0.1, fig.height= .5}
Carpas = atenciones_medicas()
valueBox(
  Carpas, 
  icon = "fa fa-hospital", 
  color = "success" )


```

### Atenciones de Urgencias
```{r fig.width=0.1, fig.height=.5}
urgencias = atenciones_urgencias()
valueBox(
  urgencias, 
  icon = "fa fa-procedures", 
  color = "info")
```

### Traslados
```{r fig.width=0.1, fig.height=.5}
traslados = traslados()
valueBox(
  traslados, 
  icon = "fa fa-ambulance", 
  color = ifelse(traslados > 1, "warning", "primary"),
  )
```

### Alertamientos a Hosp
```{r fig.width=0.1, fig.height=.5}
alertamientos = alertamientos()
valueBox(
  alertamientos, 
  icon = "fa fa-exclamation-triangle", 
  color = ifelse(alertamientos > 1, "danger", "primary"))
```




Row {data-height=55% .my-custom-row-2}
-----------------------------------------------------------------------

### Aforo
```{r fig.width=3.5, fig.height= 3}
Afluencia <- 125.1
gauge(Afluencia, min = 0, max = 100, symbol = '%', 
      label = "Afluencia", gaugeSectors(
        success = c(0,80), warning = c(81, 94), danger = c(95, 100)
      ))
```


### No de atenciones por Zona y Carpa

```{r echo=FALSE, warning=FALSE,fig.width=8, fig.height=8, message=FALSE}

library(googlesheets4)
library(dplyr)
library(pacman)

pacman::p_load(
  rio,        # importación/exportación de múltiples tipos de datos
  here,       # ruta relativa de los archivos
  janitor,    # limpieza de datos y tablas
  lubridate,  # trabajar con fechas
  epikit,     # función age_categories()
  tidyverse   # gestión y visualización de datos 
  

)

sheet_url <- "https://docs.google.com/spreadsheets/d/1Ek9SqvwVde9Il2VSK2YHGb72EUIv4Gnp3lCaSEeWftI/edit#gid=86379135"

modulos <- read_sheet(sheet_url) %>% 
  janitor::clean_names() %>%  
  rename(
    Modulo = modulo_de_atencion_medica_numero,
    Total = total
  ) %>% 
  select(Modulo,Total) %>%
  group_by(Modulo) %>% 
  summarise(Total = sum(Total, na.rm = TRUE))



library(treemapify)
library(ggplot2)

pacman::p_load(rio,here,tidyverse)

baseinicial  <- import("F1_2023.xlsx")

color_palette <- c(
  "Verde" = "#437546",
  "Naranja" = "orange",
  "Azul alta" = "#3774A7",
  "Azul baja" = "#4892D1",
  "Morada/Pulgar" = "purple",
  "Amarillo" = "#E0E155",
  "Gris" = "#878787",
  "Café" = "#825F5D"
)


ggplot(baseinicial, aes(area = Atenciones, fill = Zona, label = Carpa, subgroup=Zona)) +    
  geom_treemap(colour = "black") +  # Aquí se añade el borde negro     
  geom_treemap_subgroup_text(place = "centre", grow = TRUE, alpha = 0.25, colour = "white") +     
  geom_treemap_text(aes(label = paste(Carpa, Atenciones, sep = "\n")), colour = "black", place = "centre", size = 27) + 
  scale_fill_manual(values = color_palette) +  # Usando la paleta de colores
  theme(legend.position =  "none", plot.title=element_text(size=20, face="bold"))



```


### Atenciones por hora

```{r echo=FALSE, message=FALSE, fig.width=10}
# Cargar las bibliotecas necesarias
# Cargar las bibliotecas necesarias
library(ggplot2)
library(scales)
library(ggthemes)
library(ggpubr)
library(rio)

hr <- import("F1_2023.xlsx", sheet = "xhr")

# Convertir la columna Hora a formato datetime, estableciendo explícitamente la zona horaria como UTC
hr$Hora <- as.POSIXct(hr$Hora, format = "%H:%M", tz = "UTC")

# Crear la gráfica
ggplot(hr, aes(x = Hora, y = Atenciones)) +
  geom_point(size = 3) +
  geom_line(color = "blue") +
  geom_text(aes(label = Atenciones), vjust = 1.2, size = 5) +
  scale_x_datetime(
    labels = date_format("%H:%M", tz = "UTC"),  # Solo hora y minutos
    breaks = function(x) seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), by = "1 hours")
  ) +
  labs(title = "", x = "Hora", y = "Número de Atenciones") +
  theme_pubclean() +
  theme(
    axis.title.x = element_text(size = 14),  # Aumentar el tamaño del título del eje X
    axis.title.y = element_text(size = 14),  # Aumentar el tamaño del título del eje Y
    axis.text.x = element_text(angle = 90, hjust = 1)  # Hacer las etiquetas del eje X verticales
  )



```



Diagnosticos {data-icon="fa-solid fa-stethoscope"}
===================================== 




### Diagnosticos mas frecuentes

```{r echo=FALSE, warning=FALSE, message=FALSE}


# Cargar las bibliotecas necesarias
library(googlesheets4)
library(dplyr)
library(pacman)
library(ggplot2)
library(stringr)


pacman::p_load(
  rio,        # importación/exportación de múltiples tipos de datos
  here,       # ruta relativa de los archivos
  janitor,    # limpieza de datos y tablas
  lubridate,  # trabajar con fechas
  epikit,     # función age_categories()
  tidyverse   # gestión y visualización de datos 
)

# Importar datos desde Google Sheets
sheet_url <- "https://docs.google.com/spreadsheets/d/1Ek9SqvwVde9Il2VSK2YHGb72EUIv4Gnp3lCaSEeWftI/edit#gid=86379135"
datos <- read_sheet(sheet_url)

# Limpieza de nombres de columnas
datos_clean <- datos %>% 
  janitor::clean_names() 

# Función para sumar diagnósticos y totales por cada par de columnas
sumar_diagnosticos <- function(num) {
  col_diag <- paste0("diagnostico_", num)
  col_total <- paste0("total_de_casos_del_diagnostico_", num)
  
  df <- datos_clean %>%
    select(!!sym(col_diag), !!sym(col_total)) %>%
    rename(Diagnostico = !!sym(col_diag), Total = !!sym(col_total)) %>%
    group_by(Diagnostico) %>%
    summarise(Total = sum(Total, na.rm = TRUE)) %>%
    filter(!is.na(Diagnostico) & Diagnostico != "") # Excluir diagnósticos vacíos
  
  return(df)
}

# Aplicar la función a cada par de columnas
df_list <- lapply(1:5, sumar_diagnosticos)

# Combinar todos los data frames resultantes
df_combined <- bind_rows(df_list)

# Sumar todos los totales para cada diagnóstico
df_sum <- df_combined %>%
  group_by(Diagnostico) %>%
  summarise(Total = sum(Total, na.rm = TRUE)) %>%
  arrange(-Total) # Ordenar de mayor a menor


df_sum$Diagnostico <- str_wrap(df_sum$Diagnostico, width = 20)



top_9 <- df_sum %>% 
  top_n(9, wt = Total)


# Graficar
ggplot(top_9, aes(x = reorder(Diagnostico, Total), y = Total, fill = Total)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = Total, y = Total + 1), position = position_dodge(0.9), hjust = 0.5) +
  coord_flip() +
  scale_fill_gradient(low = "#f7e1e6", high = "#6a1b36") +
  labs(title = "", x = "Diagnóstico", y = "Número de casos") +
  theme_minimal()






```


Edad y sexo {data-icon="fa-solid fa-restroom"}
=====================================   

row
-----------------------------------------------------------------------

### Atenciones por grupo de edad  (modulos JSI)

```{r echo=FALSE, warning=FALSE,fig.width=7, fig.height= 3.5, message=FALSE}

library(googlesheets4)
library(dplyr)
library(pacman)

pacman::p_load(
  rio,        # importación/exportación de múltiples tipos de datos
  here,       # ruta relativa de los archivos
  janitor,    # limpieza de datos y tablas
  lubridate,  # trabajar con fechas
  epikit,     # función age_categories()
  tidyverse   # gestión y visualización de datos 
  

)

sheet_url <- "https://docs.google.com/spreadsheets/d/1Ek9SqvwVde9Il2VSK2YHGb72EUIv4Gnp3lCaSEeWftI/edit#gid=86379135"


datos <- read_sheet(sheet_url) %>% 
 janitor::clean_names() %>%  
           #nombre NUEVO         # nombre ANTIGUO
    rename (Modulo       = modulo_de_atencion_medica_numero,
          Fecha = fecha,
          Hora         = informe,
          "Menor 1 año" = menos_de_1_ano,
          "1 año" = x1_ano,
          "2-4 a" = x2_a_4_anos,
          "5-9 a" = x5_a_9_anos,
          "10-14 a" = x10_a_14_anos,
          "15-19 a" = x15_a_19_anos,
          "20-29 a" = x20_a_29_anos,
          "30-59 a" = x30_a_59_anos,
          "mas 60 a"= x60_anos_y_mas,
          Masculino= pacientes_masculinos,
          Femenino=pacientes_femenino,
          Cdmx= cdmx,
          "Edo de Mex" = estado_de_mexico,
          Provincia= provincia,
          Extranjero =extranjero,
          IMSS = imss,
          ISSSTE=issste,
          SEDENA=sedena,
          SSPCDMX=sspcdmx,
          Otros=otros,
          Total=total) 

library(tidyr)
library(ggplot2)


# Transformar datos de formato ancho a formato largo
datos_long <- datos %>%
  pivot_longer(
    cols = c(`Menor 1 año`, `1 año`, `2-4 a`, `5-9 a`, `10-14 a`, `15-19 a`, `20-29 a`, `30-59 a`, `mas 60 a`),
    names_to = "Edades",
    values_to = "Casos"
  ) %>%
  group_by(Edades) %>%
  summarise(Casos = sum(Casos))  # Suma los casos por cada grupo de edad

# Calcula el total de casos
total_casos <- sum(datos_long$Casos)

# Calcula los porcentajes
datos_long <- datos_long %>%
  mutate(Porcentaje = (Casos / total_casos) * 100)

ggplot(datos_long, aes(x = Edades, y = Casos)) +
  geom_bar(stat = "identity", fill = "#1B71CA") +
  geom_text(
    aes(label = paste(Casos, sprintf("(%0.2f%%)", Porcentaje), sep = "\n")),  # Muestra casos y porcentaje
    position = position_stack(vjust = 1.1),  # Ajusta la posición vertical
    size = 3,  # Ajusta el tamaño del texto
    check_overlap = TRUE  # Evita solapamientos
  ) +
  labs(title = "Distribución de Atenciones por Edad", x = "Grupo de Edad", y = "Número de Atenciones") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

```

### Atenciones por Sexo (modulos JSI)

```{r}



# Preparar los datos para la gráfica, suponiendo que 'Masculino' y 'Femenino' son los conteos de casos
datos_agregados <- datos %>% 
  summarise(Masculino = sum(Masculino, na.rm = TRUE), Femenino = sum(Femenino, na.rm = TRUE)) %>% 
  pivot_longer(cols = c(Masculino, Femenino), names_to = "Sexo", values_to = "Casos")

# Calcular los porcentajes
datos_agregados <- datos_agregados %>% 
  mutate(Porcentaje = (Casos / sum(Casos)) * 100)

# Crear la gráfica
ggplot(datos_agregados, aes(x = 2, y = Casos, fill = Sexo)) +
  geom_bar(stat = "identity", color = "white") +
  geom_text(aes(label = paste(Casos, sprintf("(%0.2f%%)", Porcentaje), sep = "\n")), position = position_stack(vjust = 0.5), color = "black", size = 4) +
  coord_polar(theta = "y") +
  scale_fill_manual(values = c(Femenino = "#FF8DE3", Masculino = "#73F3ED")) +
  theme_void() +
  labs(title = "", fill = "Sexo") +
  xlim(0.5, 2.5)

```

Procedencia {data-icon="fa-solid fa-map-location-dot"}
======================================================  

### Procedencia
```{r echo=FALSE,warning=FALSE}
library(googlesheets4)
library(dplyr)
library(ggplot2)
library(pacman)

# Carga de paquetes necesarios
pacman::p_load(
  rio,
  here,
  janitor,
  lubridate,
  epikit,
  tidyverse
)

# URL de la hoja de Google Sheets y carga de datos
sheet_url <- "https://docs.google.com/spreadsheets/d/1Ek9SqvwVde9Il2VSK2YHGb72EUIv4Gnp3lCaSEeWftI/edit#gid=86379135"
datos <- read_sheet(sheet_url) %>% 
  janitor::clean_names() %>%  
  rename(
    Cdmx = cdmx,
    `Edo de Mex` = estado_de_mexico,
    Provincia = provincia,
    Extranjero = extranjero
    # ... otros renombres ...
  )

# Preparar los datos para la gráfica
datos_agregados <- datos %>% 
  summarise(
    Cdmx = sum(Cdmx, na.rm = TRUE), 
    `Edo de Mex` = sum(`Edo de Mex`, na.rm = TRUE),
    Provincia = sum(Provincia, na.rm = TRUE), 
    Extranjero = sum(Extranjero, na.rm = TRUE)
  ) %>% 
  pivot_longer(cols = c(Cdmx, `Edo de Mex`, Provincia, Extranjero), names_to = "Procedencia", values_to = "Casos")

# Calcular los porcentajes
datos_agregados <- datos_agregados %>% 
  mutate(Porcentaje = (Casos / sum(Casos)) * 100)

# Crear la gráfica de dona
ggplot(datos_agregados, aes(x = 2, y = Casos, fill = Procedencia)) +
  geom_bar(stat = "identity", color = "white") +
  geom_text(aes(label = paste(as.character(Casos), "\n", sprintf("%.2f%%", Porcentaje))), position = position_stack(vjust = 0.5), color = "black", size = 3) +
  coord_polar(theta = "y") +
  scale_fill_manual(values = c(
    Cdmx = "#FF8DE3", 
    `Edo de Mex` = "#1B71CA", 
    Provincia = "#EA4521", 
    Extranjero = "#FFF65F"
  )) +
  theme_void() +
  labs(title = "", fill = "Procedencia") +
  xlim(0.5, 2.5)

```


### Derechohabiencia 

```{r echo=FALSE, warning=FALSE, message=FALSE}
library(googlesheets4)
library(dplyr)
library(ggplot2)
library(ggrepel)
library(pacman)

# Cargar paquetes necesarios
pacman::p_load(
  rio, janitor, lubridate, epikit, tidyverse
)

# URL de la hoja de Google Sheets y carga de datos
sheet_url <- "https://docs.google.com/spreadsheets/d/1Ek9SqvwVde9Il2VSK2YHGb72EUIv4Gnp3lCaSEeWftI/edit#gid=86379135"

datos <- read_sheet(sheet_url) %>% 
  janitor::clean_names() %>%  
  rename(
    IMSS = imss,
    ISSSTE = issste,
    SEDENA = sedena,
    SSPCDMX = sspcdmx,
    Otros = otros
    # ... otros renombres si son necesarios ...
  )

# Convertir columnas a numérico
datos$IMSS <- as.numeric(datos$IMSS)
datos$ISSSTE <- as.numeric(datos$ISSSTE)
datos$SEDENA <- as.numeric(datos$SEDENA)
datos$SSPCDMX <- as.numeric(datos$SSPCDMX)
datos$Otros <- as.numeric(datos$Otros)

# Agregamos los casos por derechohabiencia
datos_derechohabiencia <- datos %>%
  summarise(
    IMSS = sum(IMSS, na.rm = TRUE),
    ISSSTE = sum(ISSSTE, na.rm = TRUE),
    SEDENA = sum(SEDENA, na.rm = TRUE),
    SSPCDMX = sum(SSPCDMX, na.rm = TRUE),
    Otros = sum(Otros, na.rm = TRUE)
  ) %>%
  pivot_longer(cols = everything(), names_to = "Derechohabiencia", values_to = "Casos")

# Calcular los porcentajes
datos_derechohabiencia <- datos_derechohabiencia %>% 
  mutate(Porcentaje = (Casos / sum(Casos)) * 100) %>%
  arrange(desc(Derechohabiencia)) %>%
  mutate(
    csum = cumsum(Porcentaje),
    pos = csum - 0.5 * Porcentaje
  )

# Crear la gráfica de pastel
ggplot(datos_derechohabiencia, aes(x = "", y = Porcentaje, fill = Derechohabiencia)) +
  geom_bar(stat = "identity", width = 1, color = "white") +
  coord_polar(theta = "y") +
  scale_fill_manual(values = c(
    IMSS = "#035208", 
    ISSSTE = "#9F271A", 
    SEDENA = "#DBB45E", 
    SSPCDMX = "#FF8DE3", 
    Otros = "#73F3ED"
  )) +
  geom_label_repel(
    aes(y = pos, label = paste0(sprintf("%.1f", Porcentaje), "%")),
    size = 4.5, nudge_x = 1, show.legend = FALSE
  ) +
  theme_void() +
  labs(title = "")



```



Protección sanitaria {data-icon="fa-solid fa-users"}
=======================================================   




### Establecimientos


```{r echo=FALSE, warning=FALSE}

# Cargar la biblioteca flextable
library(flextable)
library(rio)

# Importar los datos desde el archivo "F1_2023.xlsx"
tablas <- import("F1_2023.xlsx", sheet = "tabla2")

# Crear una tabla flextable
ft <- flextable(tablas)

# Personalizar la tabla, si es necesario
ft <- flextable::set_table_properties(ft, layout = "autofit")

# Imprimir la tabla
ft



```




### Personal operativo

```{r  echo=FALSE, warning=FALSE}

# Cargar la biblioteca flextable
library(flextable)
library(rio)

# Importar los datos desde el archivo "F1_2023.xlsx"
tablas <- import("F1_2023.xlsx", sheet = "tabla3")

# Crear una tabla flextable
ft <- flextable(tablas)

# Personalizar la tabla, si es necesario
ft <- flextable::set_table_properties(ft, layout = "autofit")

# Imprimir la tabla
ft



```

Tendencias {data-icon="fa-solid fa-arrow-trend-up"}
=======================================================  

### Tendencia de Atenciones por Zonas

```{r echo=FALSE, warning=FALSE, message=FALSE}
library(dplyr)
library(tidyr)
library(ggplot2)
library(rio)
library(gganimate)
library(lubridate)  # Cargar lubridate
library(ggthemes)
library(ggpubr)




# Importar los datos desde el archivo "F1_2023.xlsx"
tendencia <- import("F1_2023.xlsx", sheet = "ten")



colores_zonas <- c("Verde" = "green", "Naranja" = "orange", "Azul alta" = "blue",
                   "Azul baja" = "lightblue", "Morada/Pulgar" = "purple", 
                   "Amarillo" = "yellow", "Gris" = "grey", "Café" = "brown")

library(ggplot2)
library(scales)  # para date_format

# Importar los datos desde el archivo "F1_2023.xlsx"
tendencia <- import("F1_2023.xlsx", sheet = "ten")

# Asegúrate de que la columna 'Hora' esté en formato POSIXct de fecha y hora
tendencia$Hora <- as.POSIXct(tendencia$Hora, format = "%Y-%m-%d %H:%M:%S")

# Crear una nueva columna para el día
tendencia$Dia <- as.Date(tendencia$Hora)


# Crea la gráfica con facetas por día, usando solo líneas
ggplot(tendencia, aes(x = Hora, y = Atenciones, group = Zona, color = Zona)) +
  geom_point(size = 3) +
  geom_line() +  # Agregar líneas entre puntos
  scale_color_manual(name = "Zonas", values = colores_zonas) +
  scale_x_datetime(
    labels = date_format("%H:%M"),  # Solo hora y minutos
    breaks = function(x) seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), by = "1 hours")
  ) +
  facet_wrap(~ Dia, ncol = 1, scales = "free_x") +  # Facetas por día, una columna
  xlab("Hora") +
  ylab("Número de Atenciones") +
  labs(title = "") +
  theme_pubclean() +
  theme(
    axis.line = element_line(colour = "black", size = 0.24),
    axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)
  )



```


### Tendencia de asistentes

```{r echo=FALSE, warning=FALSE, message=FALSE}
library(dplyr)
library(tidyr)
library(ggplot2)
library(scales)  # para date_format
library(rio)

# Importar los datos desde el archivo "F1_2023.xlsx"
asistentes <- import("F1_2023.xlsx", sheet = "asis")

# Convertir la columna Hora al formato adecuado
asistentes$Hora <- as.POSIXct(asistentes$Hora, format = "%d/%m/%Y %H:%M")

# Extraer la fecha de la columna Hora y guardarla en la columna Dia
asistentes$Dia <- as.Date(asistentes$Hora)

# Crear la gráfica
ggplot(asistentes, aes(x = Hora, y = Asistentes)) +
  geom_point(size = 3) +
  geom_line(color = "blue") +
  geom_text(aes(label = Asistentes), vjust = -1, size = 3.5) +  # Añadir etiquetas
  scale_x_datetime(
    labels = date_format("%H:%M"),  # Solo hora y minutos
    breaks = function(x) seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), by = "1 hours")
  ) +
  facet_wrap(~ Dia, ncol = 1, scales = "free_x") +
  xlab("Hora") +
  ylab("Número de Asistentes") +
  labs(title = "Asistencia por hora") +
  theme_minimal() +
  theme(
    axis.line = element_line(colour = "black", size = 0.24),
    axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)
  )


```










Reportes {data-icon="fa-solid fa-chart-simple"}
=======================================================  

### Día 1 27/10/2023

[Descargar](https://wmrelite.com/17_27Oct23.pdf)


### Día 2 28/10/2023

[Descargar](https://wmrelite.com/19-F1_281017.pdf)

### Día 3 29/10/2023

[Descargar](https://wmrelite.com/19_29Oct23.pdf)

[Infografía](https://wmrelite.com/InfografiaF12023_Ver1_0.pdf)