aceptabilidad

Análisis descriptivo

library(readxl)
library(dplyr)
BASE <- read_excel("BD_articuloaceptabilidad_autotomaVPH.xlsx") #cargue base datos
BASE1 <- BASE %>% select(edad, tipo_afiliacion, vacuna_vph, meses_lastscreen, n_partos, resultado_vph, encuesta_post_toma) #seleccionar 
BASE1 <- as.data.frame(BASE1) #manejo como dataframe
#str(BASE1)

BASE1$tipo_afiliacion[BASE1$tipo_afiliacion == 3] <- 1
BASE1$tipo_afiliacion <- factor(BASE1$tipo_afiliacion, levels = c(1,2), labels = c("Contributivo", "Subsidiado"))
BASE1$vacuna_vph <- factor(BASE1$vacuna_vph, levels = c(1,2), labels = c("Si", "No"))

BASE1 <- BASE1 %>% filter(encuesta_post_toma == 1)

#BASE1$resultado_vph <- replace(BASE1$resultado_vph, BASE1$resultado_vph == 3, NA)
BASE1$resultado_vph <- factor(BASE1$resultado_vph, levels = c(1,2,3), labels = c("Detectado", "No detectado", "Insatisfactorio"))

BASE1 <- BASE1 %>%
  filter(edad <= 65) %>%
  filter(!is.na(edad))


