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 (2).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 50
BASE <- BASE %>%
mutate(t_municipio = case_when(
lugar_de_residencia == "Istmina" ~ "Grande",
lugar_de_residencia == "Valle de Sibundoy" ~ "Grande",
lugar_de_residencia == "Nuquí" ~ "Pequeño",
lugar_de_residencia == "Puerto Leguizamo" ~ "Pequeño",
TRUE ~ nivel_educativo # o el valor que corresponda para el resto
))
BASE$ult_tamizaje_agr[BASE$ult_tamizaje_agr == "NA"] <- "25-36 meses"
summary(BASE$dias_procesamiento)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 3.000 4.000 5.000 7.185 8.000 19.000BASE <- BASE %>%
mutate(dias_proc_cat = cut(dias_procesamiento,
breaks = c(-Inf, 5, Inf),
labels = c("<=5", ">5"),
right = TRUE))Tabla cruce variables sociodemográfiacs y clínicas
library(gtsummary)
library(dplyr)
variables_tabla <- c("departamento", "lugar_de_residencia", "t_municipio", "etnia_agr",
"nivel_educativo_agr", "educacion2", "edad2", "estrategia_toma",
"ultimo_tamizaje", "ult_tamizaje_agr", "dias_procesamiento","dias_proc_cat", "regimen_agr", "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",
t_municipio ~ "Tamaño municipio",
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",
dias_proc_cat ~ "Dias procesamiento categorico",
regimen_agr ~ "Regimen de afiliación",
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%) | |
| Tamaño municipio | 0.007 | |||
| Grande | 334.0 (63.1%) | 226.0 (59.5%) | 108.0 (72.5%) | |
| Pequeño | 195.0 (36.9%) | 154.0 (40.5%) | 41.0 (27.5%) | |
| 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.854 | |||
| <= 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 | 356.0 (67.3%) | 255.0 (67.1%) | 101.0 (67.8%) | |
| Días de procesamiento | 7.19 (4.60) | 5.39 (2.00) | 11.77 (5.98) | <0.001 |
| Dias procesamiento categorico | <0.001 | |||
| <=5 | 266.0 (50.3%) | 237.0 (62.4%) | 29.0 (19.5%) | |
| >5 | 263.0 (49.7%) | 143.0 (37.6%) | 120.0 (80.5%) | |
| Regimen de afiliación | 0.003 | |||
| Contributivo/otros | 171.0 (32.3%) | 139.0 (36.6%) | 32.0 (21.5%) | |
| No afiliado/NA | 4.0 (0.8%) | 2.0 (0.5%) | 2.0 (1.3%) | |
| Subsidiado | 354.0 (66.9%) | 239.0 (62.9%) | 115.0 (77.2%) | |
| 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 | ||||
BASE_pos <- BASE %>% filter(resultado_vph == "positivo")
tabla1.1 <- BASE_pos %>%
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",
t_municipio ~ "Tamaño municipio",
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",
dias_proc_cat ~ "Dias procesamiento categorico",
regimen_agr ~ "Regimen de afiliación",
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() ~ "fisher.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 2. Características según método de toma solo las positivas COLUMNAS****")
tabla1.1| Variable | Overall N = 1341 |
autotoma N = 1081 |
convencional N = 261 |
p-value2 |
|---|---|---|---|---|
| Departamento | 0.003 | |||
| Chocó | 50.0 (37.3%) | 47.0 (43.5%) | 3.0 (11.5%) | |
| Putumayo | 84.0 (62.7%) | 61.0 (56.5%) | 23.0 (88.5%) | |
| Lugar de residencia | <0.001 | |||
| Istmina | 32.0 (23.9%) | 32.0 (29.6%) | 0.0 (0.0%) | |
| Nuquí | 18.0 (13.4%) | 15.0 (13.9%) | 3.0 (11.5%) | |
| Puerto Leguizamo | 32.0 (23.9%) | 30.0 (27.8%) | 2.0 (7.7%) | |
| Valle de Sibundoy | 52.0 (38.8%) | 31.0 (28.7%) | 21.0 (80.8%) | |
| Tamaño municipio | 0.042 | |||
| Grande | 84.0 (62.7%) | 63.0 (58.3%) | 21.0 (80.8%) | |
| Pequeño | 50.0 (37.3%) | 45.0 (41.7%) | 5.0 (19.2%) | |
| Etnia | 0.005 | |||
| Afro-Colombiano | 48.0 (35.8%) | 45.0 (41.7%) | 3.0 (11.5%) | |
| Indigena | 30.0 (22.4%) | 24.0 (22.2%) | 6.0 (23.1%) | |
| Otro/ninguno/NA | 56.0 (41.8%) | 39.0 (36.1%) | 17.0 (65.4%) | |
| Nivel educativo agr | 0.269 | |||
| primaria o menos | 19.0 (14.4%) | 13.0 (12.3%) | 6.0 (23.1%) | |
| profesional o mayor | 27.0 (20.5%) | 21.0 (19.8%) | 6.0 (23.1%) | |
| secundaria-tecnico | 86.0 (65.2%) | 72.0 (67.9%) | 14.0 (53.8%) | |
| Sin dato | 2 | 2 | 0 | |
| Educación (agrupada2) | >0.999 | |||
| Más de Secundaria | 61.0 (46.2%) | 49.0 (46.2%) | 12.0 (46.2%) | |
| Secundaria o menos | 71.0 (53.8%) | 57.0 (53.8%) | 14.0 (53.8%) | |
| Sin dato | 2 | 2 | 0 | |
| Edad (categorizada) | 0.441 | |||
| 29-44 | 105.0 (78.4%) | 86.0 (79.6%) | 19.0 (73.1%) | |
| >=45 | 29.0 (21.6%) | 22.0 (20.4%) | 7.0 (26.9%) | |
| Estrategia toma | 0.002 | |||
| Campaña | 98.0 (73.1%) | 73.0 (67.6%) | 25.0 (96.2%) | |
| Tamizaje rutinario | 36.0 (26.9%) | 35.0 (32.4%) | 1.0 (3.8%) | |
| Último tamizaje | 33.20 (170.71) | 31.18 (165.15) | 41.52 (195.29) | 0.534 |
| Sin dato | 1 | 1 | 0 | |
| Ultimo tamizaje agrupado | 0.468 | |||
| <= 24 meses | 8.0 (6.0%) | 8.0 (7.4%) | 0.0 (0.0%) | |
| >36 meses | 29.0 (21.6%) | 24.0 (22.2%) | 5.0 (19.2%) | |
| 25-36 meses | 97.0 (72.4%) | 76.0 (70.4%) | 21.0 (80.8%) | |
| Días de procesamiento | 6.64 (4.09) | 5.46 (1.94) | 11.54 (6.48) | <0.001 |
| Dias procesamiento categorico | <0.001 | |||
| <=5 | 72.0 (53.7%) | 66.0 (61.1%) | 6.0 (23.1%) | |
| >5 | 62.0 (46.3%) | 42.0 (38.9%) | 20.0 (76.9%) | |
| Regimen de afiliación | 0.356 | |||
| Contributivo/otros | 42.0 (31.3%) | 36.0 (33.3%) | 6.0 (23.1%) | |
| Subsidiado | 92.0 (68.7%) | 72.0 (66.7%) | 20.0 (76.9%) | |
| Resultado vph | ||||
| positivo | 134.0 (100.0%) | 108.0 (100.0%) | 26.0 (100.0%) | |
| 1 n (%); Mean (SD) | ||||
| 2 Fisher’s exact test; Kruskal-Wallis rank sum test; NA | ||||
tabla1.2 <- BASE_pos %>%
dplyr::select(metodo_toma, all_of(variables_tabla)) %>%
tbl_summary(
by = metodo_toma,
percent = "row",
type = list(
c(ultimo_tamizaje, dias_procesamiento) ~ "continuous" #no normales
),
label = list(
departamento ~ "Departamento",
lugar_de_residencia ~ "Lugar de residencia",
t_municipio ~ "Tamaño municipio",
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() ~ "fisher.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 2. Características según método de toma solo las positivas FILAS**")
tabla1.2| Variable | Overall N = 1341 |
autotoma N = 1081 |
convencional N = 261 |
p-value2 |
|---|---|---|---|---|
| Departamento | 0.003 | |||
| Chocó | 50.0 (100.0%) | 47.0 (94.0%) | 3.0 (6.0%) | |
| Putumayo | 84.0 (100.0%) | 61.0 (72.6%) | 23.0 (27.4%) | |
| Lugar de residencia | <0.001 | |||
| Istmina | 32.0 (100.0%) | 32.0 (100.0%) | 0.0 (0.0%) | |
| Nuquí | 18.0 (100.0%) | 15.0 (83.3%) | 3.0 (16.7%) | |
| Puerto Leguizamo | 32.0 (100.0%) | 30.0 (93.8%) | 2.0 (6.3%) | |
| Valle de Sibundoy | 52.0 (100.0%) | 31.0 (59.6%) | 21.0 (40.4%) | |
| Tamaño municipio | 0.042 | |||
| Grande | 84.0 (100.0%) | 63.0 (75.0%) | 21.0 (25.0%) | |
| Pequeño | 50.0 (100.0%) | 45.0 (90.0%) | 5.0 (10.0%) | |
| Etnia | 0.005 | |||
| Afro-Colombiano | 48.0 (100.0%) | 45.0 (93.8%) | 3.0 (6.3%) | |
| Indigena | 30.0 (100.0%) | 24.0 (80.0%) | 6.0 (20.0%) | |
| Otro/ninguno/NA | 56.0 (100.0%) | 39.0 (69.6%) | 17.0 (30.4%) | |
| Nivel educativo agr | 0.269 | |||
| primaria o menos | 19.0 (100.0%) | 13.0 (68.4%) | 6.0 (31.6%) | |
| profesional o mayor | 27.0 (100.0%) | 21.0 (77.8%) | 6.0 (22.2%) | |
| secundaria-tecnico | 86.0 (100.0%) | 72.0 (83.7%) | 14.0 (16.3%) | |
| Sin dato | 2 | 2 | 0 | |
| Educación (agrupada2) | >0.999 | |||
| Más de Secundaria | 61.0 (100.0%) | 49.0 (80.3%) | 12.0 (19.7%) | |
| Secundaria o menos | 71.0 (100.0%) | 57.0 (80.3%) | 14.0 (19.7%) | |
| Sin dato | 2 | 2 | 0 | |
| Edad (categorizada) | 0.441 | |||
| 29-44 | 105.0 (100.0%) | 86.0 (81.9%) | 19.0 (18.1%) | |
| >=45 | 29.0 (100.0%) | 22.0 (75.9%) | 7.0 (24.1%) | |
| Estrategia toma | 0.002 | |||
| Campaña | 98.0 (100.0%) | 73.0 (74.5%) | 25.0 (25.5%) | |
| Tamizaje rutinario | 36.0 (100.0%) | 35.0 (97.2%) | 1.0 (2.8%) | |
| Último tamizaje | 33.20 (170.71) | 31.18 (165.15) | 41.52 (195.29) | 0.534 |
| Sin dato | 1 | 1 | 0 | |
| Ultimo tamizaje agrupado | 0.468 | |||
| <= 24 meses | 8.0 (100.0%) | 8.0 (100.0%) | 0.0 (0.0%) | |
| >36 meses | 29.0 (100.0%) | 24.0 (82.8%) | 5.0 (17.2%) | |
| 25-36 meses | 97.0 (100.0%) | 76.0 (78.4%) | 21.0 (21.6%) | |
| Días de procesamiento | 6.64 (4.09) | 5.46 (1.94) | 11.54 (6.48) | <0.001 |
| dias_proc_cat | <0.001 | |||
| <=5 | 72.0 (100.0%) | 66.0 (91.7%) | 6.0 (8.3%) | |
| >5 | 62.0 (100.0%) | 42.0 (67.7%) | 20.0 (32.3%) | |
| regimen_agr | 0.356 | |||
| Contributivo/otros | 42.0 (100.0%) | 36.0 (85.7%) | 6.0 (14.3%) | |
| Subsidiado | 92.0 (100.0%) | 72.0 (78.3%) | 20.0 (21.7%) | |
| Resultado vph | ||||
| positivo | 134.0 (100.0%) | 108.0 (80.6%) | 26.0 (19.4%) | |
| 1 n (%); Mean (SD) | ||||
| 2 Fisher’s exact test; Kruskal-Wallis rank sum test; NA | ||||
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))
Segregado por municipio
tendencia_metodo2 <- BASE %>%
mutate(mes = floor_date(fecha_tamizaje, "month")) %>%
group_by(mes, lugar_de_residencia) %>%
summarise(
n_total = n(),
n_positivos = sum(resultado_vph == "positivo", na.rm = TRUE),
prop_positivos = n_positivos / n_total * 100,
.groups = "drop"
)
ggplot(tendencia_metodo2, aes(x = mes, y = prop_positivos, color = lugar_de_residencia)) +
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 = "Municipio") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 270, hjust = 1))
Tamaño Municipio
tendencia_metodo3 <- BASE %>%
mutate(mes = floor_date(fecha_tamizaje, "month")) %>%
group_by(mes, t_municipio) %>%
summarise(
n_total = n(),
n_positivos = sum(resultado_vph == "positivo", na.rm = TRUE),
prop_positivos = n_positivos / n_total * 100,
.groups = "drop"
)
ggplot(tendencia_metodo3, aes(x = mes, y = prop_positivos, color = t_municipio)) +
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 = "Tamaño Municipio") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 270, hjust = 1))
Positividad por muniicipio
tabla2 <- BASE %>%
dplyr::select(lugar_de_residencia, t_municipio, resultado_vph, metodo_toma, estrategia_toma) %>%
tbl_summary(
by = resultado_vph,
type = list(
),
label = list(
lugar_de_residencia ~ "Lugar de residencia",
t_municipio ~ "Tamaño municipio",
metodo_toma ~ "Método toma",
estrategia_toma ~ "Estrategia"
),
statistic = list(
all_categorical() ~ "{n} ({p}%)"
),
digits = list(
all_categorical() ~ 1
),
missing = "ifany",
missing_text = "Sin dato"
) %>%
add_p(
test = list(
all_categorical() ~ "chisq.test"
),
pvalue_fun = ~ style_pvalue(.x, digits = 3)
) %>%
add_overall() %>%
modify_header(label ~ "**Variable**") %>%
bold_labels() %>%
bold_p(t = 0.05) %>%
modify_caption("**Tabla 2. Positividad por municipio**")
tabla2| Variable | Overall N = 5281 |
negativo N = 3941 |
positivo N = 1341 |
p-value2 |
|---|---|---|---|---|
| Lugar de residencia | 0.574 | |||
| Istmina | 126.0 (23.9%) | 94.0 (23.9%) | 32.0 (23.9%) | |
| Nuquí | 55.0 (10.4%) | 37.0 (9.4%) | 18.0 (13.4%) | |
| Puerto Leguizamo | 139.0 (26.3%) | 107.0 (27.2%) | 32.0 (23.9%) | |
| Valle de Sibundoy | 208.0 (39.4%) | 156.0 (39.6%) | 52.0 (38.8%) | |
| Tamaño municipio | 0.956 | |||
| Grande | 334.0 (63.3%) | 250.0 (63.5%) | 84.0 (62.7%) | |
| Pequeño | 194.0 (36.7%) | 144.0 (36.5%) | 50.0 (37.3%) | |
| Método toma | 0.012 | |||
| autotoma | 379.0 (71.8%) | 271.0 (68.8%) | 108.0 (80.6%) | |
| convencional | 149.0 (28.2%) | 123.0 (31.2%) | 26.0 (19.4%) | |
| Estrategia | >0.999 | |||
| Campaña | 385.0 (72.9%) | 287.0 (72.8%) | 98.0 (73.1%) | |
| Tamizaje rutinario | 143.0 (27.1%) | 107.0 (27.2%) | 36.0 (26.9%) | |
| 1 n (%) | ||||
| 2 Pearson’s Chi-squared test | ||||
Test de independencia
library(coin)
library(dplyr)
BASE_filt2 <- BASE %>% filter(!is.na(resultado_vph))
vars_a_probar <- c(
"metodo_toma",
"etnia",
"nivel_educativo_agr",
"edad2",
"ult_tamizaje_agr"
)
for (v in vars_a_probar) {
cat("\n==============================\n")
cat("Combinación: estrategia_toma + t_municipio +", v, "\n")
datos_v <- BASE_filt2 %>%
filter(!is.na(.data[[v]]), !is.na(estrategia_toma), !is.na(t_municipio)) %>%
mutate(
resultado_vph = as.factor(resultado_vph),
estrategia_toma = as.factor(estrategia_toma),
t_municipio = as.factor(t_municipio),
!!v := as.factor(.data[[v]]) # convierte la variable v a factor dinámicamente
)
formula_v <- as.formula(paste("resultado_vph ~ estrategia_toma + t_municipio +", v))
test_resultado <- independence_test(
formula_v,
data = datos_v,
distribution = approximate(B = 10000)
)
print(test_resultado)
}##
## ==============================
## Combinación: estrategia_toma + t_municipio + metodo_toma##
## Approximative General Independence Test
##
## data: resultado_vph by
## estrategia_toma, t_municipio, metodo_toma
## maxT = 2.6226, p-value = 0.0284
## alternative hypothesis: two.sided
##
##
## ==============================
## Combinación: estrategia_toma + t_municipio + etnia##
## Approximative General Independence Test
##
## data: resultado_vph by estrategia_toma, t_municipio, etnia
## maxT = 0.40413, p-value = 0.9967
## alternative hypothesis: two.sided
##
##
## ==============================
## Combinación: estrategia_toma + t_municipio + nivel_educativo_agr##
## Approximative General Independence Test
##
## data: resultado_vph by
## estrategia_toma, t_municipio, nivel_educativo_agr
## maxT = 1.619, p-value = 0.3927
## alternative hypothesis: two.sided
##
##
## ==============================
## Combinación: estrategia_toma + t_municipio + edad2##
## Approximative General Independence Test
##
## data: resultado_vph by estrategia_toma, t_municipio, edad2
## maxT = 0.15857, p-value = 0.9996
## alternative hypothesis: two.sided
##
##
## ==============================
## Combinación: estrategia_toma + t_municipio + ult_tamizaje_agr##
## Approximative General Independence Test
##
## data: resultado_vph by
## estrategia_toma, t_municipio, ult_tamizaje_agr
## maxT = 1.4699, p-value = 0.4936
## alternative hypothesis: two.sidedModelo 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 | |||
Modelo multivariado 2
BASE_modelo$edad_cat <- factor(BASE_modelo$edad_cat, levels = c("26-34","35-49", ">=50"))
modelo_poisson3 <- glm(
positividad ~ metodo_toma +
edad_cat,
data = BASE_modelo,
family = poisson(link = "log")
)
coeftest(modelo_poisson3, vcov = sandwich)##
## z test of coefficients:
##
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.99267 0.12130 -8.1838 2.75e-16 ***
## metodo_tomaconvencional -0.49156 0.19285 -2.5490 0.01080 *
## edad_cat35-49 -0.41950 0.15351 -2.7328 0.00628 **
## edad_cat>=50 0.28109 0.32668 0.8604 0.38954
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1tabla_modelo2 <- tbl_regression(
modelo_poisson3,
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 Poisson2 robusto - Razones de Prevalencia**")
tabla_modelo2| Characteristic | IRR | 95% CI | p-value |
|---|---|---|---|
| metodo_toma | 0.018 | ||
| autotoma | 1.00 | — | |
| convencional | 0.61 | 0.42, 0.89 | |
| edad_cat | 0.037 | ||
| 26-34 | 1.00 | — | |
| 35-49 | 0.66 | 0.49, 0.89 | |
| >=50 | 1.32 | 0.70, 2.51 | |
| Abbreviations: CI = Confidence Interval, IRR = Incidence Rate Ratio | |||
summary(modelo_poisson3)$deviance ## [1] 355.3452summary(modelo_poisson2)$null.deviance # devianza nula## [1] 367.49671 - (summary(modelo_poisson2)$deviance / summary(modelo_poisson2)$null.deviance)## [1] 0.01511308AIC(modelo_poisson3)## [1] 631.3452AIC(modelo_poisson2)## [1] 635.9427