Solución Trabajo Parcial 2
Maria Camila Alvarez Barbosa
2025-10-30
Actividad 1. Contextualización inicial
Descripción de la base
Empezamos instalando las librerías necesarias.
# Cargamos las librerías
library(dplyr)
library(ggplot2)
library(readxl)
library(tidyverse)
library(TTR)Cargamos los datos de la base.
# Cargamos la información de la base
datos_covid <- read_excel("2. covid_example_data.xlsx")
datos_covidEmpezamos nuestros análisis con una descripción de la información de la tabla.
# Número de filas
nrow(datos_covid)## [1] 82101# Número de columnas
ncol(datos_covid)## [1] 31Con estás lineas de código podemos ver que tenemos una tabla con 82101 filas y 31 columnas.
# Nombres de columnas
colnames(datos_covid)## [1] "PID" "reprt_creationdt_FALSE" "case_dob_FALSE"
## [4] "case_age" "case_gender" "case_race"
## [7] "case_eth" "case_zip" "Contact_id"
## [10] "sym_startdt_FALSE" "sym_fever" "sym_subjfever"
## [13] "sym_myalgia" "sym_losstastesmell" "sym_sorethroat"
## [16] "sym_cough" "sym_headache" "sym_resolved"
## [19] "sym_resolveddt_FALSE" "contact_household" "hospitalized"
## [22] "hosp_admidt_FALSE" "hosp_dischdt_FALSE" "died"
## [25] "died_covid" "died_dt_FALSE" "confirmed_case"
## [28] "covid_dx" "pos_sampledt_FALSE" "latitude_JITT"
## [31] "longitude_JITT"El conjunto de datos de la tabla tiene una serie de columnas con el sufijo sym_, siendo estas variables el reporte del tipo de sintoma encontrado en el paciente.
#posibles faltantes
datos_covid %>%
summarise_all(funs(sum(is.na(.)))) %>%
t()## [,1]
## PID 0
## reprt_creationdt_FALSE 0
## case_dob_FALSE 48
## case_age 48
## case_gender 63
## case_race 2630
## case_eth 2574
## case_zip 13
## Contact_id 32205
## sym_startdt_FALSE 37480
## sym_fever 31577
## sym_subjfever 37908
## sym_myalgia 32137
## sym_losstastesmell 50724
## sym_sorethroat 32241
## sym_cough 31630
## sym_headache 32018
## sym_resolved 42294
## sym_resolveddt_FALSE 65799
## contact_household 36737
## hospitalized 32482
## hosp_admidt_FALSE 77115
## hosp_dischdt_FALSE 78600
## died 36832
## died_covid 42302
## died_dt_FALSE 80394
## confirmed_case 9
## covid_dx 0
## pos_sampledt_FALSE 122
## latitude_JITT 94
## longitude_JITT 200Evidenciamos los datos faltantes por columnas, siendo las columnas de died_dt_FALSE, hosp_admidt_FALSE y hosp_dischdt_FALSE las que más valores faltantes tienen.
Tipo de Información de la base
Hacemos un analisis descriptivo de las variables de la tabla.
summary(datos_covid)## PID reprt_creationdt_FALSE case_dob_FALSE
## Length:82101 Min. :2019-12-27 00:00:00 Min. :1914-12-28 00:00:00
## Class :character 1st Qu.:2020-08-05 00:00:00 1st Qu.:1968-05-21 00:00:00
## Mode :character Median :2020-12-04 00:00:00 Median :1984-05-13 00:00:00
## Mean :2020-11-08 10:56:26 Mean :1981-05-16 14:49:00
## 3rd Qu.:2021-01-22 00:00:00 3rd Qu.:1995-07-25 00:00:00
## Max. :2021-07-27 00:00:00 Max. :2042-06-07 00:00:00
## NA's :48
## case_age case_gender case_race case_eth
## Min. :-20.00 Length:82101 Length:82101 Length:82101
## 1st Qu.: 25.00 Class :character Class :character Class :character
## Median : 37.00 Mode :character Mode :character Mode :character
## Mean : 39.69
## 3rd Qu.: 53.00
## Max. :106.00
## NA's :48
## case_zip Contact_id sym_startdt_FALSE
## Min. :30000 Length:82101 Min. :1941-03-08 00:00:00
## 1st Qu.:30213 Class :character 1st Qu.:2020-07-25 00:00:00
## Median :30312 Mode :character Median :2020-11-22 00:00:00
## Mean :30250 Mean :2020-10-23 00:14:19
## 3rd Qu.:30331 3rd Qu.:2021-01-14 00:00:00
## Max. :31707 Max. :2030-12-03 00:00:00
## NA's :13 NA's :37480
## sym_fever sym_subjfever sym_myalgia sym_losstastesmell
## Length:82101 Length:82101 Length:82101 Length:82101
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## sym_sorethroat sym_cough sym_headache sym_resolved
## Length:82101 Length:82101 Length:82101 Length:82101
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## sym_resolveddt_FALSE contact_household hospitalized
## Min. :2001-11-08 00:00:00 Length:82101 Length:82101
## 1st Qu.:2020-07-29 00:00:00 Class :character Class :character
## Median :2020-11-27 00:00:00 Mode :character Mode :character
## Mean :2020-11-03 16:14:50
## 3rd Qu.:2021-01-20 00:00:00
## Max. :2102-02-03 00:00:00
## NA's :65799
## hosp_admidt_FALSE hosp_dischdt_FALSE died
## Min. :2019-12-26 00:00:00 Min. :2019-12-04 00:00:00 Length:82101
## 1st Qu.:2020-06-30 00:00:00 1st Qu.:2020-07-06 00:00:00 Class :character
## Median :2020-10-14 00:00:00 Median :2020-10-24 00:00:00 Mode :character
## Mean :2020-10-06 21:48:35 Mean :2020-10-14 14:17:35
## 3rd Qu.:2021-01-12 18:00:00 3rd Qu.:2021-01-22 00:00:00
## Max. :2032-05-22 00:00:00 Max. :2029-12-29 00:00:00
## NA's :77115 NA's :78600
## died_covid died_dt_FALSE confirmed_case
## Length:82101 Min. :2020-02-21 00:00:00 Length:82101
## Class :character 1st Qu.:2020-07-23 00:00:00 Class :character
## Mode :character Median :2020-12-11 00:00:00 Mode :character
## Mean :2020-11-03 05:00:18
## 3rd Qu.:2021-02-06 00:00:00
## Max. :2021-07-01 00:00:00
## NA's :80394
## covid_dx pos_sampledt_FALSE latitude_JITT
## Length:82101 Min. :2020-02-01 00:00:00 Min. :-0.003998
## Class :character 1st Qu.:2020-08-03 00:00:00 1st Qu.:33.690308
## Mode :character Median :2020-12-03 00:00:00 Median :33.783085
## Mean :2020-11-05 18:46:09 Mean :32.578711
## 3rd Qu.:2021-01-17 00:00:00 3rd Qu.:33.977716
## Max. :2021-07-23 00:00:00 Max. :34.188697
## NA's :122 NA's :94
## longitude_JITT
## Min. :-84.800289
## 1st Qu.:-84.460319
## Median :-84.384400
## Mean :-81.394127
## 3rd Qu.:-84.347641
## Max. : 0.003999
## NA's :200Actividad 2. Tablas descriptivas.
Perfil demográfico
Distribución por Genero
#Distribución por case_gender (n)
ggplot(datos_covid, aes(x = case_gender)) +
geom_bar(fill = "steelblue") +
geom_text(
stat = "count",
aes(label = after_stat(count)),
vjust = -0.5
) +
labs(
title = "Distribución por Generos (n)",
x = "Genero",
y = "Frecuencia"
) +
theme_minimal()
Analizando el gráfico podemos observar que hay dos grupos predominante de la categoría genero, estos se corresponden con los de hombre y mujer. También se puede evidenciar que hay más registros de mujeres que de hombres.
#Distribución por case_gender (%)
datos_covid %>%
count(case_gender) %>%
mutate(pct = n / sum(n) * 100) %>%
ggplot(aes(x = case_gender, y = pct)) +
geom_col(fill = "seagreen") +
geom_text(aes(label = sprintf("%.1f%%", pct)), vjust = -0.5) +
labs(
title = "Distribución porcentual por Generos (%)",
x = "Genero",
y = "Porcentaje (%)"
) +
theme_minimal()
Analizando el gráfico por sexo, pero como distribución porcentual vemos que la diferencia del más representado (mujer) sobre el segundo (hombre) es de aproximadamente el 7 %. También evidenciamos que fuera de las dos categorias predominantes la suma de los demas generos no llega ni al 1%.
Distribución por Raza
#Distribución por case_race (n)
ggplot(datos_covid, aes(x = case_race)) +
geom_bar(fill = "steelblue") +
geom_text(
stat = "count",
aes(label = after_stat(count)),
vjust = -0.5
) +
labs(
title = "Distribución por Raza (n)",
x = "Raza",
y = "Frecuencia"
) +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 0.5))
De forma similar a como sucede con el caso del genero, para la raza se evidencian dos categorias predominates, estás son las razas de negros y blancosm siendo mayor para la raza negra.
#Distribución por case_race (%)
datos_covid %>%
count(case_race) %>%
mutate(pct = n / sum(n) * 100) %>%
ggplot(aes(x = case_race, y = pct)) +
geom_col(fill = "seagreen") +
geom_text(aes(label = sprintf("%.1f%%", pct)), vjust = -0.5) +
labs(
title = "Distribución Porcentual por Raza (%)",
x = "Raza",
y = "Porcentaje (%)"
) +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 0.5))
Analizando el gráfico por raza, pero como distribución porcentual vemos que la diferencia del más representado (raza negra) con el segundo más representado (raza blanca) es del 4%. Adicionalmente se observa que las razas fueras de las dominantes suman aproximadamente un 20%, siendo este número no despreciable.
Distribución por Etnia
#Distribución por case_eth (n)
ggplot(datos_covid, aes(x = case_eth)) +
geom_bar(fill = "steelblue") +
geom_text(
stat = "count",
aes(label = after_stat(count)),
vjust = -0.5
) +
labs(
title = "Distribución por Etnia (n)",
x = "ETH",
y = "Frecuencia"
) +
theme_minimal()
Analizando el gráfico podemos observar que hay una categoría predominante (etnia no hispana/latina), siendo este valor al menos 7 veces más grande que las siguientes categorias.
#Distribución por case_eth (%)
datos_covid %>%
count(case_eth) %>%
mutate(pct = n / sum(n) * 100) %>%
ggplot(aes(x = case_eth, y = pct)) +
geom_col(fill = "seagreen") +
geom_text(aes(label = sprintf("%.1f%%", pct)), vjust = -0.5) +
labs(
title = "Distribución Porcentual por Etnia (%)",
x = "Etnia",
y = "Porcentaje (%)"
) +
theme_minimal()
Analizando el gráfico por etnia, pero como distribución porcentual vemos que la diferencia del más representado (etnia no hispana/latina) con el segundo más representado (hispano/latino) es de aproximadamente el 65%.
Procesamiento
# Creamos la columna age_group
datos_covid <- datos_covid %>%
mutate(
age_group = case_when(
case_age >= 0 & case_age <= 17 ~ "0-17",
case_age >= 18 & case_age <= 29 ~ "18-29",
case_age >= 30 & case_age <= 44 ~ "30-44",
case_age >= 45 & case_age <= 64 ~ "45-64",
case_age >= 65 ~ "65+",
TRUE ~ "Desconocido/Inválido"
)
)
datos_covid# Tabla cruzada de Grupo Etario por Edad
tabla_cruzada <- table(
datos_covid$age_group,
datos_covid$case_gender
)
tabla_cruzada##
## Female Male Unknown
## 0-17 4014 3948 38
## 18-29 11227 9333 84
## 30-44 11935 10639 96
## 45-64 10969 10432 79
## 65+ 5132 4026 38
## Desconocido/Inválido 22 15 11Al realizar el análisis de la tabla cruzada podemos observar que los valores más altos por genero es para las mujeres en todos los grupos etarios.
Síntomas
# Porcentaje de personas que presentaron fiebre
datos_covid %>%
filter(!is.na(sym_fever)) %>%
summarise(
porcentaje_fiebre = mean(sym_fever == "Yes") * 100
)# Porcentaje de personas que presentaron fiebre subjetiva
datos_covid %>%
filter(!is.na(sym_subjfever)) %>%
summarise(
porcentaje_fiebre_subjetiva = mean(sym_subjfever == "Yes") * 100
)# Porcentaje de personas que presentaron dolor muscular
datos_covid %>%
filter(!is.na(sym_myalgia)) %>%
summarise(
porcentaje_dolor_muscular = mean(sym_myalgia == "Yes") * 100
)# Porcentaje de personas que presentaron perdida del gusto y olfato
datos_covid %>%
filter(!is.na(sym_losstastesmell)) %>%
summarise(
porcentaje_perdida_gus_olf = mean(sym_losstastesmell == "Yes") * 100
)# Porcentaje de personas que presentaron dolor de garganta
datos_covid %>%
filter(!is.na(sym_sorethroat)) %>%
summarise(
porcentaje_dolor_garganta = mean(sym_sorethroat == "Yes") * 100
)# Porcentaje de personas que presentaron tos
datos_covid %>%
filter(!is.na(sym_cough)) %>%
summarise(
porcentaje_tos = mean(sym_cough == "Yes") * 100
)# Porcentaje de personas que presentaron dolor de cabeza
datos_covid %>%
filter(!is.na(sym_headache)) %>%
summarise(
porcentaje_dolor_cabeza = mean(sym_headache == "Yes") * 100
)De los sintomas encontrados en los pacientes, en orden de los más comunes a los menos comunes tenemos: tos, dolor de cabeza, perdida del gusto/olfato, dolor muscular, fiebre, fiebre subjetiva y dolor de garganta.
Resultados clínicos
Tabla de Porcentaje de Hospitalizacion por Grupo Etario
# Tabla de Hospitalización
tabla_hospitalizacion <- datos_covid %>%
filter(!is.na(hospitalized)) %>%
group_by(age_group) %>%
summarise(total_si = sum(hospitalized == "Yes"), .groups = "drop") %>%
mutate(tasa_hospitalizacion = 100 * total_si / sum(total_si))
tabla_hospitalizacion <- tabla_hospitalizacion %>% select(age_group, tasa_hospitalizacion)
tabla_hospitalizacionPara la tasa de hospitalización se observa que el grupo de 65+ es el más afectado con un 41,42 % seguido con grupo etario de 45-64 con un 33,40%. Así podemos evidenciar que en estos grupos etarios el valor es de 74,81 %.
Tabla de Porcentaje de Letalidad por Grupo Etario
# Tabla de Letalidad
vals_muerto_validos <- c("Yes", "No")
denominador_global <- datos_covid %>%
filter(confirmed_case == "Yes", died %in% vals_muerto_validos) %>%
nrow()
tabla_letalidad <- datos_covid %>%
filter(confirmed_case == "Yes", died %in% vals_muerto_validos) %>%
group_by(age_group) %>%
summarise(
total_muerto_si = sum(died == "Yes"),
total_en_grupo_con_dato = n(),
.groups = "drop"
) %>%
mutate(
denominador_global = denominador_global,
porcentaje_letalidad = ifelse(denominador_global > 0,
100 * total_muerto_si / denominador_global,
NA_real_)
)
tabla_letalidad <- tabla_letalidad %>% select(age_group, porcentaje_letalidad)
tabla_letalidadAnalizando la tasa de letalidad por grupo etario podemos evidenciar que el valor más alto es para el grupo etario de 65+ y el ese valor es casi 5 veces más grande que el valor del segundo grupo etario más afectado (45-64) y nuevamente es casi 6 veces mayor al observado con el siguiente grupo etario (30-44).
Actividad 3. Análisis gráfico
Casos diarios y tendencia
df_diario <- datos_covid %>%
group_by(reprt_creationdt_FALSE) %>%
summarise(conteo = n()) %>%
arrange(reprt_creationdt_FALSE)
df_diario <- df_diario %>%
mutate(media_movil_7d = zoo::rollmean(conteo, k = 7, fill = NA, align = "right"))
ggplot(df_diario, aes(x = reprt_creationdt_FALSE)) +
geom_col(aes(y = conteo), fill = "steelblue", alpha = 0.7) +
geom_line(aes(y = media_movil_7d), color = "red", size = 0.9) +
scale_x_date(
date_breaks = "1 month",
date_labels = "%b %d",
expand = c(0, 0)
) +
labs(
title = "Evolución de registros diarios con media móvil de 7 días",
x = "Fecha del reporte",
y = "Número de casos"
) +
theme_minimal(base_size = 14) +
theme(
plot.title = element_text(face = "bold", hjust = 0.5),
axis.text.x = element_text(angle = 45, hjust = 1)
)
En el analisis del gráfico podemos ver que la media movil se comporta de una forma muy particular en donde tiende a subestimar cuando empiezan a crecer los casos, así como también tiende a sobreestimar cuando decrecen los casos. Este fenomeno se encuentra en las dos picos de brote.
Distribución demográfica
grafico_apilado_conteo <- ggplot(datos_covid, aes(x = age_group, fill = case_gender)) +
geom_bar(color = "black") +
labs(title = "Distribución de Casos de COVID por Rango de Edad y Género",
x = "Rango de Edad",
y = "Frecuencia Absoluta (n)",
fill = "Género") +
scale_x_discrete(limits = c("0-17", "18-29", "30-44", "45-64", "65+", "Desconocido/Inválido")) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(grafico_apilado_conteo)
Podemos ver que la distribución de casos por sexo y grupo etario se comporta de forma muy similar tanto para hombres como para mujeres siendo ligeramente mayor en el caso de las mujeres, adicionalmente los valores de desconocido no apreciable en la gráfica.
Hospitalización y letalidad
agrupamiento = merge(tabla_hospitalizacion, tabla_letalidad, by = "age_group")
agrupamiento <- agrupamiento %>% rename(tasa_letalidad = porcentaje_letalidad)
df_long <- agrupamiento %>%
pivot_longer(cols = c(tasa_hospitalizacion, tasa_letalidad),
names_to = "variable",
values_to = "valor")
ggplot(df_long, aes(x = age_group, y = valor, fill = variable)) +
geom_bar(stat = "identity", position = position_dodge(width = 0.8)) +
geom_text(aes(label = sprintf("%.2f", valor)),
position = position_dodge(width = 0.8),
vjust = -0.5, size = 3) +
labs(
title = "Relación de hospitalización y letalidad por grupo etario",
x = "Grupo etario",
y = "Tasa",
fill = "Variable"
) +
theme(axis.text.x = element_text(angle = 45, vjust = 0.5, hjust = 0.5))
Podemos observar que el pico de hospitalización está en el grupo etario de 65+ en donde a medida que disminuye la edad, la tasa de hospitalización decrece, adicionalmente observamos de igual forma que la tasa de letalidad tiene su pico en el grupo de 65+ y este disminuye con la edad.
Síntomas principales
df_long <- datos_covid %>%
pivot_longer(
cols = c(sym_cough, sym_headache, sym_losstastesmell, sym_myalgia, sym_fever),
names_to = "sintoma",
values_to = "valor"
)
tabla_share <- df_long %>%
filter(!is.na(valor)) %>%
group_by(sintoma, age_group) %>%
summarise(
total_yes = sum(valor == "Yes"),
.groups = "drop_last"
) %>%
group_by(sintoma) %>%
mutate(
total_yes_sintoma = sum(total_yes),
share_pct = ifelse(total_yes_sintoma > 0,
100 * total_yes / total_yes_sintoma,
0)
) %>%
ungroup()
ggplot(tabla_share, aes(x = age_group, y = share_pct, fill = sintoma)) +
geom_col(position = position_dodge(width = 0.9), width = 0.8) +
geom_text(aes(label = sprintf("%.1f%%", share_pct)),
position = position_dodge(width = 0.9),
angle = 90,
vjust = 0.5,
hjust = 0.5,
size = 3) +
labs(
title = "Frecuencia de prevalencia de los síntomas por grupos etarios",
x = "Grupo etario",
y = "Frecuencia de prevalencia de los síntomas (%)",
fill = "Síntoma"
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", hjust = 0.5),
axis.text.x = element_text(angle = 45, hjust = 1)
)
Para el grupo etario de 0-17 años la fiebre es el síntoma más común, para los grupos etarios de 18-29 y 30-44 la perdida del olfato y gusto es el síntoma más común, para el grupo etario de 45-64 el dolor muscular es el síntoma más común y para el grupo etario 65+ la tos es el síntoma más común.