library(gtsummary)
tabla1 <- BASE1 %>%
  select(edad, tipo_afiliacion, vacuna_vph, meses_lastscreen, n_partos, resultado_vph) %>%
  tbl_summary(
    by = resultado_vph,
    type = list(
      all_continuous()                    ~ "continuous2",
      all_categorical()                   ~ "categorical"
    ),
    label = list(
      edad ~ "Edad", 
      tipo_afiliacion ~ "Afiliacion", 
      vacuna_vph ~"Vacunacion vph", 
      meses_lastscreen ~ "Tiempo en meses último tamizaje", 
      n_partos ~ "Paridad"
          ),
    statistic = list(
      all_continuous2()  ~ c(
        "{mean} ({sd})",
        "{median} ({p25}, {p75})",
        "{min} - {max}"
      ),
      all_categorical() ~ "{n} ({p}%)"
    ),
    digits = list(
      all_continuous()  ~ 2,
      all_categorical() ~ 2
    ),
    missing = "ifany",
    missing_text = "Sin dato"
  ) %>%
  add_p(
    test = list(
      all_continuous()  ~ "kruskal.test",  
      all_categorical() ~ "fisher.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**")

tabla1

Tabla 1

Variable	Overall N = 8451	Detectado N = 2091	No detectado N = 6351	Insatisfactorio N = 11	p-value2
Edad					0.115
Mean (SD)	43.73 (9.67)	43.09 (9.95)	43.91 (9.54)	64.00 (NA)
Median (Q1, Q3)	42.00 (36.00, 51.00)	41.00 (35.00, 50.00)	43.00 (36.00, 51.00)	64.00 (64.00, 64.00)
Min - Max	24.00 - 65.00	25.00 - 65.00	24.00 - 65.00	64.00 - 64.00
Afiliacion					0.526
Contributivo	128.00 (15.84%)	28.00 (14.00%)	100.00 (16.47%)	0.00 (0.00%)
Subsidiado	680.00 (84.16%)	172.00 (86.00%)	507.00 (83.53%)	1.00 (100.00%)
Sin dato	37	9	28	0
Vacunacion vph					0.522
Si	97.00 (14.06%)	27.00 (16.07%)	70.00 (13.44%)	0.00 (0.00%)
No	593.00 (85.94%)	141.00 (83.93%)	451.00 (86.56%)	1.00 (100.00%)
Sin dato	155	41	114	0
Tiempo en meses último tamizaje					0.117
Mean (SD)	49.73 (441.32)	31.25 (27.91)	55.72 (507.83)	43.04 (NA)
Median (Q1, Q3)	25.82 (16.89, 38.90)	25.03 (13.96, 37.06)	25.89 (17.74, 40.90)	43.04 (43.04, 43.04)
Min - Max	0.36 - 12,015.80	0.56 - 234.09	0.36 - 12,015.80	43.04 - 43.04
Sin dato	104	28	76	0
Paridad					0.077
Mean (SD)	2.39 (1.50)	2.29 (1.52)	2.42 (1.46)	10.00 (NA)
Median (Q1, Q3)	2.00 (2.00, 3.00)	2.00 (1.00, 3.00)	2.00 (2.00, 3.00)	10.00 (10.00, 10.00)
Min - Max	0.00 - 10.00	0.00 - 8.00	0.00 - 10.00	10.00 - 10.00
Sin dato	3	0	3	0
1 n (%)
2 Kruskal-Wallis rank sum test; Fisher’s exact test

library(huxtable)

tabla1 %>%
  as_hux_xlsx("tabla1.xlsx")

Variables aceptabilidad

BASE2 <- BASE %>% select(encuesta_post_toma,    como_se_sintio, razones_no_satisfaccion___1,    razones_no_satisfaccion___2,    razones_no_satisfaccion___3,    razones_no_satisfaccion___4,    razones_no_satisfaccion___5,    otra_no_satisfaccion,   confianza_prueba,   toma_prueba, resultado_vph)
#lapply(BASE2, table)

BASE2$emocion <- ifelse(
  BASE2$razones_no_satisfaccion___1 == 1 | 
    BASE2$razones_no_satisfaccion___2 == 1 |
    grepl("inseguridad", BASE2$otra_no_satisfaccion, ignore.case = TRUE),
    2, 1)

BASE2$tecnico <- ifelse(
  BASE2$razones_no_satisfaccion___3 == 1 | 
  BASE2$razones_no_satisfaccion___4 == 1 |
  grepl("instrumento", BASE2$otra_no_satisfaccion, ignore.case = TRUE),
  2, 1
)
BASE2$confianza <- ifelse(BASE2$confianza_prueba == 1, 1, 2)

BASE2$acept_autotoma <- ifelse(BASE2$toma_prueba == 1, 1,2)

Análisis descriptivo

library(dplyr)
library(ggplot2)

BASE3 <- as.data.frame(BASE[, c("resultado_vph", "como_se_sintio", 
                  "razones_no_satisfaccion___1", "razones_no_satisfaccion___2",
                  "razones_no_satisfaccion___3", "razones_no_satisfaccion___4",
                  "razones_no_satisfaccion___5", "otra_no_satisfaccion",
                  "confianza_prueba", "toma_prueba", "edad", "encuesta_post_toma")])

BASE3$como_se_sintio <- factor(BASE3$como_se_sintio, levels = c(1,2), labels = c("Bien", "No Bien"))

BASE3$resultado_vph <- replace(BASE3$resultado_vph, BASE3$resultado_vph == 3, NA)
BASE3$resultado_vph <- factor(BASE3$resultado_vph, levels = c(1,2), labels = c("Detectado", "No detectado"))

BASE3$barrera_emo <- factor(ifelse(
  BASE3$razones_no_satisfaccion___1 == 1 | 
    BASE3$razones_no_satisfaccion___2 == 1 |
    grepl("inseguridad", BASE3$otra_no_satisfaccion, ignore.case = TRUE),
    "Si", "No"))

BASE3$barrera_tec <- factor(ifelse(
  BASE3$razones_no_satisfaccion___3 == 1 | 
  BASE3$razones_no_satisfaccion___4 == 1 |
  grepl("instrumento", BASE3$otra_no_satisfaccion, ignore.case = TRUE),
  "Si", "No"
))

BASE3$confianza_prueba <- ifelse(BASE2$confianza_prueba == 1, 1, 2)
BASE3$confianza_prueba <- factor(BASE3$confianza_prueba, levels = c(1,2), labels = c("Si", "No"))
BASE3$toma_prueba <- factor(BASE3$toma_prueba, levels = c(1,2,3), labels = c("Misma mujer", "Profesional salud", "Sin preferencia"))

BASE3 <- BASE3 %>%
 filter(!is.na(toma_prueba))  #870 --> 856

BASE3 <- BASE3 %>%
 filter(!is.na(resultado_vph))  #856 --> 855


#BASE2$consumo_diario_std_3cat[is.na(BASE1$consumo_diario_std_3cat)] <- "Consumo Ligero"

datos_sankey <- as.data.frame(BASE3[, c("resultado_vph", "como_se_sintio", "barrera_emo", "barrera_tec", "confianza_prueba", "toma_prueba")])
#dput(names(BASE3))


library(forcats)

datos_sankey <- datos_sankey %>%
  rename(VPH = resultado_vph, Sintio_toma = como_se_sintio, Barrera_emocional = barrera_emo, Barrera_tecnica = barrera_tec, Confianza = confianza_prueba, Preferencia_prueba = toma_prueba)

BASE_transformado <- datos_sankey %>% group_by(VPH, Sintio_toma, Barrera_emocional, Barrera_tecnica, Confianza, Preferencia_prueba) %>% summarise(Freq = n()) %>% ungroup() 

library(easyalluvial) 

alluvial_wide( data = datos_sankey, 
               max_variables = 8, fill_by = 'last_variable',
               col_vector_flow = c("skyblue", "salmon", "#52b788"))

library(gt)
BASE_transformado %>%
  arrange(desc(Freq)) %>%       
  gt() %>%
  tab_header(title = "Conteos") %>%
  cols_label_with(fn = toupper)

Conteos
VPH	SINTIO_TOMA	BARRERA_EMOCIONAL	BARRERA_TECNICA	CONFIANZA	PREFERENCIA_PRUEBA	FREQ
No detectado	Bien	No	No	Si	Misma mujer	297
Detectado	Bien	No	No	Si	Misma mujer	87
No detectado	Bien	No	No	Si	Profesional salud	87
No detectado	Bien	No	No	Si	Sin preferencia	81
Detectado	Bien	No	No	Si	Profesional salud	45
No detectado	No Bien	Si	No	Si	Profesional salud	34
No detectado	Bien	No	No	No	Profesional salud	32
Detectado	Bien	No	No	Si	Sin preferencia	25
No detectado	Bien	Si	No	Si	Profesional salud	17
No detectado	No Bien	Si	No	No	Profesional salud	17
Detectado	Bien	No	No	No	Profesional salud	11
No detectado	Bien	No	No	No	Misma mujer	11
No detectado	Bien	Si	No	Si	Misma mujer	11
No detectado	No Bien	Si	No	Si	Misma mujer	9
Detectado	No Bien	Si	No	No	Profesional salud	8
Detectado	No Bien	Si	No	Si	Profesional salud	7
No detectado	No Bien	No	Si	Si	Profesional salud	6
No detectado	No Bien	Si	No	Si	Sin preferencia	5
No detectado	No Bien	Si	Si	No	Profesional salud	5
Detectado	Bien	Si	No	Si	Misma mujer	4
Detectado	Bien	Si	No	No	Profesional salud	4
Detectado	No Bien	Si	No	Si	Misma mujer	4
No detectado	Bien	Si	No	Si	Sin preferencia	4
No detectado	No Bien	Si	No	No	Misma mujer	4
No detectado	Bien	No	No	No	Sin preferencia	3
Detectado	Bien	No	No	No	Misma mujer	2
Detectado	Bien	Si	No	Si	Profesional salud	2
Detectado	No Bien	Si	No	Si	Sin preferencia	2
Detectado	No Bien	Si	No	No	Misma mujer	2
Detectado	No Bien	Si	Si	No	Profesional salud	2
No detectado	Bien	No	Si	Si	Misma mujer	2
No detectado	Bien	No	Si	No	Profesional salud	2
No detectado	Bien	Si	No	No	Misma mujer	2
No detectado	Bien	Si	No	No	Profesional salud	2
No detectado	No Bien	No	No	No	Profesional salud	2
No detectado	No Bien	No	Si	No	Profesional salud	2
No detectado	No Bien	Si	Si	Si	Misma mujer	2
Detectado	Bien	No	No	No	Sin preferencia	1
Detectado	Bien	Si	No	Si	Sin preferencia	1
Detectado	No Bien	No	No	Si	Profesional salud	1
Detectado	No Bien	No	No	No	Profesional salud	1
Detectado	No Bien	No	Si	No	Profesional salud	1
Detectado	No Bien	Si	Si	Si	Misma mujer	1
Detectado	No Bien	Si	Si	Si	Profesional salud	1
No detectado	Bien	Si	No	No	Sin preferencia	1
No detectado	Bien	Si	Si	Si	Misma mujer	1
No detectado	No Bien	No	No	Si	Sin preferencia	1
No detectado	No Bien	No	Si	Si	Misma mujer	1
No detectado	No Bien	Si	No	No	Sin preferencia	1
No detectado	No Bien	Si	Si	Si	Profesional salud	1

tabla_acept <- BASE3 %>%
  select(como_se_sintio, barrera_emo, barrera_tec, 
         confianza_prueba, toma_prueba, resultado_vph) %>%
  tbl_summary(
    by = resultado_vph,
    label = list(
      como_se_sintio ~ "¿Cómo se sintió?",
      barrera_emo ~ "Barrera emocional",
      barrera_tec ~ "Barrera técnica",
      confianza_prueba ~ "Confianza en la prueba",
      toma_prueba ~ "Preferencia de toma"
    ),
    statistic = all_categorical() ~ "{n} ({p}%)",
    missing = "ifany",
    missing_text = "Sin dato"
  ) %>%
  add_p(pvalue_fun = ~ style_pvalue(.x, digits = 3)) %>%
  add_overall() %>%
  bold_labels() %>%
  bold_p(t = 0.05) %>%
  modify_caption("**Aceptabilidad de autotoma según resultado VPH**")
tabla_acept

Aceptabilidad de autotoma según resultado VPH

Characteristic	Overall N = 8551	Detectado N = 2121	No detectado N = 6431	p-value2
¿Cómo se sintió?				0.955
Bien	735 (86%)	182 (86%)	553 (86%)
No Bien	120 (14%)	30 (14%)	90 (14%)
Barrera emocional				0.970
No	701 (82%)	174 (82%)	527 (82%)
Si	154 (18%)	38 (18%)	116 (18%)
Barrera técnica				0.443
No	828 (97%)	207 (98%)	621 (97%)
Si	27 (3.2%)	5 (2.4%)	22 (3.4%)
Confianza en la prueba				0.454
Si	739 (86%)	180 (85%)	559 (87%)
No	116 (14%)	32 (15%)	84 (13%)
Preferencia de toma				0.178
Misma mujer	440 (51%)	100 (47%)	340 (53%)
Profesional salud	290 (34%)	83 (39%)	207 (32%)
Sin preferencia	125 (15%)	29 (14%)	96 (15%)
1 n (%)
2 Pearson’s Chi-squared test

tabla_acept %>%
  as_hux_xlsx("tabla2.xlsx")

Razones no satisfacción

BASE2$resultado_vph <- replace(BASE2$resultado_vph, BASE1$resultado_vph == 3, NA)
BASE2$resultado_vph <- factor(BASE2$resultado_vph, levels = c(1,2), labels = c("Detectado", "No detectado"))


tabla_acept2 <- BASE2 %>%
  select(razones_no_satisfaccion___1,   razones_no_satisfaccion___2,    razones_no_satisfaccion___3,    razones_no_satisfaccion___4,    razones_no_satisfaccion___5,resultado_vph) %>%
  tbl_summary(
    by = resultado_vph,
    label = list(
     razones_no_satisfaccion___1 ~ "Miedo",
       razones_no_satisfaccion___2 ~ "Incomodidad", 
     razones_no_satisfaccion___3 ~ "No comprendió", 
     razones_no_satisfaccion___4 ~ "dificil",   
     razones_no_satisfaccion___5 ~"Otro"),
    statistic = all_categorical() ~ "{n} ({p}%)",
    missing = "ifany",
    missing_text = "Sin dato"
  ) %>%
  add_p(pvalue_fun = ~ style_pvalue(.x, digits = 3)) %>%
  add_overall() %>%
  bold_labels() %>%
  bold_p(t = 0.05) %>%
  modify_caption("**Razone sno satisfacción autotoma según resultado VPH**")
tabla_acept2

Razone sno satisfacción autotoma según resultado VPH

Characteristic	Overall N = 8691	Detectado N = 2261	No detectado N = 6431	p-value2
Miedo	70 (8.1%)	18 (8.0%)	52 (8.1%)	0.954
Incomodidad	90 (10%)	24 (11%)	66 (10%)	0.880
No comprendió	3 (0.3%)	0 (0%)	3 (0.5%)	0.572
dificil	20 (2.3%)	5 (2.2%)	15 (2.3%)	0.917
Otro	15 (1.7%)	2 (0.9%)	13 (2.0%)	0.377
1 n (%)
2 Pearson’s Chi-squared test; Fisher’s exact test

tabla_acept2 %>%
  as_hux_xlsx("tabla3.xlsx")

Tabla frecuencia

BASE3 <- BASE3 %>% filter(encuesta_post_toma == 1)

BASE3 <- BASE3 %>%
  filter(edad <= 65) %>%
  filter(!is.na(edad)) #844

round(prop.table(table(BASE3$confianza_prueba, BASE3$toma_prueba))*100,2)

##     
##      Misma mujer Profesional salud Sin preferencia
##   Si       49.17             23.22           13.98
##   No        2.49             10.55            0.59

table(BASE3$confianza_prueba, BASE3$toma_prueba)

##     
##      Misma mujer Profesional salud Sin preferencia
##   Si         415               196             118
##   No          21                89               5

round(prop.table(table(BASE3$como_se_sintio, BASE3$toma_prueba))*100,2)

##          
##           Misma mujer Profesional salud Sin preferencia
##   Bien          48.93             23.46           13.51
##   No Bien        2.73             10.31            1.07

table(BASE3$como_se_sintio, BASE3$toma_prueba)

##          
##           Misma mujer Profesional salud Sin preferencia
##   Bien            413               198             114
##   No Bien          23                87               9

library(irr)

# Reconstruir observaciones individuales
evaluador1 <- c(rep("Si", 419+201+119), rep("No", 21+89+6))

evaluador2 <- c(
  rep("MismaMujer", 419), rep("ProfSalud", 201), rep("SinPref", 119),  # filas Si
  rep("MismaMujer", 21),  rep("ProfSalud", 89),  rep("SinPref", 6)    # filas No
)

# Recodificar según tu lógica de concordancia
e1_bin <- evaluador1  # Ya es binario

e2_bin <- ifelse(evaluador2 == "MismaMujer", "Si", "No")

tabla <- table(e1_bin, e2_bin)
print(tabla)

##       e2_bin
## e1_bin  No  Si
##     No  95  21
##     Si 320 419

# Kappa
library(vcd)
Kappa(tabla)

##            value    ASE     z  Pr(>|z|)
## Unweighted 0.185 0.0238 7.771 7.799e-15
## Weighted   0.185 0.0238 7.771 7.799e-15

library(ggplot2)
library(dplyr)
library(tidyr)

# Crear los datos
datos <- data.frame(
  Pregunta = c(rep("General acceptance", 6), rep("Trust in sampling technique", 6)),
  Respuesta = rep(c("Yes", "Yes", "Yes", "No", "No", "No"), 2),
  Preferencia = rep(c("HPV Self-collected", "HPV Clinician-collected", "No preference"), 4),
  Porcentaje = c(
    # General acceptance
    11.7, 9.71, 3.39,
    39.77, 24.21, 11.23,
    # Trust
    49.01, 23.51, 13.92,
    2.46, 10.41, 0.70
  )
)

# Definir orden de categorías
datos$Preferencia <- factor(datos$Preferencia, 
                            levels = c("HPV Self-collected", 
                                       "HPV Clinician-collected", 
                                       "No preference"))
datos$Respuesta <- factor(datos$Respuesta, levels = c("Yes", "No"))

# Heatmap
ggplot(datos, aes(x = Preferencia, y = Respuesta, fill = Porcentaje)) +
  geom_tile(color = "white", linewidth = 1) +
  geom_text(aes(label = paste0(Porcentaje, "%")), 
            size = 4, fontface = "bold") +
  scale_fill_gradient(low = "white", high = "#2166AC",
                      name = "Percentage (%)") +
  facet_wrap(~Pregunta, ncol = 1) +
  labs(
    title = "Sampling method preference",
    x = "Sampling method preference",
    y = NULL
  ) +
  theme_minimal(base_size = 13) +
  theme(
    axis.text.x = element_text(angle = 25, hjust = 1),
    strip.text = element_text(face = "bold", size = 12),
    panel.grid = element_blank(),
    legend.position = "right"
  )