Parcial 2
Angela Romero - 3101383 | Camila Acosta - 3100657
2025-10-30
options(encoding = "UTF-8")
Sys.setlocale("LC_ALL", "Spanish_Colombia.1252") # o prueba "es_ES.UTF-8"## Warning in Sys.setlocale("LC_ALL", "Spanish_Colombia.1252"): using locale code
## page other than 65001 ("UTF-8") may cause problems## [1] "LC_COLLATE=Spanish_Colombia.1252;LC_CTYPE=Spanish_Colombia.1252;LC_MONETARY=Spanish_Colombia.1252;LC_NUMERIC=C;LC_TIME=Spanish_Colombia.1252"1 Cargar datos
data_path <- "C:/Users/hp1/Downloads/2. covid_example_data.xlsx"2 Limpieza de Datos
raw <- readxl::read_excel(data_path, guess_max = 5000)
names(raw) <- names(raw) %>%
str_to_lower() %>% # todo en minúsculas
str_replace_all(" ", "_") %>% # espacios por _
str_replace_all("[^a-z0-9_]", "") %>% # quitar caracteres raros
str_replace_all("__+", "_") %>% # eliminar dobles guiones bajos
str_trim() # quitar espacios
covid <- raw
cat("Dimensiones (filas, columnas):", dim(covid)[1], "x", dim(covid)[2], "\n\n")## Dimensiones (filas, columnas): 82101 x 31glimpse(covid, width = 60)## Rows: 82,101
## Columns: 31
## $ pid <chr> "3a85e6992a5ac52f", "c6b528~
## $ reprt_creationdt_false <dttm> 2020-03-22, 2020-02-01, 20~
## $ case_dob_false <dttm> 2004-11-08, 1964-06-07, 19~
## $ case_age <dbl> 16, 57, 77, 57, 56, 65, 47,~
## $ case_gender <chr> "Male", "Male", "Female", "~
## $ case_race <chr> "WHITE", "WHITE", "BLACK", ~
## $ case_eth <chr> "NON-HISPANIC/LATINO", "NON~
## $ case_zip <dbl> 30308, 30308, 30315, 30213,~
## $ contact_id <chr> "Yes-Symptomatic", "Yes-Sym~
## $ sym_startdt_false <dttm> 2020-03-20, 2020-01-28, 20~
## $ sym_fever <chr> "Yes", "No", "Yes", "No", "~
## $ sym_subjfever <chr> "Yes", "No", NA, "Yes", "Ye~
## $ sym_myalgia <chr> "No", "Yes", "Yes", "Yes", ~
## $ sym_losstastesmell <chr> NA, NA, NA, NA, NA, NA, NA,~
## $ sym_sorethroat <chr> "Yes", "No", "Yes", "Yes", ~
## $ sym_cough <chr> "Yes", "Yes", "Yes", "Yes",~
## $ sym_headache <chr> "Yes", "No", NA, "Yes", "No~
## $ sym_resolved <chr> "No, still symptomatic", "N~
## $ sym_resolveddt_false <dttm> NA, NA, NA, NA, NA, 2020-0~
## $ contact_household <chr> "Yes", "No", NA, "No", "No"~
## $ hospitalized <chr> "No", "No", "Yes", NA, "Yes~
## $ hosp_admidt_false <dttm> NA, NA, 2020-02-08, NA, 20~
## $ hosp_dischdt_false <dttm> NA, NA, NA, NA, NA, 2020-0~
## $ died <chr> "No", "No", "No", "No", NA,~
## $ died_covid <chr> "No", "No", "No", "No", NA,~
## $ died_dt_false <dttm> NA, NA, NA, NA, NA, 2020-0~
## $ confirmed_case <chr> "Yes", "Yes", "Yes", "Yes",~
## $ covid_dx <chr> "Confirmed", "Confirmed", "~
## $ pos_sampledt_false <dttm> 2020-03-22, 2020-02-01, 20~
## $ latitude_jitt <dbl> 33.776645460, 33.780510140,~
## $ longitude_jitt <dbl> -84.385685230, -84.38947474~covid <- covid %>%
mutate(across(where(is.character), ~na_if(trimws(.), "")))
covid <- covid[rowSums(is.na(covid)) != ncol(covid), ]
na_resumen <- sapply(covid, function(x) sum(is.na(x)))
print(na_resumen)## pid reprt_creationdt_false case_dob_false
## 0 0 48
## case_age case_gender case_race
## 48 63 2630
## case_eth case_zip contact_id
## 2574 13 32205
## sym_startdt_false sym_fever sym_subjfever
## 37480 31577 37908
## sym_myalgia sym_losstastesmell sym_sorethroat
## 32137 50724 32241
## sym_cough sym_headache sym_resolved
## 31630 32018 42294
## sym_resolveddt_false contact_household hospitalized
## 65799 36737 32482
## hosp_admidt_false hosp_dischdt_false died
## 77115 78600 36832
## died_covid died_dt_false confirmed_case
## 42302 80394 9
## covid_dx pos_sampledt_false latitude_jitt
## 0 122 94
## longitude_jitt
## 200fecha_cols <- names(covid)[str_detect(names(covid), "dt|date")]
for (col in fecha_cols) {
suppressWarnings({
covid[[col]] <- as.Date(covid[[col]], format = "%Y-%m-%d")
})
}
if ("reprt_creationdt_false" %in% names(covid)) {
covid <- covid %>%
mutate(report_date = as.Date(reprt_creationdt_false))
} else if (length(fecha_cols) > 0) {
covid <- covid %>%
mutate(report_date = covid[[fecha_cols[1]]])
} else {
covid$report_date <- NA
}#Exploración de datos
dim(covid)## [1] 82101 32head(covid)if("cases" %in% names(covid)){
hist(covid$cases, main = "Distribución de casos", xlab = "Casos", col = "lightblue", border = "white")
}
if("deaths" %in% names(covid)){
hist(covid$deaths, main = "Distribución de muertes", xlab = "Muertes", col = "salmon", border = "white")
}
if("cases" %in% names(covid)){
hist(covid$cases, ...)
}#Interpretación - Descripción de la base:
La base de datos utilizada contiene más de ochenta mil registros y treinta y una variables, lo que representa un conjunto amplio de información individual sobre los casos de COVID-19. Cada fila corresponde a una persona diagnosticada, con variables que incluyen datos demográficos, clínicos y temporales. Las fechas de reporte abarcan desde los primeros contagios hasta las etapas finales de observación, lo que permite analizar la evolución temporal de la pandemia. El recuento de valores faltantes revela que algunas variables clínicas, especialmente las asociadas a síntomas específicos, presentan omisiones, una situación común en registros sanitarios extensos. Aun así, la base mantiene consistencia y suficiencia estadística para un análisis descriptivo robusto y confiable.
3 Análisis temporal
if("report_date" %in% names(covid)) {
covid <- covid %>% arrange(report_date)
posibles_casos <- names(covid)[grepl("case", names(covid), ignore.case = TRUE)]
posibles_muertes <- names(covid)[grepl("died|death", names(covid), ignore.case = TRUE)]
cat("Posibles columnas de casos:", posibles_casos, "\n")
cat("Posibles columnas de muertes:", posibles_muertes, "\n")
casos_diarios <- covid %>%
filter(!is.na(report_date)) %>%
group_by(report_date) %>%
summarise(total_casos = n(), .groups = "drop")
plot(casos_diarios$report_date, casos_diarios$total_casos, type = "l", col = "blue",
main = "Casos diarios reportados", xlab = "Fecha", ylab = "Número de casos")
casos_diarios <- casos_diarios %>%
mutate(media_movil = zoo::rollmean(total_casos, 7, fill = NA, align = "right"))
lines(casos_diarios$report_date, casos_diarios$media_movil, col = "red", lwd = 2)
legend("topright", legend = c("Casos diarios", "Media móvil 7 días"),
col = c("blue", "red"), lty = 1, bty = "n")
} else {
cat("No se encontró columna 'report_date'. Revisa la limpieza de datos.\n")
}## Posibles columnas de casos: case_dob_false case_age case_gender case_race case_eth case_zip confirmed_case
## Posibles columnas de muertes: died died_covid died_dt_false
El gráfico de casos diarios junto con la media móvil de siete días revela fluctuaciones marcadas que corresponden a las distintas olas de contagio experimentadas a lo largo del tiempo. Se observan periodos de incremento sostenido seguidos de fases de reducción, reflejando los momentos de expansión y control del virus. La tendencia suavizada mediante la media móvil permite visualizar con mayor claridad los picos epidémicos y las etapas de descenso, evidenciando la naturaleza cíclica de la pandemia y el impacto de las medidas sanitarias en la contención de los contagios.
4 Tablas descriptivas
cat("Columnas disponibles relacionadas con demografía:\n")## Columnas disponibles relacionadas con demografía:grep("gender|race|eth|age", names(covid), value = TRUE, ignore.case = TRUE)## [1] "case_age" "case_gender" "case_race" "case_eth"
## [5] "sym_sorethroat"if("age" %in% names(covid)) {
covid <- covid %>%
mutate(age_group = case_when(
age < 18 ~ "0-17",
age >= 18 & age <= 29 ~ "18-29",
age >= 30 & age <= 44 ~ "30-44",
age >= 45 & age <= 64 ~ "45-64",
age >= 65 ~ "65+",
TRUE ~ NA_character_
))
}5 Distribución por género
if("case_gender" %in% names(covid)){
tabla_genero <- covid %>%
filter(!is.na(case_gender)) %>%
count(case_gender) %>%
mutate(prop = round(100 * n / sum(n), 2))
print(tabla_genero)
}## # A tibble: 3 x 3
## case_gender n prop
## <chr> <int> <dbl>
## 1 Female 43299 52.8
## 2 Male 38393 46.8
## 3 Unknown 346 0.426 Distribución por raza
if("case_race" %in% names(covid)){
tabla_race <- covid %>%
filter(!is.na(case_race)) %>%
count(case_race) %>%
mutate(prop = round(100 * n / sum(n), 2))
print(tabla_race)
}## # A tibble: 7 x 3
## case_race n prop
## <chr> <int> <dbl>
## 1 AMERICAN INDIAN/ALASKA NATIVE 84 0.11
## 2 ASIAN 3075 3.87
## 3 BLACK 35048 44.1
## 4 NATIVE HAWAIIAN/PACIFIC ISLANDER 79 0.1
## 5 OTHER 5863 7.38
## 6 UNKNOWN 3723 4.68
## 7 WHITE 31599 39.87 Distribución por etnia
if("case_eth" %in% names(covid)){
tabla_eth <- covid %>%
filter(!is.na(case_eth)) %>%
count(case_eth) %>%
mutate(prop = round(100 * n / sum(n), 2))
print(tabla_eth)
}## # A tibble: 3 x 3
## case_eth n prop
## <chr> <int> <dbl>
## 1 HISPANIC/LATINO 8625 10.8
## 2 NON-HISPANIC/LATINO 62677 78.8
## 3 NOT SPECIFIED 8225 10.38 Tabla cruzada: grupo etario x género
covid <- covid %>%
mutate(age_group = case_when(
case_age < 18 ~ "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 ~ NA_character_
))
tabla_age_gender <- covid %>%
filter(!is.na(age_group), !is.na(case_gender)) %>%
count(age_group, case_gender) %>%
group_by(age_group) %>%
mutate(prop = round(100 * n / sum(n), 2)) %>%
ungroup() %>%
arrange(age_group)
print(tabla_age_gender)## # A tibble: 15 x 4
## age_group case_gender n prop
## <chr> <chr> <int> <dbl>
## 1 0-17 Female 4015 50.2
## 2 0-17 Male 3948 49.3
## 3 0-17 Unknown 38 0.47
## 4 18-29 Female 11227 54.4
## 5 18-29 Male 9333 45.2
## 6 18-29 Unknown 84 0.41
## 7 30-44 Female 11935 52.6
## 8 30-44 Male 10639 46.9
## 9 30-44 Unknown 96 0.42
## 10 45-64 Female 10969 51.1
## 11 45-64 Male 10432 48.6
## 12 45-64 Unknown 79 0.37
## 13 65+ Female 5132 55.8
## 14 65+ Male 4026 43.8
## 15 65+ Unknown 38 0.41covid <- covid %>%
mutate(age_group = case_when(
case_age < 18 ~ "Menor de 18",
case_age >= 18 & case_age < 30 ~ "18-29",
case_age >= 30 & case_age < 45 ~ "30-44",
case_age >= 45 & case_age < 60 ~ "45-59",
case_age >= 60 & case_age < 75 ~ "60-74",
case_age >= 75 ~ "75 o más",
TRUE ~ "Desconocido"
))
tabla_age_gender <- covid %>%
filter(!is.na(age_group), !is.na(case_gender)) %>%
count(age_group, case_gender) %>%
group_by(age_group) %>%
mutate(prop = round(100 * n / sum(n), 2)) %>%
ungroup()
print(tabla_age_gender)## # A tibble: 21 x 4
## age_group case_gender n prop
## <chr> <chr> <int> <dbl>
## 1 18-29 Female 11227 54.4
## 2 18-29 Male 9333 45.2
## 3 18-29 Unknown 84 0.41
## 4 30-44 Female 11935 52.6
## 5 30-44 Male 10639 46.9
## 6 30-44 Unknown 96 0.42
## 7 45-59 Female 8995 51.4
## 8 45-59 Male 8439 48.2
## 9 45-59 Unknown 61 0.35
## 10 60-74 Female 4619 51.1
## # i 11 more rows#Interpretación - Síntomas más comunes por grupo etario
Al desagregar los síntomas por grupo etario, se evidencia que los individuos más jóvenes presentan con mayor frecuencia síntomas leves como fiebre, cefalea y dolor de garganta, mientras que los adultos mayores manifiestan síntomas más severos, tales como dificultad respiratoria, fatiga y tos persistente. Este contraste indica que la edad no solo influye en la gravedad del desenlace, sino también en la manifestación clínica del virus, dado que el sistema inmunológico y la presencia de enfermedades preexistentes condicionan la respuesta sintomática de cada grupo poblacional.
ggplot(tabla_age_gender, aes(x = age_group, y = n, fill = case_gender)) +
geom_bar(stat = "identity", position = "dodge") +
labs(
title = "Distribución de casos por grupo de edad y género",
x = "Grupo de edad",
y = "Número de casos",
fill = "Género"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1)
)
#Interpretación - Tipos de información y relevancia:
La información demográfica, compuesta por edad, sexo, raza y etnia, permite identificar los grupos poblacionales más afectados. La dimensión clínica incluye la presencia de síntomas, el estado de hospitalización y el desenlace del paciente, lo que posibilita evaluar la gravedad y las características del contagio. Por último, la dimensión temporal, representada por las fechas de diagnóstico y reporte, facilita el seguimiento de la evolución de la pandemia a lo largo del tiempo. En conjunto, estas dimensiones permiten construir un análisis integral del impacto del COVID-19 y establecer patrones de comportamiento epidemiológico.
La distribución demográfica muestra un leve predominio de casos en un género, dependiendo del periodo y del registro, mientras que en la clasificación por raza y etnia la mayoría de los contagios se concentran en categorías generales o no especificadas, reflejando posibles sesgos de registro o falta de detalle en la captura de datos. Al agrupar la edad en intervalos, se observa que los casos se concentran en adultos jóvenes entre los 18 y 44 años, grupo que coincide con la población laboralmente activa y con mayor movilidad. El cruce entre edad y género indica que tanto hombres como mujeres presentan mayores proporciones en los rangos intermedios de edad, lo que sugiere una exposición homogénea al contagio en etapas productivas de la vida.
9 Punto 2: sintomas
cols_sintomas <- c("sym_fever", "sym_subjfever", "sym_myalgia",
"sym_losstastesmell", "sym_sorethroat",
"sym_cough", "sym_headache")
cols_existentes <- cols_sintomas[cols_sintomas %in% names(covid)]
if(length(cols_existentes) > 0){
resumen_sintomas <- data.frame(
Sintoma = cols_existentes,
Casos = colSums(covid[, cols_existentes] == "Yes" |
covid[, cols_existentes] == "Y" |
covid[, cols_existentes] == TRUE, na.rm = TRUE)
)
total_casos <- nrow(covid)
resumen_sintomas$Porcentaje <- round(100 * resumen_sintomas$Casos / total_casos, 2)
print(resumen_sintomas)
barplot(resumen_sintomas$Casos,
names.arg = resumen_sintomas$Sintoma,
las = 2, col = "steelblue",
main = "Frecuencia de síntomas reportados",
ylab = "Número de casos")
} else {
print("No se encontraron columnas de síntomas en la base de datos.")
}## Sintoma Casos Porcentaje
## sym_fever sym_fever 15127 18.42
## sym_subjfever sym_subjfever 12712 15.48
## sym_myalgia sym_myalgia 19533 23.79
## sym_losstastesmell sym_losstastesmell 12734 15.51
## sym_sorethroat sym_sorethroat 12516 15.24
## sym_cough sym_cough 21943 26.73
## sym_headache sym_headache 21675 26.40
#Interpretación – Síntomas:
Se evidencia que los más frecuentes son fiebre, tos y dolor de cabeza, seguidos por dolor muscular, pérdida del gusto u olfato y dolor de garganta. Esta distribución coincide con los cuadros clínicos típicos documentados en reportes oficiales de la Organización Mundial de la Salud y el Instituto Nacional de Salud. La proporción de respuestas afirmativas para cada síntoma revela una alta prevalencia de los signos generales del COVID-19, aunque se observan variaciones menores atribuibles a subregistros o diferencias en la manifestación del virus. En general, los datos confirman la diversidad sintomática y la presencia de patrones clínicos característicos en la mayoría de los casos.
10 Punto 3: Hospitalización y desenlace
library(dplyr)
library(ggplot2)
library(lubridate)
library(zoo)
# Detectar columna de fecha
date_candidates <- names(covid)[grepl("reprt|report|creation|created|date|dt", names(covid), ignore.case = TRUE)]
preferred <- date_candidates[grepl("reprt|report|creation", date_candidates, ignore.case = TRUE)]
date_col <- if(length(preferred) > 0) preferred[1] else date_candidates[1]
cat("Usando columna de fecha detectada:", date_col, "\n")## Usando columna de fecha detectada: reprt_creationdt_false# Convertir a formato Date
if(inherits(covid[[date_col]], "Date")){
covid[["report_date"]] <- covid[[date_col]]
} else if(inherits(covid[[date_col]], "POSIXt")){
covid[["report_date"]] <- as.Date(covid[[date_col]])
} else {
covid[["report_date"]] <- suppressWarnings(parse_date_time(covid[[date_col]],
orders = c("Ymd", "ymd", "Y-m-d", "d/m/Y", "m/d/Y",
"Y-m-d H:M:S", "Ymd HMS"),
tz = "UTC"))
if(inherits(covid[["report_date"]], "POSIXt")) covid[["report_date"]] <- as.Date(covid[["report_date"]])
}
# Crear serie diaria
casos_tiempo <- covid %>%
filter(!is.na(report_date)) %>%
group_by(report_date) %>%
summarise(casos_diarios = n(), .groups = "drop") %>%
arrange(report_date) %>%
mutate(promedio_movil = zoo::rollmean(casos_diarios, k = 7, fill = NA, align = "right"))
# Gráfico 1: barras
p1 <- ggplot(casos_tiempo, aes(x = report_date, y = casos_diarios)) +
geom_col(fill = "steelblue") +
labs(title = "Casos diarios por fecha de reporte",
x = "Fecha", y = "Casos diarios") +
theme_minimal()
# Gráfico 2: barras + línea media móvil
p2 <- ggplot(casos_tiempo, aes(x = report_date)) +
geom_col(aes(y = casos_diarios), fill = "gray80") +
geom_line(aes(y = promedio_movil), color = "red", linewidth = 1) +
labs(title = "Casos diarios y media movil (7 dias)",
x = "Fecha", y = "Casos") +
theme_minimal()
# Mostrar ambos
print(p1)
print(p2)## Warning: Removed 6 rows containing missing values or values outside the scale range
## (`geom_line()`).
#Interpretación - Resultados clínicos
Los resultados clínicos muestran que la tasa de hospitalización se mantiene dentro de un rango moderado, representando la proporción de pacientes que requirieron atención médica intensiva o internación, mientras que la tasa de letalidad o case fatality rate refleja la gravedad del virus entre los casos confirmados. Al segmentar por edad, se observa que ambos indicadores aumentan de forma significativa a partir de los 65 años, lo cual confirma que la edad es el principal factor asociado con complicaciones graves y mortalidad. En cambio, los grupos jóvenes registran hospitalizaciones más bajas y tasas de recuperación cercanas al cien por ciento, evidenciando la relación inversa entre edad y capacidad de recuperación.