Tazas_vph
Nicolas Martínez Ramos
2026-08-10
Cargue base de datos
library(readxl)
library(dplyr)
BASE <- read_excel("BD_AUTOTOMA_art_positividad_07.26.xlsx") # 529 observaciones
#Codificando variables
BASE <- BASE %>%
mutate(educacion2 = case_when(
nivel_educativo == "Ninguno" ~ "Secundaria o menos",
nivel_educativo == "Primaria" ~ "Secundaria o menos",
nivel_educativo == "Secundaria" ~ "Secundaria o menos",
nivel_educativo == "Técnico" ~ "Más de Secundaria",
nivel_educativo == "Profesional" ~ "Más de Secundaria",
nivel_educativo == "Posgrado" ~ "Más de Secundaria",
TRUE ~ nivel_educativo # o el valor que corresponda para el resto
))
BASE$edad2 <- cut(BASE$edad,
breaks = c(-Inf, 44, Inf),
labels = c("29-44", ">=45"),
right = TRUE) #Min 29, Mean = 38.93, Max 50Tabla cruce variables sociodemográfiacs y clínicas
library(gtsummary)
library(dplyr)
variables_tabla <- c("departamento", "lugar_de_residencia", "etnia_agr",
"nivel_educativo_agr", "educacion2", "edad2", "estrategia_toma",
"ultimo_tamizaje", "ult_tamizaje_agr", "dias_procesamiento", "resultado_vph")
tabla1 <- BASE %>%
dplyr::select(metodo_toma, all_of(variables_tabla)) %>%
tbl_summary(
by = metodo_toma,
type = list(
c(ultimo_tamizaje, dias_procesamiento) ~ "continuous" #no normales
),
label = list(
departamento ~ "Departamento",
lugar_de_residencia ~ "Lugar de residencia",
etnia_agr ~ "Etnia",
nivel_educativo_agr ~ "Nivel educativo agr",
educacion2 ~ "Educación (agrupada2)",
edad2 ~ "Edad (categorizada)",
estrategia_toma ~ "Estrategia toma",
ultimo_tamizaje ~ "Último tamizaje",
ult_tamizaje_agr ~ "Ultimo tamizaje agrupado",
dias_procesamiento ~ "Días de procesamiento",
resultado_vph ~ "Resultado vph"
),
statistic = list(
all_categorical() ~ "{n} ({p}%)",
c(ultimo_tamizaje, dias_procesamiento) ~ "{mean} ({sd})"
),
digits = list(
all_categorical() ~ 1,
c(ultimo_tamizaje, dias_procesamiento) ~ 2
),
missing = "ifany",
missing_text = "Sin dato"
) %>%
add_p(
test = list(
all_categorical() ~ "chisq.test",
c(ultimo_tamizaje, dias_procesamiento) ~ "kruskal.test"
),
pvalue_fun = ~ style_pvalue(.x, digits = 3)
) %>%
add_overall() %>%
modify_header(label ~ "**Variable**") %>%
bold_labels() %>%
bold_p(t = 0.05) %>%
modify_caption("**Tabla 1. Características según método de toma**")
tabla1| Variable | Overall N = 5291 |
autotoma N = 3801 |
convencional N = 1491 |
p-value2 |
|---|---|---|---|---|
| Departamento | <0.001 | |||
| Chocó | 182.0 (34.4%) | 149.0 (39.2%) | 33.0 (22.1%) | |
| Putumayo | 347.0 (65.6%) | 231.0 (60.8%) | 116.0 (77.9%) | |
| Lugar de residencia | <0.001 | |||
| Istmina | 126.0 (23.8%) | 115.0 (30.3%) | 11.0 (7.4%) | |
| Nuquí | 56.0 (10.6%) | 34.0 (8.9%) | 22.0 (14.8%) | |
| Puerto Leguizamo | 139.0 (26.3%) | 120.0 (31.6%) | 19.0 (12.8%) | |
| Valle de Sibundoy | 208.0 (39.3%) | 111.0 (29.2%) | 97.0 (65.1%) | |
| Etnia | <0.001 | |||
| Afro-Colombiano | 183.0 (34.6%) | 149.0 (39.2%) | 34.0 (22.8%) | |
| Indigena | 117.0 (22.1%) | 86.0 (22.6%) | 31.0 (20.8%) | |
| Otro/ninguno/NA | 229.0 (43.3%) | 145.0 (38.2%) | 84.0 (56.4%) | |
| Nivel educativo agr | 0.010 | |||
| primaria o menos | 100.0 (19.2%) | 60.0 (16.0%) | 40.0 (27.2%) | |
| profesional o mayor | 112.0 (21.5%) | 87.0 (23.2%) | 25.0 (17.0%) | |
| secundaria-tecnico | 310.0 (59.4%) | 228.0 (60.8%) | 82.0 (55.8%) | |
| Sin dato | 7 | 5 | 2 | |
| Educación (agrupada2) | 0.174 | |||
| Más de Secundaria | 236.0 (45.2%) | 177.0 (47.2%) | 59.0 (40.1%) | |
| Secundaria o menos | 286.0 (54.8%) | 198.0 (52.8%) | 88.0 (59.9%) | |
| Sin dato | 7 | 5 | 2 | |
| Edad (categorizada) | 0.744 | |||
| 29-44 | 415.0 (78.4%) | 300.0 (78.9%) | 115.0 (77.2%) | |
| >=45 | 114.0 (21.6%) | 80.0 (21.1%) | 34.0 (22.8%) | |
| Estrategia toma | 0.002 | |||
| Campaña | 385.0 (72.8%) | 262.0 (68.9%) | 123.0 (82.6%) | |
| Tamizaje rutinario | 144.0 (27.2%) | 118.0 (31.1%) | 26.0 (17.4%) | |
| Último tamizaje | 29.96 (160.56) | 32.48 (167.79) | 23.54 (140.79) | 0.848 |
| Sin dato | 4 | 3 | 1 | |
| Ultimo tamizaje agrupado | 0.952 | |||
| <= 24 meses | 35.0 (6.6%) | 24.0 (6.3%) | 11.0 (7.4%) | |
| >36 meses | 138.0 (26.1%) | 101.0 (26.6%) | 37.0 (24.8%) | |
| 25-36 meses | 352.0 (66.5%) | 252.0 (66.3%) | 100.0 (67.1%) | |
| NA | 4.0 (0.8%) | 3.0 (0.8%) | 1.0 (0.7%) | |
| Días de procesamiento | 7.19 (4.60) | 5.39 (2.00) | 11.77 (5.98) | <0.001 |
| Resultado vph | 0.012 | |||
| negativo | 394.0 (74.6%) | 271.0 (71.5%) | 123.0 (82.6%) | |
| positivo | 134.0 (25.4%) | 108.0 (28.5%) | 26.0 (17.4%) | |
| Sin dato | 1 | 1 | 0 | |
| 1 n (%); Mean (SD) | ||||
| 2 Pearson’s Chi-squared test; Kruskal-Wallis rank sum test | ||||
Gráficos de tendencia - positividad
library(dplyr)
library(lubridate)
library(ggplot2)
# Agregar por mes
tendencia <- BASE %>%
mutate(mes = floor_date(fecha_tamizaje, "month")) %>%
group_by(mes) %>%
summarise(
n_total = n(),
n_positivos = sum(resultado_vph == "positivo", na.rm = TRUE), # ajusta el valor exacto
prop_positivos = n_positivos / n_total * 100
)
ggplot(tendencia, aes(x = mes, y = prop_positivos)) +
geom_line(color = "#2C3E50", linewidth = 1) +
geom_point(color = "#2C3E50", size = 2) +
scale_x_date(date_labels = "%b %Y", date_breaks = "1 month") +
labs(
title = "Tendencia de positividad VPH en el tiempo",
x = "Mes de tamizaje",
y = "% positivos"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 270, hjust = 1))
Segregado por método de toma
tendencia_metodo <- BASE %>%
mutate(mes = floor_date(fecha_tamizaje, "month")) %>%
group_by(mes, metodo_toma) %>%
summarise(
n_total = n(),
n_positivos = sum(resultado_vph == "positivo", na.rm = TRUE),
prop_positivos = n_positivos / n_total * 100,
.groups = "drop"
)
ggplot(tendencia_metodo, aes(x = mes, y = prop_positivos, color = metodo_toma)) +
geom_line(linewidth = 1) +
geom_point(size = 2) +
scale_x_date(date_labels = "%b %Y", date_breaks = "1 month") +
labs(title = "Tendencia de positividad VPH por método de toma",
x = "Mes de tamizaje", y = "% positivos", color = "Método") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 270, hjust = 1))
Modelo multivariado
library(sandwich)
library(lmtest)
BASE_modelo <- BASE %>%
filter(!is.na(resultado_vph)) %>%
mutate(
positividad = case_when(
resultado_vph == "positivo" ~ 1,
resultado_vph == "negativo" ~ 0
)
)
# Modelo de Poisson
modelo_poisson <- glm(
positividad ~ metodo_toma +
departamento +
etnia +
nivel_educativo_agr +
educacion2+
edad2+
ult_tamizaje_agr +
lugar_de_residencia +
estrategia_toma+
dias_procesamiento,
data = BASE_modelo,
family = poisson(link = "log")
)
modelo_poisson2 <- glm(
positividad ~ metodo_toma +
dias_procesamiento,
data = BASE_modelo,
family = poisson(link = "log")
)
coeftest(modelo_poisson2, vcov = sandwich)##
## z test of coefficients:
##
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.2692620 0.1568424 -8.0926 5.841e-16 ***
## metodo_tomaconvencional -0.5070269 0.2594057 -1.9546 0.05063 .
## dias_procesamiento 0.0025758 0.0250727 0.1027 0.91818
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1tabla_modelo <- tbl_regression(
modelo_poisson2,
exponentiate = TRUE,
add_estimate_to_reference_rows = TRUE,
tidy_fun = function(x, ...) {
coeftest(x, vcov = sandwich(x)) %>%
broom::tidy(conf.int = TRUE) %>%
mutate(
conf.low = exp(estimate - 1.96 * std.error),
conf.high = exp(estimate + 1.96 * std.error),
estimate = exp(estimate)
)
}
) %>%
add_global_p() %>%
bold_p(t = 0.05) %>%
bold_labels() %>%
modify_caption("**Modelo de Poisson robusto - Razones de Prevalencia**")
tabla_modelo| Characteristic | IRR | 95% CI | p-value |
|---|---|---|---|
| metodo_toma | 0.058 | ||
| autotoma | 1.00 | — | |
| convencional | 0.60 | 0.36, 1.00 | |
| dias_procesamiento | 1.00 | 0.95, 1.05 | >0.9 |
| Abbreviations: CI = Confidence Interval, IRR = Incidence Rate Ratio | |||