Cargue de la base de datos

Se carga la base de datos ya filtrada y compactada. En esta base

En esta base se inclyeron un total de 494 registros

Ajuste de variables para el analisis

  1. Dolor
  2. Ingreso por tamizaje o sintomas
  3. Indice de Charlson
  4. Afiliacion al sistema de salud
  5. Edad (ajuste de NA)
  6. Intervalo entre Radioterapia y braquiterapia (Ajuste NA)
  7. Nivel educativo
  8. Grupo etnico
  9. Estado FIGO
  10. Antecedente tabaquismo
#Ajuste de variables inicial (dolor + sintomas/tamizaje + Charlson)
library(dplyr)  
  BASE$dolor <- ifelse(
  apply(BASE[, c(76,81, 82)] == "Checked", 1, any),  # Verificar si hay algún "Checked" en cada fila
  "Sí", 
  "No")


BASE$ingreso <- ifelse(BASE$`¿Cuenta con estudios previos de tamizaje para cáncer de cuello uterino?`== "Si", "tamizaje", "sintomas")
BASE$ingreso[is.na(BASE$ingreso)] <- "sintomas"
  
  BASE <- BASE %>%
  mutate(charls_cat= cut(`Índice de Charlson`, 
                           breaks = c(-Inf, 2, 4, Inf), 
                           right = T, 
                           labels = c("<=2","3-4", ">=5")))  

#table(BASE$`Régimen Afiliación Salud (Colombia)`)
#table(BASE$`Régimen afiliación salud (Guatemala)`)    

    BASE <- BASE %>%
    mutate(AFILIACION = case_when(
    `Régimen Afiliación Salud (Colombia)` %in% c("Contributivo", "Particular/Prepagada") |
    `Régimen afiliación salud (Guatemala)` %in% c("Privado/Seguro médico") ~ "Contributivo/Privado",
     `Régimen Afiliación Salud (Colombia)` %in% c("Subsidiado") |
     `Régimen afiliación salud (Guatemala)` %in% c("Sector público", "Seguro social") ~ "Subsidiado/Público",
     TRUE ~ NA_character_  # Para los casos que no cumplen ninguna condición
    )) 

BASE$AFILIACION <- factor(BASE$AFILIACION, levels = c("Subsidiado/Público", "Contributivo/Privado")) #REORDENANDO LAS CATEGORIAS


#summary(BASE$`Edad a la fecha de diagnóstico`)
# se convierten en NA los mayores o iguales a 100
BASE$`Edad a la fecha de diagnóstico`[BASE$`Edad a la fecha de diagnóstico` >= 100] <- NA

#summary(BASE$`Intervalo entre Radioterapia Externa y Braquiterapia`)
BASE$`Intervalo entre Radioterapia Externa y Braquiterapia`[BASE$`Intervalo entre Radioterapia Externa y Braquiterapia` >= 1000] <- NA

#table(BASE$`Máximo nivel de educación alcanzado`)
    
BASE$EDUCACION <- ifelse(BASE$`Máximo nivel de educación alcanzado` %in% c("No sabe leer/escribir", "Primaria"), "Primaria <",
ifelse(BASE$`Máximo nivel de educación alcanzado` %in% c("Secundaria", "Técnico"), "Secundaria + tecnico", ifelse(BASE$`Máximo nivel de educación alcanzado` %in% c("Profesional", "Posgrado (maestría, doctorado)"), "Profesional + posgrado", BASE$`Máximo nivel de educación alcanzado`)))

BASE$EDUCACION <- factor(BASE$EDUCACION, levels = c("Primaria <", "Secundaria + tecnico", "Profesional + posgrado") ) #REORDENANDO LAS CATEGORIAS

#table(BASE$`Grupo étnico`)
BASE$GRUPO_ET <- ifelse(BASE$`Grupo étnico` %in% c("Afroamericano", "Gitanos o romanos", "Latino", "Mestizo", "Otros", "No aplica"), "Sin etnia especifica", ifelse(BASE$`Grupo étnico` %in% c("Indígena (etnias)"), "Indigena", BASE$`Grupo étnico`))


BASE$GRUPO_ET <- factor(BASE$GRUPO_ET, levels = c("Indigena", "Sin etnia especifica")) #REORDENANDO LAS CATEGORIAS

BASE$EST_clin_FIGO<- factor(recode(BASE$`Estadio clínico según clasificación FIGO`, "IB3: Tumor confinado al cuello uterino que mide 4 cm o más de ancho." = "IB3,II,IIA", "II: Cáncer se ha diseminado más allá del útero hacia la vagina o tejido cercano al cuello uterino y esta dentro del área pélvica." = "IB3,II,IIA",
"IIA: Tumor limitado a los dos tercios superiores de la vagina." = "IB3,II,IIA", 
"IIB: Tumor diseminado a región parametrial sin llegar a la pared pélvica." = "IIB, III, IIIA, IIIB, IIIC, IVA", "III: Tumor compromete tercio inferior de vagina y/o se ha diseminado a la pared pélvica y/o causa hidronefrosis y/o compromete ganglios linfáticos regionales, sin desiminación a distancia." = "IIB, III, IIIA, IIIB, IIIC, IVA", "IIIA: Tumor compromete tercio inferior de la vagina, no ha crecido hasta interior de la pared pélvica." = "IIB, III, IIIA, IIIB, IIIC, IVA", "IIIB: Tumor ha crecido dentro de la pared pélvica y/o afecta un riñón." = "IIB, III, IIIA, IIIB, IIIC, IVA", "IIIC: Tumor compromete ganglios linfáticos regionales (pelvis y paraaórticos)." = "IIB, III, IIIA, IIIB, IIIC, IVA", 
"IVA: Cáncer se ha diseminado a vejiga o recto, pero no hay metástasis a distancia." = "IIB, III, IIIA, IIIB, IIIC, IVA"))

BASE$EST_clin_FIGO <- factor(BASE$EST_clin_FIGO, levels = c("IB3,II,IIA", "IIB, III, IIIA, IIIB, IIIC, IVA")) #REORDENANDO LAS CATEGORIAS


BASE$TABAQUISMO <- ifelse(BASE$Tabaquismo %in% c("Fumadora al momento del diagnóstico 1 paquete año o menos", "Fumadora al momento del diagnóstico 2 paquetes año o más"), "Fumadora", ifelse(BASE$Tabaquismo %in% c("Fumó hasta menos de 15 años previos al diagnóstico (al momento del diagnóstico sin consumo)"), "Ex-Fumadora", ifelse(BASE$Tabaquismo %in% c("Nunca o dejó de fumar 15 años o más antes del diagnóstico"), "No fumadora", BASE$Tabaquismo)))

BASE$TABAQUISMO <- factor(BASE$TABAQUISMO, levels = c("No fumadora","Ex-Fumadora", "Fumadora"))

BASE$ECOG <- factor(recode(BASE$ECOG, "0 Asintomático, sin restricciones para realización de la actividad física" = "ECOG0", "1 Sintomático con limitación para actividades arduas. Logra desempeñar sin asistencia trabajos ligeros y actividades cotidianas. Permanece en cama solo en las horas de sueño" = "ECOG1",
"2 Paciente encamado menos del 50% del día.  Satisface la mayoría de sus necesidades solo" = "ECOG2", 
"3 Paciente encamado más del 50% del día. Necesita ayuda para satisfacer la mayoría de las actividades diarias" = "ECOG3", "6 Sin dato" = "SIN DATO"))

BASE$ECOG[BASE$ECOG == "SIN DATO"] <- NA

Analisis estadistico

#Numero de casos por intitucion (verificados en calidad)

País Centro n
Colombia HUSI 132
Colombia COAJ 122
Guatemala ANGELES 121
Guatemala MIRARI 119
Total 488

Analisis de datos sociodemografico

myVars1 <- c("Edad a la fecha de diagnóstico", "EDUCACION", "GRUPO_ET", "Estado civil",               "AFILIACION","tipo_residencia") 
catVars1 <- c("EDUCACION", "GRUPO_ET", "Estado civil", "AFILIACION","tipo_residencia")  
# Reordenando las categorias para la tabla 1 PENDIENTES

BASE$`Estado civil` <- factor(BASE$`Estado civil`, levels = c("Soltero", "Casado o en pareja", "Divorciado o viudo")) #REORDENANDO LAS CATEGORIAS

library(tableone)
tab1 <- CreateTableOne(vars = myVars1, factorVars= catVars1, strata = "Procedencia", data = BASE, includeNA = F, test = T,addOverall = T, testNonNormal = T)
table1 <- as.data.frame(print(tab1, showAllLevels= TRUE, printToggle = FALSE, noSpaces = TRUE))
table1 <- table1[,c(-6)]
rownames(table1) <- gsub("\\.{3,}", "", rownames(table1))  # Quita puntos suspensivos "..."
rownames(table1) <- gsub("\\.{1,}", "_", rownames(table1))  # Quita puntos suspensivos "..."
rownames(table1) <- gsub("\\_{1,}", " ", rownames(table1))  # Quita puntos suspensivos "..."


library(knitr)
library(kableExtra)

kable(table1, format = "html", caption = "Variable sociodemograficas") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F,position = "center") %>%
  column_spec(1, bold = T, color = "white", background = "#D7261E") %>%
  column_spec(2, border_left = T, background = "#F3E6E3")
Variable sociodemograficas
level Overall Colombia Guatemala p
n 494 254 240
Edad a la fecha de diagnóstico mean SD 51.25 (13.39) 51.77 (14.65) 50.71 (11.91) 0.379
EDUCACION Primaria < 144 (37.0) 47 (30.1) 97 (41.6) 0.001
X Secundaria + tecnico 209 (53.7) 85 (54.5) 124 (53.2)
X 1 Profesional + posgrado 36 (9.3) 24 (15.4) 12 (5.2)
GRUPO ET Indigena 35 (7.1) 3 (1.2) 32 (13.3) <0.001
X 2 Sin etnia especifica 459 (92.9) 251 (98.8) 208 (86.7)
Estado civil Soltero 110 (24.4) 58 (26.9) 52 (22.2) 0.043
X 3 Casado o en pareja 254 (56.4) 127 (58.8) 127 (54.3)
X 4 Divorciado o viudo 86 (19.1) 31 (14.4) 55 (23.5)
AFILIACION Subsidiado/Público 197 (39.9) 131 (51.6) 66 (27.5) <0.001
X 5 Contributivo/Privado 297 (60.1) 123 (48.4) 174 (72.5) 
#library(openxlsx)
#write.xlsx(table1, "tablasocio_dm_Junio.xlsx", rowNames = TRUE)

Antecedentes

#cambiando nombres variables y niveles para mejor visualizacion de la tabla 1 

colnames(BASE)[colnames(BASE) == "Número de gestaciones (incluyendo abortos, ectópicos y nacimientos vivos previos al ingreso al estudio)"] <- "N.de gestaciones"

colnames(BASE)[colnames(BASE) == "Número de partos vaginales"] <- "N. partos 
vaginales"

colnames(BASE)[colnames(BASE) == "Tipo de estudio de tamizaje (choice=Citología)"] <- "Citologia"

colnames(BASE)[colnames(BASE) == "Tipo de estudio de tamizaje (choice=Pruebas moleculares VPH)"] <- "P. molecular VPH"

colnames(BASE)[colnames(BASE) == "Antecedente de procedimientos en cérvix (choice=Conización cervical)"] <- "Conización cervical"

colnames(BASE)[colnames(BASE) == "Antecedente de procedimientos en cérvix (choice=Crioterapia)"] <- "Crioterapia"

colnames(BASE)[colnames(BASE) == "Antecedente de procedimientos en cérvix (choice=Ablación térmica)"] <- "Ablación térmica"

colnames(BASE)[colnames(BASE) == "Antecedente de procedimientos en cérvix (choice=Biopsia exocervical o endocervical)"] <- "Biopsia exocervical o endocervical"

colnames(BASE)[colnames(BASE) == "Antecedente de procedimientos en cérvix (choice=Ninguno)"] <- "Ningun procedimiento cervix previo"

#names(BASE) 35:37, 45:49
BASE <- BASE %>%
  mutate(across(c(35:37, 45:49), ~ recode(., "Checked" = "Si", "Unchecked" = "No")))


BASE$`Historia de lesiones premalignas` <- ifelse(BASE$`Historia de lesiones premalignas` %in% c("NIC 1 (displasia leve) - Lesión escamosa intraepitelial de bajo grado"), "NIC 1", ifelse(BASE$`Historia de lesiones premalignas` %in% c("NIC 2 (displasia moderada - Lesión escamosa intraepitelial de alto grado", "NIC 3 (displasia grave) - Lesión escamosa intraepitelial de alto grado"), "NIC 2 - 3", BASE$`Historia de lesiones premalignas`))

BASE$`Historia de lesiones premalignas` <- factor(BASE$`Historia de lesiones premalignas`, levels = c("NIC 2 - 3", "NIC 1", "Carcinoma in situ", "Nunca")) #REORDENANDO LAS CATEGORIAS
BASE <- BASE %>%
  mutate(
    # Contar cuántas respuestas "Sí" hay
    n_procedimientos = (`Ningun procedimiento cervix previo` == "Si") + 
      (`Biopsia exocervical o endocervical` == "Si") + 
      (`Ablación térmica`== "Si") + 
      (`Conización cervical` == "Si") + 
      (`Crioterapia` == "Si"),
    
    # Crear la columna con la clasificación
    Procedimiento_Cervix = case_when(
      `Ningun procedimiento cervix previo` == "Si" ~ "NINGUNA",
      `Biopsia exocervical o endocervical` == "Si" ~ "BIOPSIA",
      `Ablación térmica` == "Si" | `Crioterapia` == "Si" ~ "TRAT. ABLATIVO",
      `Conización cervical` == "Si" ~ "CONIZACION",
      TRUE ~ NA_character_
    )
  )

# Ver casos con múltiples respuestas
casos_multiples <- BASE %>% 
  filter(n_procedimientos > 1) %>% 
  select(contains("cervix"), contains("Ablación"), contains("Crioterapia"), 
         contains("Biopsia"), contains("Conización"), Procedimiento_Cervix)

BASE$Procedimiento_Cervix <- factor(BASE$Procedimiento_Cervix, levels = c("NINGUNA", "BIOPSIA", "TRAT. ABLATIVO", "CONIZACION")) #REORDENANDO LAS CATEGORIAS
myVars2<-c("TABAQUISMO", "N.de gestaciones",  "N. partos vaginales", "Citologia", "P. molecular VPH", "Historia de lesiones premalignas", "Procedimiento_Cervix", "charls_cat")
    
catVars2<-c("TABAQUISMO", "Citologia", "P. molecular VPH", "Historia de lesiones premalignas", "Conización cervical", "Crioterapia", "Procedimiento_Cervix", "charls_cat")
    
tab2 <- CreateTableOne(vars = myVars2, factorVars= catVars2, strata = "Procedencia", data = BASE, includeNA = F, test = T, addOverall = T, testNonNormal = T)

table2 <- as.data.frame(print(tab2, showAllLevels= TRUE, printToggle = FALSE, noSpaces = TRUE))
table2 <- table2[,c(-6)]


rownames(table2) <- gsub("\\.{3,}", "", rownames(table2))  # Quita 3 puntos suspensivos
rownames(table2) <- gsub("\\.{2,}", " ", rownames(table2))  # Quita 2 puntos suspensivos
rownames(table2) <- gsub("\\.{1,}", " ", rownames(table2))  # Quita 1 punto

kable(table2, format = "html", caption = "Antecedentes") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F,position = "center") %>%
  column_spec(1, bold = T, color = "white", background = "#698B22") %>%
  column_spec(2, border_left = T, background = "#98FB98")
Antecedentes
level Overall Colombia Guatemala p
n 494 254 240
TABAQUISMO No fumadora 422 (90.9) 210 (87.9) 212 (94.2) 0.032
X Ex-Fumadora 17 (3.7) 10 (4.2) 7 (3.1)
X 1 Fumadora 25 (5.4) 19 (7.9) 6 (2.7)
N de gestaciones mean SD 3.73 (2.67) 3.84 (3.06) 3.62 (2.18) 0.357
Citologia No 373 (75.5) 163 (64.2) 210 (87.5) <0.001
X 2 Si 121 (24.5) 91 (35.8) 30 (12.5)
P molecular VPH No 485 (98.2) 245 (96.5) 240 (100.0) 0.009
X 3 Si 9 (1.8) 9 (3.5) 0 (0.0)
Historia de lesiones premalignas NIC 2 - 3 17 (5.8) 7 (3.8) 10 (9.2) <0.001
X 4 NIC 1 9 (3.1) 3 (1.6) 6 (5.5)
X 5 Carcinoma in situ 9 (3.1) 1 (0.5) 8 (7.3)
X 6 Nunca 259 (88.1) 174 (94.1) 85 (78.0)
Procedimiento_Cervix NINGUNA 319 (64.6) 196 (77.2) 123 (51.2) <0.001
X 7 BIOPSIA 157 (31.8) 53 (20.9) 104 (43.3)
X 8 TRAT. ABLATIVO 6 (1.2) 0 (0.0) 6 (2.5)
X 9 CONIZACION 12 (2.4) 5 (2.0) 7 (2.9)
charls_cat <=2 200 (40.5) 117 (46.1) 83 (34.6) 0.008
X 10 3-4 189 (38.3) 95 (37.4) 94 (39.2)
X 11 >=5 105 (21.3) 42 (16.5) 63 (26.2) 
#write.xlsx(table2, "tabla_antc_jun_2025.xlsx", rowNames = TRUE)

Deteccion

colnames(BASE)[colnames(BASE) == "Estudios de extensión (choice=TC tórax)"] <- "TC TORAX"

colnames(BASE)[colnames(BASE) == "Estudios de extensión (choice=TC abdomen)"] <- "TC ABDOMEN"

colnames(BASE)[colnames(BASE) == "Estudios de extensión (choice=TC pelvis)"] <- "TC PELVIS"

colnames(BASE)[colnames(BASE) == "Estudios de extensión (choice=RMN pelvis)"] <- "RMN PELVIS"

colnames(BASE)[colnames(BASE) == "Estudios de extensión (choice=PET-CT)"] <- "PET-CT"

colnames(BASE)[colnames(BASE) == "Estudios de extensión (choice=Rayos X tórax)"] <- "RAYOS X TORAX"

colnames(BASE)[colnames(BASE) == "Estudios de extensión (choice=Laparoscopia exploratoria)"] <- "Laparoscopia exploratoria"

colnames(BASE)[colnames(BASE) == "Estudios de extensión (choice=Cistoscopia)"] <- "Cistoscopia"

colnames(BASE)[colnames(BASE) == "Estudios de extensión (choice=Ultrasonido transvaginal)"] <- "Ultrasonido transvaginal"

colnames(BASE)[colnames(BASE) == "Estudios de extensión (choice=Ultrasonido de renal y de vías urinarias)"] <- "Ultrasonido de renal y de vías urinaria"

colnames(BASE)[colnames(BASE) == "Estudios de extensión (choice=Otro ¿Cuál?)"] <- "Otro estudio de extension"


#names(BASE) 119:129
BASE <- BASE %>%
  mutate(across(c(119:129), ~ recode(., "Checked" = "Si", "Unchecked" = "No")))

myVars3<-c("ingreso", "Subtipo histológico", "Grado de diferenciación",  "TC TORAX", "TC ABDOMEN", "TC PELVIS", "RMN PELVIS", "PET-CT", "RAYOS X TORAX", "Laparoscopia exploratoria", "Cistoscopia","Ultrasonido transvaginal",  "Ultrasonido de renal y de vías urinaria","Otro estudio de extension")

catVars3<-c("ingreso", "Subtipo histológico", "Grado de diferenciación",  "TC TORAX", "TC ABDOMEN", "TC PELVIS", "RMN PELVIS", "PET-CT", "RAYOS X TORAX", "Laparoscopia exploratoria", "Cistoscopia","Ultrasonido transvaginal",  "Ultrasonido de renal y de vías urinaria","Otro estudio de extension")
    

tab3 <- CreateTableOne(vars = myVars3, factorVars= catVars3, strata = "Procedencia", data = BASE, includeNA = F, test = T, addOverall = T, testNonNormal = T)

table3 <- as.data.frame(print(tab3, showAllLevels= TRUE, printToggle = FALSE))
table3 <- table3[,c(-6)]

rownames(table3) <- gsub("\\.{3,}", "", rownames(table3))  # Quita 3 puntos

rownames(table3) <- gsub("\\.{1,}", " ", rownames(table3))  # Quita 1 puntos

kable(table3, format = "html", caption = "Deteccion - estudios de extension") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F,position = "center") %>%
  column_spec(1, bold = T, color = "white", background = "#FFB90F") %>%
  column_spec(2, border_left = T, background = "#FFFFE0")
Deteccion - estudios de extension
level Overall Colombia Guatemala p
n 494 254 240
ingreso sintomas 368 (74.5) 161 (63.4) 207 ( 86.2) <0.001
X tamizaje 126 (25.5) 93 (36.6) 33 ( 13.8)
Subtipo histológico Adenocarcinoma 59 (11.9) 22 ( 8.7) 37 ( 15.4) 0.025
X 1 Carcinoma adenoescamoso 2 ( 0.4) 0 ( 0.0) 2 ( 0.8)
X 2 Carcinoma escamocelular 429 (86.8) 228 (89.8) 201 ( 83.8)
X 3 Carcinoma neuroendocrino de células pequeñas 1 ( 0.2) 1 ( 0.4) 0 ( 0.0)
X 4 Otro, ¿Cuál? 3 ( 0.6) 3 ( 1.2) 0 ( 0.0)
Grado de diferenciación Bien diferenciado 112 (25.4) 59 (28.5) 53 ( 22.6) 0.271
X 5 Mal diferenciado o Indiferenciado 71 (16.1) 29 (14.0) 42 ( 17.9)
X 6 Moderadamente diferenciado 258 (58.5) 119 (57.5) 139 ( 59.4)
TC TORAX No 134 (27.1) 54 (21.3) 80 ( 33.3) 0.004
X 7 Si 360 (72.9) 200 (78.7) 160 ( 66.7)
TC ABDOMEN No 37 ( 7.5) 28 (11.0) 9 ( 3.8) 0.004
X 8 Si 457 (92.5) 226 (89.0) 231 ( 96.2)
TC PELVIS No 134 (27.1) 58 (22.8) 76 ( 31.7) 0.035
X 9 Si 360 (72.9) 196 (77.2) 164 ( 68.3)
RMN PELVIS No 353 (71.5) 187 (73.6) 166 ( 69.2) 0.319
X 10 Si 141 (28.5) 67 (26.4) 74 ( 30.8)
PET CT No 456 (92.3) 239 (94.1) 217 ( 90.4) 0.172
X 11 Si 38 ( 7.7) 15 ( 5.9) 23 ( 9.6)
RAYOS X TORAX No 394 (79.8) 192 (75.6) 202 ( 84.2) 0.024
X 12 Si 100 (20.2) 62 (24.4) 38 ( 15.8)
Laparoscopia exploratoria No 490 (99.2) 251 (98.8) 239 ( 99.6) 0.656
X 13 Si 4 ( 0.8) 3 ( 1.2) 1 ( 0.4)
Cistoscopia No 483 (97.8) 245 (96.5) 238 ( 99.2) 0.083
X 14 Si 11 ( 2.2) 9 ( 3.5) 2 ( 0.8)
Ultrasonido transvaginal No 397 (80.4) 174 (68.5) 223 ( 92.9) <0.001
X 15 Si 97 (19.6) 80 (31.5) 17 ( 7.1)
Ultrasonido de renal y de vías urinaria No 483 (97.8) 248 (97.6) 235 ( 97.9) 1.000
X 16 Si 11 ( 2.2) 6 ( 2.4) 5 ( 2.1)
Otro estudio de extension No 457 (92.5) 217 (85.4) 240 (100.0) <0.001
X 17 Si 37 ( 7.5) 37 (14.6) 0 ( 0.0) 
#write.xlsx(table3, "tabla_dx.xlsx", rowNames = TRUE)

Detallado estudio de extension

#if (!require("BiocManager", quietly = TRUE))
#    install.packages("BiocManager")
#BiocManager::install("limma")
library(limma)
library(UpSetR)

BASE_UPSET <- BASE %>% select(`TC TORAX`, `TC ABDOMEN`, `TC PELVIS`,  `RMN PELVIS`, `RAYOS X TORAX`,`PET-CT`,`Ultrasonido transvaginal`)

BASE_UPSET <- BASE_UPSET %>%
  mutate(across(c(1:7), ~ recode(., "Si" = 1, "No" = 0)))
BASE_UPSET<- as.data.frame(BASE_UPSET)

upset(BASE_UPSET, order.by = "freq", nsets = 9, nintersects = 25, matrix.color = "#2F4F4F",  main.bar.color = "#5F9EA0", sets.bar.color = "skyblue", mainbar.y.label = "Cuidado soporte",  sets.x.label = "Estudios de extension", point.size = 2, line.size = 0.5, number.angles = 0, group.by = "degree", shade.alpha = 1, matrix.dot.alpha = 1, scale.intersections = "identity", scale.sets = "identity", text.scale = 1, set_size.show = T)

Categorizando estudios de extensión

#estudios de extension; las tres al tiempo
BASE <- BASE %>%
  mutate(EST_PELVIS= ifelse(`TC PELVIS` == "Si" |`RMN PELVIS` == "Si" , "Si", "No"))

BASE <- BASE %>%
  mutate(Estudios_completo = ifelse((`TC TORAX` == "Si" & `TC ABDOMEN` == "Si" & EST_PELVIS == "Si") | `PET-CT` == "Si", "Si", "No"))

library(summarytools)
print(ctable(BASE$Estudios_completo, BASE$Procedencia, chisq = TRUE), method = "render")

Cross-Tabulation, Row Proportions

Estudios_completo * Procedencia

Data Frame: BASE
Procedencia
Estudios_completo Colombia Guatemala Total
No 82 ( 42.5% ) 111 ( 57.5% ) 193 ( 100.0% )
Si 172 ( 57.1% ) 129 ( 42.9% ) 301 ( 100.0% )
Total 254 ( 51.4% ) 240 ( 48.6% ) 494 ( 100.0% )
 Χ2 = 9.5335   df = 1   p = .0020

Generated by summarytools 1.1.4 (R version 4.4.2)
2025-09-15

Variables clinicas

BASE$`Tamaño tumoral clínico` <- factor(BASE$`Tamaño tumoral clínico`, levels=c("tumor microscópico", "≤ 2 cm", ">2 cm  - ≤ 4cm", ">4 cm"))

BASE$`Especialidad que realizó la primera consulta` <- ifelse(BASE$`Especialidad que realizó la primera consulta` %in% c("Cuidados Paliativos", "Oncología clínica", "Otra ¿Cuál?", "Radioterapia"), "Otra", BASE$`Especialidad que realizó la primera consulta`)

myVars4<-c("Especialidad que realizó la primera consulta","Diagnóstico CIE-10 registrado", "Tamaño tumoral clínico",  "EST_clin_FIGO", "ECOG")
    
catVars4<-c("Especialidad que realizó la primera consulta","Diagnóstico CIE-10 registrado", "Tamaño tumoral clínico", "EST_clin_FIGO", "ECOG")
    
tab4 <- CreateTableOne(vars = myVars4, factorVars= catVars4, strata = "Procedencia", data = BASE, includeNA = F, test = T, addOverall = T, testNonNormal = T)

table4 <- as.data.frame(print(tab4, showAllLevels= TRUE, printToggle = FALSE))
table4 <- table4[,c(-6)]

rownames(table4) <- gsub("\\.{3,}", "", rownames(table4))  # Quita 3 puntos
rownames(table4) <- gsub("\\.{1,}", " ", rownames(table4))  # Quita 1 puntos

kable(table4, format = "html", caption = "Variables clinicas") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F,position = "center") %>%
  column_spec(1, bold = T, color = "white", background = "blue") %>%
  column_spec(2, border_left = T, background = "#ADD8E6")
Variables clinicas
level Overall Colombia Guatemala p
n 494 254 240
Especialidad que realizó la primera consulta Ginecología Oncológica 399 (80.9) 200 (79.1) 199 (82.9) 0.328
X Otra 94 (19.1) 53 (20.9) 41 (17.1)
Diagnóstico CIE 10 registrado C530 Tumor maligno del endocérvix 91 (18.4) 50 (19.7) 41 (17.1) <0.001
X 1 C531 Tumor maligno del exocérvix 292 (59.1) 103 (40.6) 189 (78.8)
X 2 C539 Tumor maligno del cuello del útero, sin otra especificación 103 (20.9) 97 (38.2) 6 ( 2.5)
X 3 C55X Tumor maligno del útero, parte no especificada 8 ( 1.6) 4 ( 1.6) 4 ( 1.7)
Tamaño tumoral clínico tumor microscópico 5 ( 1.1) 5 ( 2.1) 0 ( 0.0) 0.001
X 4 ≤ 2 cm 2 ( 0.4) 2 ( 0.9) 0 ( 0.0)
X 5 >2 cm - ≤ 4cm 89 (18.8) 31 (13.3) 58 (24.2)
X 6 >4 cm 377 (79.7) 195 (83.7) 182 (75.8)
EST_clin_FIGO IB3,II,IIA 61 (12.3) 17 ( 6.7) 44 (18.3) <0.001
X 7 IIB, III, IIIA, IIIB, IIIC, IVA 433 (87.7) 237 (93.3) 196 (81.7)
ECOG ECOG0 181 (37.1) 147 (59.3) 34 (14.2) <0.001
X 8 ECOG1 240 (49.2) 92 (37.1) 148 (61.7)
X 9 ECOG2 63 (12.9) 9 ( 3.6) 54 (22.5)
X 10 ECOG3 4 ( 0.8) 0 ( 0.0) 4 ( 1.7) 
#write.xlsx(table4, "tabla_clinica.xlsx", rowNames = TRUE)

Tratamiento

colnames(BASE)[colnames(BASE) == "Tratamiento instaurado como primera línea  (si selecciona quimiorradiación no debe seleccionar ni terapia sistémica adyuvante ni radiación adyuvante) (choice=Quimio-radiación concomitante)"] <- "Quimio-radiación concomitante"

colnames(BASE)[colnames(BASE) == "Tratamiento instaurado como primera línea  (si selecciona quimiorradiación no debe seleccionar ni terapia sistémica adyuvante ni radiación adyuvante) (choice=Cirugía)"] <- "Cirugía"

colnames(BASE)[colnames(BASE) == "Tratamiento instaurado como primera línea  (si selecciona quimiorradiación no debe seleccionar ni terapia sistémica adyuvante ni radiación adyuvante) (choice=Terapia sistémica adyuvante)"] <- "Terapia sistémica adyuvante"

colnames(BASE)[colnames(BASE) =="Tratamiento instaurado como primera línea  (si selecciona quimiorradiación no debe seleccionar ni terapia sistémica adyuvante ni radiación adyuvante) (choice=Radiación adyuvante)"] <- "Radiación adyuvante"

colnames(BASE)[colnames(BASE) =="Tratamiento instaurado como primera línea  (si selecciona quimiorradiación no debe seleccionar ni terapia sistémica adyuvante ni radiación adyuvante) (choice=Cuidado de soporte)"] <- "Cuidado soporte"

colnames(BASE)[colnames(BASE) =="Tratamiento instaurado como primera línea  (si selecciona quimiorradiación no debe seleccionar ni terapia sistémica adyuvante ni radiación adyuvante) (choice=No recibió tratamiento)"] <- "No recibio tratamiento"


colnames(BASE)[colnames(BASE) =="Esquema de terapia sistémica en quimio-radiación concomitante (primera línea) (choice=Quimioterapia)"] <- "Esquema:Quimioterapia)"

colnames(BASE)[colnames(BASE) =="Esquema de terapia sistémica en quimio-radiación concomitante (primera línea) (choice=Terapias de blanco molecular)"] <- "Esquema:Terapias de blanco molecular)"


colnames(BASE)[colnames(BASE) =="Esquema de terapia sistémica en quimio-radiación concomitante (primera línea) (choice=Terapias de blanco molecular)"] <- "Esquema:Terapias de blanco molecular)"

colnames(BASE)[colnames(BASE) =="¿La terapia sistémica prescrita se administró en su totalidad? (Primera Línea)"] <- "Esquema completo t sistemica"

colnames(BASE)[colnames(BASE) =="¿Prescripción de Radioterapia Externa (Primera Línea)"] <- "Prescripcion radio externa"

colnames(BASE)[colnames(BASE) =="¿¿Completo en su totalidad el tratamiento por radioterapia externa?"] <- "Esquema completo radioterapia"

colnames(BASE)[colnames(BASE) =="¿Completo en su totalidad el tratamiento por radioterapia externa?"] <- "Esquema completo radioterapia"

colnames(BASE)[colnames(BASE) =="Prescripción de Braquiterapia"] <- "Prescripcion braquiterapia"

colnames(BASE)[colnames(BASE) =="¿Finalizo regimen de braquiterapia prescrito?"] <- "Esquema completo braquiterapia"

colnames(BASE)[colnames(BASE) =="Cirugía (choice=Histerectomía extrafascial)"] <- "Histerectomía extrafascial"

colnames(BASE)[colnames(BASE) =="Cirugía (choice=Histerectomía radical modificada)"] <- "Histerectomía radical modificada"
               
colnames(BASE)[colnames(BASE) =="Cirugía (choice=Histerectomía radical)"] <- "Histerectomía radical"

colnames(BASE)[colnames(BASE) =="Cirugía (choice=Salpingooforectomía bilateral)"] <- "Salpingooforectomía bilateral"

colnames(BASE)[colnames(BASE) =="Cirugía (choice=Linfadenectomía pélvica)"] <- "Linfadenectomía pélvica"

colnames(BASE)[colnames(BASE) =="Cirugía (choice=Otro)"] <- "Otra cirugia"

BASE$`Esquema completo t sistemica` <- factor(recode(BASE$`Esquema completo t sistemica`, "Desconocido" = "No"))

myVars5<-c("Quimio-radiación concomitante", "Cirugía", "Terapia sistémica adyuvante", "Radiación adyuvante", "Esquema:Quimioterapia)", "Esquema:Terapias de blanco molecular)",  "Esquema completo t sistemica", "Prescripcion radio externa", "Esquema completo radioterapia", "Prescripcion braquiterapia", "Intervalo entre Radioterapia Externa y Braquiterapia", "Prescripcion braquiterapia", "Esquema completo braquiterapia")
    
catVars5<-c("Quimio-radiación concomitante", "Cirugía", "Terapia sistémica adyuvante", "Radiación adyuvante", "Esquema:Quimioterapia)", "Esquema:Terapias de blanco molecular)",  "Esquema completo t sistemica", "Prescripcion radio externa", "Esquema completo radioterapia", "Prescripcion braquiterapia", "Prescripcion braquiterapia", "Esquema completo braquiterapia")

#names(BASE) 154, 155, 156, 157, 158, 159, 161, 162, 194, 195, 196, 197, 198, 199
BASE <- BASE %>%
  mutate(across(c(154, 155, 156, 157, 158, 159, 161, 162, 194, 195, 196, 197, 198, 199), ~ recode(., "Checked" = "Si", "Unchecked" = "No")))
    
    
tab5 <- CreateTableOne(vars = myVars5, factorVars= catVars5, strata = "Procedencia", data = BASE, includeNA = F, test = T, addOverall = T, testNonNormal = T)
table5 <- as.data.frame(print(tab5, showAllLevels= TRUE, printToggle = FALSE))
table5 <- table5[,c(-6)]

rownames(table5) <- gsub("\\.{3,}", "", rownames(table5))  # Quita 3 puntos

rownames(table5) <- gsub("\\.{1,}", " ", rownames(table5))  # Quita 1 puntos

kable(table5, format = "html", caption = "Tratamiento") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F,position = "center") %>%
  column_spec(1, bold = T, color = "white", background = "#8B475D") %>%
  column_spec(2, border_left = T, background = "#FFC0CB")
Tratamiento
level Overall Colombia Guatemala p
n 494 254 240
Quimio radiación concomitante No 19 ( 3.8) 15 ( 5.9) 4 ( 1.7) 0.027
X Si 475 (96.2) 239 (94.1) 236 ( 98.3)
Cirugía No 468 (94.7) 234 (92.1) 234 ( 97.5) 0.013
X 1 Si 26 ( 5.3) 20 ( 7.9) 6 ( 2.5)
Terapia sistémica adyuvante No 490 (99.2) 250 (98.4) 240 (100.0) 0.147
X 2 Si 4 ( 0.8) 4 ( 1.6) 0 ( 0.0)
Radiación adyuvante No 480 (97.2) 241 (94.9) 239 ( 99.6) 0.004
X 3 Si 14 ( 2.8) 13 ( 5.1) 1 ( 0.4)
Esquema Quimioterapia No 20 ( 4.0) 16 ( 6.3) 4 ( 1.7) 0.017
X 4 Si 474 (96.0) 238 (93.7) 236 ( 98.3)
Esquema Terapias de blanco molecular No 492 (99.6) 252 (99.2) 240 (100.0) 0.504
X 5 Si 2 ( 0.4) 2 ( 0.8) 0 ( 0.0)
Esquema completo t sistemica No 36 ( 7.5) 27 (11.1) 9 ( 3.8) 0.004
X 6 Si 443 (92.5) 216 (88.9) 227 ( 96.2)
Esquema completo radioterapia No 13 ( 2.7) 6 ( 2.4) 7 ( 3.0) 0.916
X 7 Si 473 (97.3) 244 (97.6) 229 ( 97.0)
Prescripcion braquiterapia No 52 (10.7) 10 ( 4.0) 42 ( 17.7) <0.001
X 8 Si 436 (89.3) 241 (96.0) 195 ( 82.3)
Intervalo entre Radioterapia Externa y Braquiterapia mean SD 20.76 (20.28) 21.52 (19.76) 19.84 (20.90) 0.392
Esquema completo braquiterapia No 18 ( 4.2) 10 ( 4.1) 8 ( 4.2) 1.000
X 9 Si 414 (95.8) 231 (95.9) 183 ( 95.8) 
#write.xlsx(table5, "tabla_tratamiento.xlsx", rowNames = TRUE)

Analisis tiempos

BASE$dif_quim_braq <- round(as.numeric(BASE$`Fecha de finalización de braquiterapia` - BASE$`Fecha de inicio de tratamiento sistémico (día de primera aplicación de terapia)`
) / 30, 3)
BASE2 <- BASE

colnames(BASE2)[colnames(BASE2) == "M_quim"] <- "Inicio_Fin_Quimio"
colnames(BASE2)[colnames(BASE2) == "M_quim0"] <- "Presc.Inicio_Quimio"
colnames(BASE2)[colnames(BASE2) == "M_rad0"] <- "Presc.Inicio_Radio"
colnames(BASE2)[colnames(BASE2) == "M_rad"] <- "Inicio_Fin_Radio"
colnames(BASE2)[colnames(BASE2) == "M_braq"] <- "Inicio_Fin_Braqui"
colnames(BASE2)[colnames(BASE2) == "M_braq0"] <- "Presc.Inicio_Braqui"


myVars6<-c("Presc.Inicio_Quimio", "Inicio_Fin_Quimio", "Presc.Inicio_Radio", "Inicio_Fin_Radio", "Inicio_Fin_Braqui", "Presc.Inicio_Braqui","dif_dx_primtrat", "dif_quim_braq", "Frecuencia del seguimiento imagenológico: Número de imágenes en el Primer Año", "Frecuencia de seguimiento por Oncología Clínica: Número de visitas en el Primer Año", "Frecuencia de seguimiento por Ginecología Oncológica: Número de visitas en el Primer Año")

tab6 <- CreateTableOne(vars = myVars6, strata = "Procedencia", data = BASE2, includeNA = F, test = T, addOverall = T, testNonNormal = T)

table6 <- as.data.frame(print(tab6, showAllLevels= TRUE, printToggle = FALSE))
table6 <- table6[,c(-6)]

rownames(table6) <- gsub("\\.{3,}", "", rownames(table6))  # Quita 3 puntos

rownames(table6) <- gsub("\\.{1,}", " ", rownames(table6))  # Quita 1 puntos

kable(table6, format = "html", caption = "Tiempo tratamientos") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F,position = "center") %>%
  column_spec(1, bold = T, color = "white", background = "#B03060")
Tiempo tratamientos
level Overall Colombia Guatemala p
n 494 254 240
Presc Inicio_Quimio (mean (SD)) 0.85 (1.81) 1.09 (2.47) 0.61 (0.61) 0.004
Inicio_Fin_Quimio (mean (SD)) 1.33 (2.44) 1.47 (2.42) 1.19 (2.47) 0.215
Presc Inicio_Radio (mean (SD)) 0.77 (0.62) 0.95 (0.60) 0.59 (0.59) <0.001
Inicio_Fin_Radio (mean (SD)) 1.45 (2.04) 1.44 (0.50) 1.46 (2.86) 0.942
Inicio_Fin_Braqui (mean (SD)) 0.55 (1.88) 0.64 (2.52) 0.44 (0.29) 0.264
Presc Inicio_Braqui (mean (SD)) 1.56 (1.23) 1.85 (1.39) 1.21 (0.89) <0.001
dif_dx_primtrat (mean (SD)) 3.03 (2.87) 3.40 (3.38) 2.64 (2.16) 0.003
dif_quim_braq (mean (SD)) 2.53 (2.03) 2.73 (2.64) 2.30 (0.85) 0.029
Frecuencia del seguimiento imagenológico: Número de imágenes en el Primer Año (mean (SD)) 1.66 (1.63) 2.45 (1.81) 0.84 (0.84) <0.001
Frecuencia de seguimiento por Oncología Clínica: Número de visitas en el Primer Año (mean (SD)) 3.33 (2.17) 3.30 (2.11) 3.72 (2.78) 0.428
Frecuencia de seguimiento por Ginecología Oncológica: Número de visitas en el Primer Año (mean (SD)) 3.02 (1.17) 2.58 (1.35) 3.46 (0.72) <0.001 
#write.xlsx(table6, "tabla_tiempo.xlsx", rowNames = TRUE)

Cuidado de soporte

colnames(BASE)[colnames(BASE) =="Cuidado de soporte (choice=Cuidados paliativos)"] <- "Cuidado paliativo"

colnames(BASE)[colnames(BASE) =="Cuidado de soporte (choice=Nutrición)"] <- "Nutricion"

colnames(BASE)[colnames(BASE) =="Cuidado de soporte (choice=Patología oral)"] <- "Patologia oral"

colnames(BASE)[colnames(BASE) =="Cuidado de soporte (choice=Psicología)"] <- "Psicologia"

colnames(BASE)[colnames(BASE) =="Cuidado de soporte (choice=Fertilidad/Sexualidad)"] <- "Fertilidad/sexualidad"

colnames(BASE)[colnames(BASE) =="Cuidado de soporte (choice=Otro, ¿Cuál?)"] <- "Otro cuidado de soporte"

colnames(BASE)[colnames(BASE) =="Cuidado de soporte (choice=Ninguno)"] <- "Ningun cuidado de soporte"

#names(BASE) 242, 243, 244, 245, 246, 247, 248
BASE <- BASE %>%
  mutate(across(c(242, 243, 244, 245, 246, 247, 248), ~ recode(., "Checked" = "Si", "Unchecked" = "No")))

myVars7<-c("Ningun cuidado de soporte", "Cuidado paliativo","Nutricion", "Patologia oral", "Psicologia", "Fertilidad/sexualidad", "Otro cuidado de soporte" )
    
catVars7<-c("Ningun cuidado de soporte", "Cuidado paliativo","Nutricion", "Patologia oral", "Psicologia", "Fertilidad/sexualidad", "Otro cuidado de soporte")
    
tab7 <- CreateTableOne(vars = myVars7, factorVars= catVars7, strata = "Procedencia", data = BASE, includeNA = F, test = T, addOverall = T, testNonNormal = T)
table7 <- as.data.frame(print(tab7, showAllLevels= TRUE, printToggle = FALSE))
table7 <- table7[,c(-6)]

rownames(table7) <- gsub("\\.{3,}", "", rownames(table7))  # Quita 3 puntos
rownames(table7) <- gsub("\\.{1,}", " ", rownames(table7))  # Quita 1 puntos

kable(table7, format = "html", caption = "Cuidado de soporte") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F,position = "center") %>%
  column_spec(1, bold = T, color = "white", background = "purple") %>%
  column_spec(2, border_left = T, background = "#CD96CD")
Cuidado de soporte
level Overall Colombia Guatemala p
n 494 254 240
Ningun cuidado de soporte No 216 (43.7) 186 (73.2) 30 (12.5) <0.001
X Si 278 (56.3) 68 (26.8) 210 (87.5)
Cuidado paliativo No 339 (68.6) 110 (43.3) 229 (95.4) <0.001
X 1 Si 155 (31.4) 144 (56.7) 11 ( 4.6)
Nutricion No 399 (80.8) 167 (65.7) 232 (96.7) <0.001
X 2 Si 95 (19.2) 87 (34.3) 8 ( 3.3)
Patologia oral No 426 (86.2) 187 (73.6) 239 (99.6) <0.001
X 3 Si 68 (13.8) 67 (26.4) 1 ( 0.4)
Psicologia No 422 (85.4) 186 (73.2) 236 (98.3) <0.001
X 4 Si 72 (14.6) 68 (26.8) 4 ( 1.7)
Fertilidad sexualidad No 489 (99.0) 253 (99.6) 236 (98.3) 0.336
X 5 Si 5 ( 1.0) 1 ( 0.4) 4 ( 1.7)
Otro cuidado de soporte No 463 (93.7) 225 (88.6) 238 (99.2) <0.001
X 6 Si 31 ( 6.3) 29 (11.4) 2 ( 0.8) 
#write.xlsx(table7, "tabla_cuidadosoporte_junio.xlsx", rowNames = TRUE)

Variables diagramas sankey

#1 Completitud del tratamiento Quimio + Radio + Braqui

BASE <- BASE %>%
mutate(trat_complete2 = ifelse(coalesce(`Esquema completo t sistemica`, "No") == "Si" & coalesce(`Esquema completo radioterapia`, "No") == "Si" & coalesce(`Esquema completo braquiterapia`, "No") == "Si", "+compl", "-compl"))

#2 Ingreso:sintomas o tamizaje
BASE$ingreso <- as.factor(BASE$ingreso)

#3 Atencion por ginecooncologia

BASE$gineco <- factor(ifelse(grepl("Ginecología Oncológica", BASE$`Especialidad que realizó la primera consulta`), "+gineco", "-gineco"))


#Tratamientos--------------------------------------------------------------

#Cirugia
BASE$cirugia <- factor(ifelse(!is.na(BASE$`Fecha de cirugía`), "+cir", "-cir"))

#Quimioterapia
BASE$quimio <- factor(ifelse(
!is.na(BASE$`Fecha de inicio de tratamiento sistémico (día de primera aplicación de terapia)`) | !is.na(BASE$`Fecha de aplicación de finalización de tratamiento sistémico`) | 
BASE$`Esquema completo t sistemica` == "Si", "+quim", "-quim"))
BASE$quimio[is.na(BASE$quimio)] <- "-quim"


#Radioterapia
BASE$radio <- factor(ifelse(
!is.na(BASE$`Fecha de inicio de radioterapia (primera sesión)`) | 
!is.na(BASE$`Fecha de finalización de radioterapia (última sesión)`) | 
BASE$`Esquema completo radioterapia` == "Si", "+rad", "-rad"))

BASE$radio <- as.character(BASE$radio)
BASE$radio[is.na(BASE$radio)] <- "-rad"
BASE$radio <- factor(BASE$radio)  

#Braquiterapia
BASE$braqu <- factor(ifelse(
!is.na(BASE$`Fecha de primera aplicación de braquiterapia`) |
!is.na(BASE$`Fecha de finalización de braquiterapia`) |
BASE$`Esquema completo braquiterapia` == "Si", "+braq", "-braq"))
BASE$braqu[is.na(BASE$braqu)] <- "-braq"
BASE <- BASE %>%
  mutate(retiro = ifelse(rowSums(across(c(`Motivo por el cuál no se completó la terapia sistémica (Primera Línea)`, `Causa de suspender tratamiento radioterapia`,                              `Causa de suspender braquiterapia`), ~ . == "Contraindicación médica"), 
na.rm = TRUE) > 0, "+cont.m", "-cont.m"))

BASE$rta1 <- factor(recode(BASE$`Respuesta a Primera Línea de Tratamiento`,
                           "Completa" = "+rta_trat",
                           "Parcial" = "+rta_trat",
                           "Sin dato" = "-rta_trat",
                           "Sin respuesta" = "-rta_trat"))

BASE$seg_onco_cli <- factor(recode(BASE$`Especialista de seguimiento (choice=Oncología clínica)`, "Checked" = "+seg_onco",
                            "Unchecked" = "-seg_onco"))

BASE$linea_2 <- factor(recode(BASE$`¿Recibió segunda línea de tratamiento?`,
                              "Yes" = "Si",
                              "No" = "No"))

BASE$linea_3 <- factor(recode(BASE$`Recibio tercera línea de tratamiento`,
                              "Yes" = "Si",
                              "No" = "No"))

BASE$fall <- factor(recode(BASE$`¿La pérdida en el seguimiento fue debido a fallecimiento?`,
                           "Yes" = "+fall",
                           "No" = "-fall",
                           "No data" = "-fall"))

BASE$fall[is.na(BASE$fall)] <- "-fall"

BASE$linea_2[is.na(BASE$linea_2)] <- "No"
BASE$linea_3[is.na(BASE$linea_3)] <- "No"
BASE$rta1[is.na(BASE$rta1)] <- "-rta_trat"


BASE$retiro <- as.factor(BASE$retiro)
BASE$retiro <- relevel(BASE$retiro, ref = "+cont.m")

Revisando frecuencias variables incluídas en el sankey

myVars11<-c("trat_complete2", "retiro", "rta1", "seg_onco_cli", "linea_2", "linea_3", "fall" )
    
catVars11<-c("trat_complete2", "retiro", "rta1", "seg_onco_cli", "linea_2", "linea_3", "fall" )
    
tab11 <- CreateTableOne(vars = myVars11, factorVars= catVars11, strata = "Procedencia", data = BASE, includeNA = F, test = T, addOverall = T, testNonNormal = T)
table11 <- as.data.frame(print(tab11, showAllLevels= TRUE, printToggle = FALSE))
table11 <- table11[,c(-6)]

rownames(table11) <- gsub("\\.{3,}", "", rownames(table11))  # Quita 3 puntos

rownames(table11) <- gsub("\\.{1,}", " ", rownames(table11))  # Quita 1 puntos

kable(table11, format = "html", caption = "Variables pos - 1 linea") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F,position = "center") %>%
  column_spec(1, bold = T, color = "white", background = "black") %>%
  column_spec(2, border_left = T, color = "white", background = "grey30")
Variables pos - 1 linea
level Overall Colombia Guatemala p
n 494 254 240
trat_complete2 -compl 114 (23.1) 52 (20.5) 62 (25.8) 0.191
X +compl 380 (76.9) 202 (79.5) 178 (74.2)
retiro +cont.m 34 ( 6.9) 31 (12.2) 3 ( 1.2) <0.001
X 1 -cont.m 460 (93.1) 223 (87.8) 237 (98.8)
rta1 -rta_trat 63 (12.8) 44 (17.3) 19 ( 7.9) 0.003
X 2 +rta_trat 431 (87.2) 210 (82.7) 221 (92.1)
seg_onco_cli -seg_onco 285 (57.7) 63 (24.8) 222 (92.5) <0.001
X 3 +seg_onco 209 (42.3) 191 (75.2) 18 ( 7.5)
linea_2 No 386 (78.1) 213 (83.9) 173 (72.1) 0.002
X 4 Si 108 (21.9) 41 (16.1) 67 (27.9)
linea_3 No 482 (97.6) 246 (96.9) 236 (98.3) 0.437
X 5 Si 12 ( 2.4) 8 ( 3.1) 4 ( 1.7)
fall -fall 405 (82.0) 228 (89.8) 177 (73.8) <0.001
X 6 +fall 89 (18.0) 26 (10.2) 63 (26.2) 
#write.xlsx(table11, "tabla_post1liena.xlsx", rowNames = TRUE)

Perfiles de tiempos por paciente

Se incluyen las variables de tiempo a analizar, se excluyen los datos que no tienen los datos completos

PROFILES <- BASE %>% select(ID_merge, Procedencia, dif_dx_primtrat, M_quim0, M_quim, M_rad0, M_rad, M_braq0, M_braq, dif_quim_braq)

colnames(PROFILES)[colnames(PROFILES) == "M_quim"]     <- "Inicio - fin quim"
colnames(PROFILES)[colnames(PROFILES) == "M_quim0"]    <- "Pres - Inicio quim"
colnames(PROFILES)[colnames(PROFILES) == "M_rad0"]     <- "Pres - Inicio rad"
colnames(PROFILES)[colnames(PROFILES) == "M_rad"]      <- "Inicio - Fin rad"
colnames(PROFILES)[colnames(PROFILES) == "M_braq0"]    <- "Pres - Inicio Braq"
colnames(PROFILES)[colnames(PROFILES) == "M_braq"]     <- "Inicio - Fin Braq"
colnames(PROFILES)[colnames(PROFILES) == "dif_dx_primtrat"] <- "Dx - Trat"
colnames(PROFILES)[colnames(PROFILES) == "dif_quim_braq"]   <- "Inicio quim - Fin braq"

PROFILES2 <- PROFILES %>% 
  filter(if_all(3:10, ~ !is.na(.)))

Se revisan cuantos posibles perfiles pueden existir

library(mclust)
library(factoextra)
p1.1<-Mclust(PROFILES2[,4:10])
fviz_mclust_bic(p1.1)

Se revisa por país, ya que puede ser dificil caracterizar los 7 grupos de pacientes.

Colombia

PROFILES2_COL <- PROFILES2 %>% filter(Procedencia == "Colombia")
PROFILES2_GUAT <- PROFILES2 %>% filter(Procedencia == "Guatemala")

p1_Col_2<-Mclust(PROFILES2_COL[,3:10])
fviz_mclust_bic(p1_Col_2)

Para Colombia hay 4 perfiles.

Estimado el modelo de Colombia

model_Col <- Mclust(PROFILES2_COL[,3:10], modelNames = "VVV", G = 4)
summary(model_Col)
## ---------------------------------------------------- 
## Gaussian finite mixture model fitted by EM algorithm 
## ---------------------------------------------------- 
## 
## Mclust VVV (ellipsoidal, varying volume, shape, and orientation) model with 4
## components: 
## 
##  log-likelihood   n  df       BIC       ICL
##       -811.7032 221 179 -2589.678 -2592.425
## 
## Clustering table:
##  1  2  3  4 
## 50 79 80 12

Graficando el modelo de Colombia

library(tibble)
library(tidyr)
means_Col <- data.frame(model_Col$parameters$mean) %>%
  rownames_to_column() %>%
  rename(PROFILES2_COL = rowname) %>%
  pivot_longer(cols = c(X1, X2, X3, X4), names_to = "Profile", values_to = "Mean") %>%
  mutate(
    Mean = round(Mean, 2)
  )


p_Col <- means_Col %>%
  mutate(Profile = recode(Profile, 
                          X1 = "Prof 1",
                          X2 = "Prof 2", 
                          X3 = "Prof 3", 
                          X4 = "Prof 4")) %>%
  ggplot(aes(PROFILES2_COL, Mean, group = Profile, color = Profile)) +
  geom_point(size = 2.25) +
  geom_line(size = 1.25) +
  scale_x_discrete(limits = c("Inicio - fin quim", "Pres - Inicio quim", "Pres - Inicio rad", "Inicio - Fin rad", "Pres - Inicio Braq", "Inicio - Fin Braq","Dx - Trat", "Inicio quim - Fin braq" )) +
  labs(x = "Diferencia momentos", y = "Promedio meses", title = "Perfiles Colombia") +
  theme_bw(base_size = 14) +
  theme(
    axis.text.x = element_text(angle = 90, hjust = 1, size = 10, face = "bold"),   # Letras eje X más grandes y en negrita
    axis.text.y = element_text(size = 14, face = "bold"),                         # Letras eje Y más grandes y en negrita
    axis.title.x = element_text(size = 16, face = "bold"),                       # Aumentar tamaño de la etiqueta del eje X
    axis.title.y = element_text(size = 16, face = "bold"),                       # Aumentar tamaño de la etiqueta del eje Y
    legend.position = "right", 
    legend.text = element_text(size = 10, face = "bold"),                        # Aumentar el tamaño de la leyenda y ponerla en negrita
    legend.title = element_text(size = 16, face = "bold")                       # Aumentar tamaño del título de la leyenda
  )
p_Col

Perfiles Guatemala

p1_Guat_2<-Mclust(PROFILES2_GUAT[,3:10])
fviz_mclust_bic(p1_Guat_2)

Se estima el modelo de Guatemala

model_Guat <- Mclust(PROFILES2_GUAT[,3:10], modelNames = "VVI", G = 7)
summary(model_Guat)
## ---------------------------------------------------- 
## Gaussian finite mixture model fitted by EM algorithm 
## ---------------------------------------------------- 
## 
## Mclust VVI (diagonal, varying volume and shape) model with 7 components: 
## 
##  log-likelihood   n  df       BIC       ICL
##       -527.3024 194 118 -1676.212 -1684.859
## 
## Clustering table:
##  1  2  3  4  5  6  7 
## 37  7 25 29 27 46 23

Se grafica el modelo de Guatemala

means_Guat <- data.frame(model_Guat$parameters$mean) %>%
  rownames_to_column() %>%
  rename(PROFILES2_GUAT = rowname) %>%
  pivot_longer(cols = c(X1, X2, X3, X4, X5, X6, X7), names_to = "Profile", values_to = "Mean") %>%
  mutate(
    Mean = round(Mean, 2)
  )

p_Guat <- means_Guat %>%
  mutate(Profile = recode(Profile, 
                          X1 = "Prof 1",
                          X2 = "Prof 2", 
                          X3 = "Prof 3", 
                          X4 = "Prof 4",
                          X5 = "Prof 5",
                          X6 = "Prof 6",
                          X7 = "Prof 7")) %>%
  ggplot(aes(PROFILES2_GUAT, Mean, group = Profile, color = Profile)) +
  geom_point(size = 2.25) +
  geom_line(size = 1.25) +
  scale_x_discrete(limits = c("Inicio - fin quim", "Pres - Inicio quim", "Pres - Inicio rad", "Inicio - Fin rad", "Pres - Inicio Braq", "Inicio - Fin Braq","Dx - Trat", "Inicio quim - Fin braq" )) +
  labs(x = "Diferencia momentos", y = "Promedio meses", title = "Perfiles Guatemala") +
  theme_bw(base_size = 14) +
  theme(
    axis.text.x = element_text(angle = 90, hjust = 1, size = 10, face = "bold"),   # Letras eje X más grandes y en negrita
    axis.text.y = element_text(size = 14, face = "bold"),                         # Letras eje Y más grandes y en negrita
    axis.title.x = element_text(size = 16, face = "bold"),                       # Aumentar tamaño de la etiqueta del eje X
    axis.title.y = element_text(size = 16, face = "bold"),                       # Aumentar tamaño de la etiqueta del eje Y
    legend.position = "right", 
    legend.text = element_text(size = 10, face = "bold"),                        # Aumentar el tamaño de la leyenda y ponerla en negrita
    legend.title = element_text(size = 16, face = "bold")                       # Aumentar tamaño del título de la leyenda
  )
p_Guat

Se asigna el grupo a la base de datos por país

clases_col <- model_Col$classification
clases_guat <- model_Guat$classification

# Agregar las clases al data frame por pais

PROFILES2_COL <- PROFILES2_COL %>%
  mutate(Perfil = clases_col)

PROFILES2_GUAT <- PROFILES2_GUAT %>%
  mutate(Perfil = clases_guat)

# Unir los data frame 

BASE_PERF_COL <- merge(PROFILES2_COL, BASE, by = "ID_merge", all.x = TRUE)
BASE_PERF_GUAT <- merge(PROFILES2_GUAT, BASE, by = "ID_merge", all.x = TRUE)

Identificando a los sujetos por perfil Colombia

Nombrando los perfiles por los promedios de tiempo

myVars8<-c("Pres - Inicio quim", "Inicio - fin quim", "Pres - Inicio rad", "Inicio - Fin rad", "Pres - Inicio Braq", "Inicio - Fin Braq","Dx - Trat", "Inicio quim - Fin braq")
    
tab8 <- CreateTableOne(vars = myVars8, strata = "Perfil", data = BASE_PERF_COL, includeNA = F, test = T, addOverall = T, testNonNormal = T)

table8 <- as.data.frame(print(tab8, showAllLevels= TRUE, printToggle = FALSE))
table8 <- table8[,c(-8)]

rownames(table8) <- gsub("\\.{3,}", "", rownames(table8))  # Quita 3 puntos

rownames(table8) <- gsub("\\.{1,}", " ", rownames(table8))  # Quita 1 puntos

kable(table8, format = "html", caption = "Promedio diferencia momentos - perfil Colombia") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F,position = "center") %>%
  column_spec(1, bold = T, color = "white", background = "black") %>%
  column_spec(2, border_left = T, background = "grey")
Promedio diferencia momentos - perfil Colombia
level Overall 1 2 3 4 p
n 221 50 79 80 12
Pres - Inicio quim (mean (SD)) 1.11 (2.55) 0.90 (0.57) 0.89 (0.46) 0.86 (0.46) 5.18 (10.30) <0.001
Inicio - fin quim (mean (SD)) 1.44 (2.48) 1.32 (0.57) 1.26 (0.19) 1.30 (0.28) 4.16 (10.58) 0.001
Pres - Inicio rad (mean (SD)) 0.93 (0.56) 0.94 (0.62) 0.95 (0.43) 0.88 (0.41) 1.06 (1.40) 0.664
Inicio - Fin rad (mean (SD)) 1.41 (0.40) 1.55 (0.49) 1.30 (0.15) 1.37 (0.26) 1.86 (1.04) <0.001
Pres - Inicio Braq (mean (SD)) 1.89 (1.40) 1.92 (1.40) 0.87 (0.56) 2.66 (0.52) 3.32 (3.54) <0.001
Inicio - Fin Braq (mean (SD)) 0.66 (2.61) 0.52 (0.36) 0.21 (0.11) 0.63 (0.23) 4.46 (10.88) <0.001
Dx - Trat (mean (SD)) 3.38 (3.47) 3.86 (3.41) 2.79 (1.12) 3.35 (2.30) 5.43 (11.57) 0.058
Inicio quim - Fin braq (mean (SD)) 2.73 (2.66) 2.90 (0.92) 2.32 (0.57) 2.41 (0.39) 6.91 (10.65) <0.001 
#write.xlsx(table8, "tabla_perfiles_col_tiempo.xlsx", rowNames = TRUE)

PERFIL 2: Pacientes con menores promedios de tiempo en la mayoría de momentos PERFIL 4: Pacientes con los mayores promedios de tiempo en la mayoria de momentos PERFIL 1: Pacientes “promedio” con mayores tiempos en el radoiterapia, desde el dx hasta el inicio del tratamiento y todo el tratamiento. Mayor variabilidad en los tiempos comparados con el perfil 3 PERFIL 3: Pacientes menores al promedio, excepto en los tiempos de braquiterapia (precripcion - inicio, inicio - fin), y con menor variabilidad en todos los tiempos comparado con el perfil 1.

Caracterizando perfiles de Colombia

myVars9<-c("Edad a la fecha de diagnóstico", "EDUCACION", "AFILIACION","N.de gestaciones",  "N. partos vaginales",  "charls_cat", "ingreso", "Grado de diferenciación",  "Estudios_completo", "Especialidad que realizó la primera consulta", "Tamaño tumoral clínico",  "EST_clin_FIGO", "ECOG", "Quimio-radiación concomitante", "Cirugía",  "Esquema completo t sistemica", "Esquema completo radioterapia", "Esquema completo braquiterapia", "Ningun cuidado de soporte", "Cuidado paliativo","Nutricion", "Patologia oral", "Psicologia", "trat_complete2", "retiro", "rta1", "trat_complete2", "seg_onco_cli", "linea_2", "linea_3", "fall" )
    
catVars9<-c("EDUCACION", "AFILIACION",  "charls_cat", "ingreso", "Grado de diferenciación", "Estudios_completo", "Especialidad que realizó la primera consulta", "Tamaño tumoral clínico", "EST_clin_FIGO", "ECOG","Quimio-radiación concomitante", "Cirugía", "Esquema completo t sistemica", "Esquema completo radioterapia", "Esquema completo braquiterapia", "Ningun cuidado de soporte", "Cuidado paliativo","Nutricion", "Patologia oral", "Psicologia",  "retiro", "rta1", "trat_complete2", "seg_onco_cli", "linea_2", "linea_3", "fall")
    
tab9 <- CreateTableOne(vars = myVars9, factorVars= catVars9, strata = "Perfil", data = BASE_PERF_COL, includeNA = F, test = T, addOverall = T, testNonNormal = T)
table9 <- as.data.frame(print(tab9, showAllLevels= TRUE, printToggle = FALSE))
table9 <- table9[,-8]
  
rownames(table9) <- gsub("\\.{3,}", "", rownames(table9))  # Quita 3 puntos

rownames(table9) <- gsub("\\.{1,}", " ", rownames(table9))  # Quita 1 puntos

kable(table9, format = "html", caption = "Caracterizacion perfiles Colombia") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F,position = "center") %>%
  column_spec(1, bold = T, color = "white", background = "black") %>%
  column_spec(2, border_left = T, color = "white", background = "grey40")
Caracterizacion perfiles Colombia
level Overall 1 2 3 4 p
n 221 50 79 80 12
Edad a la fecha de diagnóstico mean SD 50.65 (13.58) 51.54 (13.72) 49.81 (12.68) 50.58 (13.98) 53.00 (17.10) 0.833
EDUCACION Primaria < 37 (27.2) 5 (17.9) 10 ( 24.4) 17 (28.8) 5 ( 62.5) 0.001
X Secundaria + tecnico 77 (56.6) 18 (64.3) 31 ( 75.6) 26 (44.1) 2 ( 25.0)
X 1 Profesional + posgrado 22 (16.2) 5 (17.9) 0 ( 0.0) 16 (27.1) 1 ( 12.5)
AFILIACION Subsidiado/Público 120 (54.3) 26 (52.0) 74 ( 93.7) 13 (16.2) 7 ( 58.3) <0.001
X 2 Contributivo/Privado 101 (45.7) 24 (48.0) 5 ( 6.3) 67 (83.8) 5 ( 41.7)
N de gestaciones mean SD 3.63 (2.67) 3.22 (2.38) 4.30 (2.86) 3.11 (2.44) 4.33 (3.11) 0.017
charls_cat <=2 107 (48.4) 20 (40.0) 42 ( 53.2) 39 (48.8) 6 ( 50.0) 0.431
X 3 3-4 85 (38.5) 21 (42.0) 31 ( 39.2) 30 (37.5) 3 ( 25.0)
X 4 >=5 29 (13.1) 9 (18.0) 6 ( 7.6) 11 (13.8) 3 ( 25.0)
ingreso sintomas 141 (63.8) 33 (66.0) 57 ( 72.2) 44 (55.0) 7 ( 58.3) 0.149
X 5 tamizaje 80 (36.2) 17 (34.0) 22 ( 27.8) 36 (45.0) 5 ( 41.7)
Grado de diferenciación Bien diferenciado 52 (29.1) 14 (33.3) 23 ( 33.3) 12 (20.3) 3 ( 33.3) 0.282
X 6 Mal diferenciado o Indiferenciado 25 (14.0) 7 (16.7) 6 ( 8.7) 12 (20.3) 0 ( 0.0)
X 7 Moderadamente diferenciado 102 (57.0) 21 (50.0) 40 ( 58.0) 35 (59.3) 6 ( 66.7)
Estudios_completo No 69 (31.2) 14 (28.0) 27 ( 34.2) 26 (32.5) 2 ( 16.7) 0.613
X 8 Si 152 (68.8) 36 (72.0) 52 ( 65.8) 54 (67.5) 10 ( 83.3)
Especialidad que realizó la primera consulta Ginecología Oncológica 176 (80.0) 39 (78.0) 69 ( 87.3) 60 (75.9) 8 ( 66.7) 0.177
X 9 Otra 44 (20.0) 11 (22.0) 10 ( 12.7) 19 (24.1) 4 ( 33.3)
Tamaño tumoral clínico tumor microscópico 5 ( 2.4) 0 ( 0.0) 0 ( 0.0) 4 ( 5.5) 1 ( 8.3) 0.032
X 10 ≤ 2 cm 1 ( 0.5) 0 ( 0.0) 0 ( 0.0) 1 ( 1.4) 0 ( 0.0)
X 11 >2 cm - ≤ 4cm 23 (11.1) 6 (13.0) 3 ( 3.9) 11 (15.1) 3 ( 25.0)
X 12 >4 cm 179 (86.1) 40 (87.0) 74 ( 96.1) 57 (78.1) 8 ( 66.7)
EST_clin_FIGO IB3,II,IIA 14 ( 6.3) 2 ( 4.0) 4 ( 5.1) 7 ( 8.8) 1 ( 8.3) 0.673
X 13 IIB, III, IIIA, IIIB, IIIC, IVA 207 (93.7) 48 (96.0) 75 ( 94.9) 73 (91.2) 11 ( 91.7)
ECOG ECOG0 134 (62.0) 31 (63.3) 63 ( 84.0) 33 (41.2) 7 ( 58.3) <0.001
X 14 ECOG1 78 (36.1) 17 (34.7) 9 ( 12.0) 47 (58.8) 5 ( 41.7)
X 15 ECOG2 4 ( 1.9) 1 ( 2.0) 3 ( 4.0) 0 ( 0.0) 0 ( 0.0)
Quimio radiación concomitante No 3 ( 1.4) 2 ( 4.0) 0 ( 0.0) 1 ( 1.2) 0 ( 0.0) 0.276
X 16 Si 218 (98.6) 48 (96.0) 79 (100.0) 79 (98.8) 12 (100.0)
Cirugía No 206 (93.2) 46 (92.0) 79 (100.0) 71 (88.8) 10 ( 83.3) 0.017
X 17 Si 15 ( 6.8) 4 ( 8.0) 0 ( 0.0) 9 (11.2) 2 ( 16.7)
Esquema completo t sistemica No 22 (10.0) 6 (12.0) 4 ( 5.1) 9 (11.2) 3 ( 25.0) 0.137
X 18 Si 199 (90.0) 44 (88.0) 75 ( 94.9) 71 (88.8) 9 ( 75.0)
Esquema completo radioterapia No 4 ( 1.8) 1 ( 2.0) 1 ( 1.3) 2 ( 2.5) 0 ( 0.0) 0.902
X 19 Si 217 (98.2) 49 (98.0) 78 ( 98.7) 78 (97.5) 12 (100.0)
Esquema completo braquiterapia No 6 ( 2.7) 2 ( 4.0) 1 ( 1.3) 3 ( 3.8) 0 ( 0.0) 0.659
X 20 Si 215 (97.3) 48 (96.0) 78 ( 98.7) 77 (96.2) 12 (100.0)
Ningun cuidado de soporte No 163 (73.8) 32 (64.0) 51 ( 64.6) 74 (92.5) 6 ( 50.0) <0.001
X 21 Si 58 (26.2) 18 (36.0) 28 ( 35.4) 6 ( 7.5) 6 ( 50.0)
Cuidado paliativo No 94 (42.5) 23 (46.0) 45 ( 57.0) 17 (21.2) 9 ( 75.0) <0.001
X 22 Si 127 (57.5) 27 (54.0) 34 ( 43.0) 63 (78.8) 3 ( 25.0)
Nutricion No 145 (65.6) 39 (78.0) 48 ( 60.8) 48 (60.0) 10 ( 83.3) 0.072
X 23 Si 76 (34.4) 11 (22.0) 31 ( 39.2) 32 (40.0) 2 ( 16.7)
Patologia oral No 164 (74.2) 38 (76.0) 79 (100.0) 37 (46.2) 10 ( 83.3) <0.001
X 24 Si 57 (25.8) 12 (24.0) 0 ( 0.0) 43 (53.8) 2 ( 16.7)
Psicologia No 164 (74.2) 37 (74.0) 66 ( 83.5) 50 (62.5) 11 ( 91.7) 0.010
X 25 Si 57 (25.8) 13 (26.0) 13 ( 16.5) 30 (37.5) 1 ( 8.3)
trat_complete2 -compl 26 (11.8) 7 (14.0) 6 ( 7.6) 10 (12.5) 3 ( 25.0) 0.304
X 26 +compl 195 (88.2) 43 (86.0) 73 ( 92.4) 70 (87.5) 9 ( 75.0)
retiro +cont.m 20 ( 9.0) 6 (12.0) 3 ( 3.8) 8 (10.0) 3 ( 25.0) 0.073
X 27 -cont.m 201 (91.0) 44 (88.0) 76 ( 96.2) 72 (90.0) 9 ( 75.0)
rta1 -rta_trat 27 (12.2) 9 (18.0) 7 ( 8.9) 11 (13.8) 0 ( 0.0) 0.237
X 28 +rta_trat 194 (87.8) 41 (82.0) 72 ( 91.1) 69 (86.2) 12 (100.0)
seg_onco_cli -seg_onco 47 (21.3) 12 (24.0) 14 ( 17.7) 16 (20.0) 5 ( 41.7) 0.275
X 29 +seg_onco 174 (78.7) 38 (76.0) 65 ( 82.3) 64 (80.0) 7 ( 58.3)
linea_2 No 190 (86.0) 42 (84.0) 72 ( 91.1) 69 (86.2) 7 ( 58.3) 0.023
X 30 Si 31 (14.0) 8 (16.0) 7 ( 8.9) 11 (13.8) 5 ( 41.7)
linea_3 No 214 (96.8) 49 (98.0) 78 ( 98.7) 76 (95.0) 11 ( 91.7) 0.380
X 31 Si 7 ( 3.2) 1 ( 2.0) 1 ( 1.3) 4 ( 5.0) 1 ( 8.3)
fall -fall 201 (91.0) 42 (84.0) 72 ( 91.1) 76 (95.0) 11 ( 91.7) 0.209
X 32 +fall 20 ( 9.0) 8 (16.0) 7 ( 8.9) 4 ( 5.0) 1 ( 8.3) 
#write.xlsx(table9, "tabla_perfiles_col.xlsx", rowNames = TRUE)

Perfil 2 (menores tiempos), la mayoría de pacientes tienen una afiliación al sistema como subsidiado. Este perfil y el 4 (mayores tiempos) tuvieron un promedio similar y mayor a la muestra total en número de gestaciones. Este perfil tuvo la menor cantidad de citologías. El perfil el 72.2% fue detectado por sintomas (mayor entre los perfiles). Este perfil el 96% tuvieron un tamaño tumoral mayor a 4cm, fue el más alto entre los demás perfiles, además el 84% tuvo un ECOG de 0.

Perfil 3, mayoría de pacientes con educacion posgradual y afiliacion al sistema contributivo, además tuvieron la mayor cantidad de citología y pruebas moleculares de VPH. Este perfil tuvo el menor procetaje de mujeres con ningun procedimiento previo de cervix. La mayoría de pacientes su dx fue detectado por tamizaje (45%). El 59% tuvo un ECOG de 2. Tuvo el mayor porentaje de cuidado de soporte (92.5%) y sus especialidades.

En el perfil 4 (mayores tiempos), el 25% tuvi un índice de Charlson mayor o igual a 5 (el mayor entre los perfiles). En este perfil hubo un mayor porcentaje de cirugía. Menor procentaje de cuidado de de soporte (50%). 3 pacietes (25%) no culminaron el tratamiento por contraindicacion medica. A pesar de lo anterior, el 100% tuvo respuesta al tratamiento, pero el 41% de las pacientes tuvieron recaida ( recibieron segunda linea de tratamiento), patron no presentado en ningun otro perfil.

Perfil 1: Mayor cantida de ultrasonida vaginal (46%), hubo mayor porcentajde fallecimientos (16%)

Identificando a los sujetos por perfil Guatemala

Nombrando los perfiles por los promedios de tiempo

tab10 <- CreateTableOne(vars = myVars8, strata = "Perfil", data = BASE_PERF_GUAT, includeNA = F, test = T, addOverall = T, testNonNormal = T)

table10 <- as.data.frame(print(tab10, showAllLevels= TRUE, printToggle = FALSE))
table10 <- table10[,-11]

rownames(table10) <- gsub("\\.{3,}", "", rownames(table10))  # Quita 3 puntos

rownames(table10) <- gsub("\\.{1,}", " ", rownames(table10))  # Quita 1 puntos

kable(table10, format = "html", caption = "Promedio diferencia momentos - perfil Colombia") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F,position = "center") %>%
  column_spec(1, bold = T, color = "white", background = "black") %>%
  column_spec(2, border_left = T, background = "grey")
Promedio diferencia momentos - perfil Colombia
level Overall 1 2 3 4 5 6 7 p
n 194 37 7 25 29 27 46 23
Pres - Inicio quim (mean (SD)) 0.56 (0.57) 0.87 (0.72) 0.92 (0.68) 0.41 (0.19) 0.25 (0.24) 0.52 (0.21) 0.11 (0.07) 1.46 (0.24) <0.001
Inicio - fin quim (mean (SD)) 1.21 (2.72) 1.07 (0.45) 6.80 (14.06) 0.87 (0.20) 0.88 (0.25) 1.21 (0.08) 0.90 (0.10) 1.16 (0.14) <0.001
Pres - Inicio rad (mean (SD)) 0.55 (0.59) 0.99 (0.63) 1.44 (1.67) 0.43 (0.19) 0.24 (0.19) 0.43 (0.17) 0.13 (0.08) 1.09 (0.35) <0.001
Inicio - Fin rad (mean (SD)) 1.38 (2.64) 1.15 (0.35) 6.88 (13.66) 1.13 (0.05) 1.15 (0.08) 1.28 (0.11) 1.14 (0.07) 1.27 (0.11) <0.001
Pres - Inicio Braq (mean (SD)) 1.20 (0.89) 1.13 (0.99) 1.40 (2.27) 2.27 (0.47) 0.46 (0.23) 0.54 (0.29) 1.74 (0.22) 0.74 (0.19) <0.001
Inicio - Fin Braq (mean (SD)) 0.44 (0.29) 0.44 (0.21) 0.59 (0.28) 0.26 (0.11) 0.32 (0.14) 0.67 (0.26) 0.23 (0.08) 0.89 (0.32) <0.001
Dx - Trat (mean (SD)) 2.49 (2.15) 2.93 (1.54) 4.16 (1.67) 1.67 (0.61) 0.92 (0.42) 3.45 (3.33) 1.25 (0.79) 5.54 (1.25) <0.001
Inicio quim - Fin braq (mean (SD)) 2.30 (0.85) 2.40 (0.83) 4.54 (2.51) 2.16 (0.52) 1.84 (0.46) 2.61 (0.36) 1.89 (0.22) 2.61 (0.40) <0.001 
#write.xlsx(table10, "tabla_perfiles_GUAT_tiempo.xlsx", rowNames = TRUE)

La caracterización con 7 perfiles se complejiza.

PERFIL 2: Pacientes con mayores tiempo en la mayoría de momentos PERFIL 6: Pacientes con menores tiempos en la mayoría de momentos

Pendiente por caracterizar acorde a lo que el Dr. Murillo indique

Modelos multivariados base completa

Se toma como desenlace el fallecimiento

Analisis bi-variado

Se incluirán variables con un p valor igual o menor a 0.1

myVars12<-c("Procedencia", "Edad a la fecha de diagnóstico", "EDUCACION", "Estado civil",  "AFILIACION","tipo_residencia", "N.de gestaciones",  "N. partos vaginales", "Citologia", "P. molecular VPH", "Historia de lesiones premalignas", "Procedimiento_Cervix", "charls_cat", "ingreso", "Subtipo histológico", "Grado de diferenciación",  "Estudios_completo", "Tamaño tumoral clínico",  "EST_clin_FIGO", "ECOG", "Quimio-radiación concomitante", "Cirugía", "Esquema:Quimioterapia)",  "Esquema completo t sistemica", "Prescripcion radio externa", "Esquema completo radioterapia", "Prescripcion braquiterapia", "Prescripcion braquiterapia", "Esquema completo braquiterapia",  "M_quim", "M_quim0", "M_rad0", "M_rad", "M_braq", "M_braq0",  "dif_dx_primtrat", "dif_quim_braq", "Frecuencia del seguimiento imagenológico: Número de imágenes en el Primer Año", "Frecuencia de seguimiento por Oncología Clínica: Número de visitas en el Primer Año", "Frecuencia de seguimiento por Ginecología Oncológica: Número de visitas en el Primer Año",
"Ningun cuidado de soporte", "Cuidado paliativo","Nutricion", "Patologia oral", "Psicologia",  "trat_complete2", "retiro", "rta1", "seg_onco_cli", "linea_2", "linea_3" )
    
catVars12<-c("Procedencia", "EDUCACION", "Estado civil", "AFILIACION","tipo_residencia", "Citologia", "P. molecular VPH", "Historia de lesiones premalignas", "Conización cervical", "Crioterapia", "Procedimiento_Cervix", "charls_cat", "ingreso", "Subtipo histológico", "Grado de diferenciación",  "Estudios_completo", "Tamaño tumoral clínico", "EST_clin_FIGO", "ECOG","Quimio-radiación concomitante", "Cirugía", "Esquema:Quimioterapia)", "Esquema completo t sistemica", "Prescripcion radio externa", "Esquema completo radioterapia", "Prescripcion braquiterapia", "Prescripcion braquiterapia", "Esquema completo braquiterapia", "Ningun cuidado de soporte", "Cuidado paliativo","Nutricion", "Patologia oral", "Psicologia", "trat_complete2", "retiro", "rta1", "seg_onco_cli", "linea_2", "linea_3")
    
tab12 <- CreateTableOne(vars = myVars12, factorVars= catVars12, strata = "fall", data = BASE, includeNA = F, test = T, addOverall = T, testNonNormal = T)
table12 <- as.data.frame(print(tab12, showAllLevels= TRUE, printToggle = FALSE))
table12 <- table12[, c(-6)]

rownames(table12) <- gsub("\\.{3,}", "", rownames(table12))  # Quita 3 puntos

rownames(table12) <- gsub("\\.{1,}", " ", rownames(table12))  # Quita 1 puntos

kable(table12, format = "html", caption = "Caracterizacion fallecimiento") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F,position = "center") %>%
  column_spec(1, bold = T, color = "white", background = "black") %>%
  column_spec(2, border_left = T, color ="white", background = "grey40")
Caracterizacion fallecimiento
level Overall -fall +fall p
n 494 405 89
Procedencia Colombia 254 (51.4) 228 (56.3) 26 (29.2) <0.001
X Guatemala 240 (48.6) 177 (43.7) 63 (70.8)
Edad a la fecha de diagnóstico mean SD 51.25 (13.39) 51.25 (13.42) 51.27 (13.32) 0.990
EDUCACION Primaria < 144 (37.0) 111 (35.6) 33 (42.9) 0.145
X 1 Secundaria + tecnico 209 (53.7) 168 (53.8) 41 (53.2)
X 2 Profesional + posgrado 36 ( 9.3) 33 (10.6) 3 ( 3.9)
Estado civil Soltero 110 (24.4) 95 (26.0) 15 (17.6) 0.263
X 3 Casado o en pareja 254 (56.4) 201 (55.1) 53 (62.4)
X 4 Divorciado o viudo 86 (19.1) 69 (18.9) 17 (20.0)
AFILIACION Subsidiado/Público 197 (39.9) 174 (43.0) 23 (25.8) 0.004
X 5 Contributivo/Privado 297 (60.1) 231 (57.0) 66 (74.2)
N de gestaciones mean SD 3.73 (2.67) 3.81 (2.80) 3.40 (2.00) 0.198
Citologia No 373 (75.5) 298 (73.6) 75 (84.3) 0.047
X 6 Si 121 (24.5) 107 (26.4) 14 (15.7)
P molecular VPH No 485 (98.2) 398 (98.3) 87 (97.8) 1.000
X 7 Si 9 ( 1.8) 7 ( 1.7) 2 ( 2.2)
Historia de lesiones premalignas NIC 2 - 3 17 ( 5.8) 13 ( 5.5) 4 ( 7.0) 0.229
X 8 NIC 1 9 ( 3.1) 5 ( 2.1) 4 ( 7.0)
X 9 Carcinoma in situ 9 ( 3.1) 8 ( 3.4) 1 ( 1.8)
X 10 Nunca 259 (88.1) 211 (89.0) 48 (84.2)
Procedimiento_Cervix NINGUNA 319 (64.6) 254 (62.7) 65 (73.0) 0.001
X 11 BIOPSIA 157 (31.8) 137 (33.8) 20 (22.5)
X 12 TRAT. ABLATIVO 6 ( 1.2) 2 ( 0.5) 4 ( 4.5)
X 13 CONIZACION 12 ( 2.4) 12 ( 3.0) 0 ( 0.0)
charls_cat <=2 200 (40.5) 157 (38.8) 43 (48.3) 0.180
X 14 3-4 189 (38.3) 162 (40.0) 27 (30.3)
X 15 >=5 105 (21.3) 86 (21.2) 19 (21.3)
ingreso sintomas 368 (74.5) 294 (72.6) 74 (83.1) 0.053
X 16 tamizaje 126 (25.5) 111 (27.4) 15 (16.9)
Subtipo histológico Adenocarcinoma 59 (11.9) 51 (12.6) 8 ( 9.0) 0.675
X 17 Carcinoma adenoescamoso 2 ( 0.4) 2 ( 0.5) 0 ( 0.0)
X 18 Carcinoma escamocelular 429 (86.8) 348 (85.9) 81 (91.0)
X 19 Carcinoma neuroendocrino de células pequeñas 1 ( 0.2) 1 ( 0.2) 0 ( 0.0)
X 20 Otro, ¿Cuál? 3 ( 0.6) 3 ( 0.7) 0 ( 0.0)
Grado de diferenciación Bien diferenciado 112 (25.4) 90 (25.5) 22 (25.0) 0.992
X 21 Mal diferenciado o Indiferenciado 71 (16.1) 57 (16.1) 14 (15.9)
X 22 Moderadamente diferenciado 258 (58.5) 206 (58.4) 52 (59.1)
Estudios_completo No 193 (39.1) 159 (39.3) 34 (38.2) 0.948
X 23 Si 301 (60.9) 246 (60.7) 55 (61.8)
Tamaño tumoral clínico tumor microscópico 5 ( 1.1) 5 ( 1.3) 0 ( 0.0) 0.660
X 24 ≤ 2 cm 2 ( 0.4) 2 ( 0.5) 0 ( 0.0)
X 25 >2 cm - ≤ 4cm 89 (18.8) 73 (18.9) 16 (18.6)
X 26 >4 cm 377 (79.7) 307 (79.3) 70 (81.4)
EST_clin_FIGO IB3,II,IIA 61 (12.3) 55 (13.6) 6 ( 6.7) 0.110
X 27 IIB, III, IIIA, IIIB, IIIC, IVA 433 (87.7) 350 (86.4) 83 (93.3)
ECOG ECOG0 181 (37.1) 167 (41.8) 14 (15.9) <0.001
X 28 ECOG1 240 (49.2) 195 (48.8) 45 (51.1)
X 29 ECOG2 63 (12.9) 36 ( 9.0) 27 (30.7)
X 30 ECOG3 4 ( 0.8) 2 ( 0.5) 2 ( 2.3)
Quimio radiación concomitante No 19 ( 3.8) 16 ( 4.0) 3 ( 3.4) 1.000
X 31 Si 475 (96.2) 389 (96.0) 86 (96.6)
Cirugía No 468 (94.7) 381 (94.1) 87 (97.8) 0.252
X 32 Si 26 ( 5.3) 24 ( 5.9) 2 ( 2.2)
Esquema Quimioterapia No 20 ( 4.0) 17 ( 4.2) 3 ( 3.4) 0.951
X 33 Si 474 (96.0) 388 (95.8) 86 (96.6)
Esquema completo t sistemica No 36 ( 7.5) 28 ( 7.1) 8 ( 9.3) 0.640
X 34 Si 443 (92.5) 365 (92.9) 78 (90.7)
Esquema completo radioterapia No 13 ( 2.7) 6 ( 1.5) 7 ( 8.1) 0.002
X 35 Si 473 (97.3) 394 (98.5) 79 (91.9)
Prescripcion braquiterapia No 52 (10.7) 24 ( 6.0) 28 (32.2) <0.001
X 36 Si 436 (89.3) 377 (94.0) 59 (67.8)
Esquema completo braquiterapia No 18 ( 4.2) 12 ( 3.2) 6 (10.5) 0.026
X 37 Si 414 (95.8) 363 (96.8) 51 (89.5)
M_quim mean SD 1.33 (2.44) 1.36 (2.69) 1.15 (0.39) 0.476
M_quim0 mean SD 0.85 (1.81) 0.86 (1.98) 0.83 (0.62) 0.900
M_rad0 mean SD 0.77 (0.62) 0.76 (0.61) 0.83 (0.70) 0.318
M_rad mean SD 1.45 (2.04) 1.41 (1.87) 1.64 (2.68) 0.334
M_braq mean SD 0.55 (1.88) 0.55 (2.02) 0.54 (0.31) 0.979
M_braq0 mean SD 1.56 (1.23) 1.57 (1.20) 1.51 (1.41) 0.742
dif_dx_primtrat mean SD 3.03 (2.87) 2.99 (2.99) 3.24 (2.25) 0.459
dif_quim_braq mean SD 2.53 (2.03) 2.52 (2.16) 2.58 (0.71) 0.838
Frecuencia del seguimiento imagenológico Número de imágenes en el Primer Año mean SD 1.66 (1.63) 1.67 (1.65) 1.58 (1.56) 0.668
Frecuencia de seguimiento por Oncología Clínica Número de visitas en el Primer Año mean SD 3.33 (2.17) 3.24 (1.99) 4.00 (3.21) 0.102
Frecuencia de seguimiento por Ginecología Oncológica Número de visitas en el Primer Año mean SD 3.02 (1.17) 3.04 (1.15) 2.92 (1.25) 0.449
Ningun cuidado de soporte No 216 (43.7) 187 (46.2) 29 (32.6) 0.026
X 38 Si 278 (56.3) 218 (53.8) 60 (67.4)
Cuidado paliativo No 339 (68.6) 268 (66.2) 71 (79.8) 0.017
X 39 Si 155 (31.4) 137 (33.8) 18 (20.2)
Nutricion No 399 (80.8) 323 (79.8) 76 (85.4) 0.283
X 40 Si 95 (19.2) 82 (20.2) 13 (14.6)
Patologia oral No 426 (86.2) 348 (85.9) 78 (87.6) 0.799
X 41 Si 68 (13.8) 57 (14.1) 11 (12.4)
Psicologia No 422 (85.4) 343 (84.7) 79 (88.8) 0.412
X 42 Si 72 (14.6) 62 (15.3) 10 (11.2)
trat_complete2 -compl 114 (23.1) 74 (18.3) 40 (44.9) <0.001
X 43 +compl 380 (76.9) 331 (81.7) 49 (55.1)
retiro +cont.m 34 ( 6.9) 29 ( 7.2) 5 ( 5.6) 0.772
X 44 -cont.m 460 (93.1) 376 (92.8) 84 (94.4)
rta1 -rta_trat 63 (12.8) 38 ( 9.4) 25 (28.1) <0.001
X 45 +rta_trat 431 (87.2) 367 (90.6) 64 (71.9)
seg_onco_cli -seg_onco 285 (57.7) 221 (54.6) 64 (71.9) 0.004
X 46 +seg_onco 209 (42.3) 184 (45.4) 25 (28.1)
linea_2 No 386 (78.1) 353 (87.2) 33 (37.1) <0.001
X 47 Si 108 (21.9) 52 (12.8) 56 (62.9)
linea_3 No 482 (97.6) 398 (98.3) 84 (94.4) 0.075
X 48 Si 12 ( 2.4) 7 ( 1.7) 5 ( 5.6) 
#write.xlsx(table12, "tabla_fallecimiento.xlsx", rowNames = TRUE)

Regresion logistica

Se excluyo “esquema completo braqui” por no tener suficiente variabilidad

BASE$fall_reg <- ifelse(BASE$fall == "+fall", 1, 0)
m1 <- glm (fall_reg ~ Procedencia + AFILIACION +  Citologia + Procedimiento_Cervix +ingreso +  ECOG + `Esquema completo radioterapia` + `Prescripcion braquiterapia` + `Ningun cuidado de soporte` + `Cuidado paliativo` + trat_complete2 + rta1  + seg_onco_cli + linea_2, family = "binomial", data= BASE) 

m2 <- glm (fall_reg ~ ECOG + `Esquema completo radioterapia` + `Prescripcion braquiterapia` + linea_2, family = "binomial", data= BASE)

summary(m2)
## 
## Call:
## glm(formula = fall_reg ~ ECOG + `Esquema completo radioterapia` + 
##     `Prescripcion braquiterapia` + linea_2, family = "binomial", 
##     data = BASE)
## 
## Coefficients:
##                                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                        -0.5130     0.7258  -0.707  0.47975    
## ECOGECOG1                           0.5812     0.3695   1.573  0.11571    
## ECOGECOG2                           1.2199     0.4590   2.658  0.00786 ** 
## ECOGECOG3                           2.6172     1.2126   2.158  0.03090 *  
## `Esquema completo radioterapia`Si  -1.6453     0.6635  -2.480  0.01315 *  
## `Prescripcion braquiterapia`Si     -1.0725     0.4002  -2.680  0.00736 ** 
## linea_2Si                           2.4095     0.2962   8.136 4.08e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 448.26  on 479  degrees of freedom
## Residual deviance: 316.01  on 473  degrees of freedom
##   (14 observations deleted due to missingness)
## AIC: 330.01
## 
## Number of Fisher Scoring iterations: 5

Se seleccionaron las variables por su significancia estadistica

#install.packages("sjPlot")
library(sjPlot)
#install.packages("sjmisc")
library(sjmisc)
#install.packages("sjlabelled")
library(sjlabelled)

library(gtsummary)
tbl_regression(m2, exponentiate = TRUE, add_estimate_to_reference_rows=TRUE)  %>% add_global_p()
Characteristic OR 95% CI p-value
ECOG

0.021
    ECOG0 1.00 —
    ECOG1 1.79 0.88, 3.79
    ECOG2 3.39 1.39, 8.45
    ECOG3 13.7 0.96, 149
Esquema completo radioterapia

0.014
    No 1.00 —
    Si 0.19 0.05, 0.71
Prescripcion braquiterapia

0.007
    No 1.00 —
    Si 0.34 0.16, 0.75
linea_2

<0.001
    No 1.00 —
    Si 11.1 6.29, 20.2
Abbreviations: CI = Confidence Interval, OR = Odds Ratio 
library(performance)
check_model(m2)

library(ResourceSelection)
hoslem.test(m2$y, fitted(m2), g=10)
## 
##  Hosmer and Lemeshow goodness of fit (GOF) test
## 
## data:  m2$y, fitted(m2)
## X-squared = 4.5072, df = 3, p-value = 0.2116

Prueba de verosimilitud

library(lmtest)
lrtest(m1, m2)
## Likelihood ratio test
## 
## Model 1: fall_reg ~ Procedencia + AFILIACION + Citologia + Procedimiento_Cervix + 
##     ingreso + ECOG + `Esquema completo radioterapia` + `Prescripcion braquiterapia` + 
##     `Ningun cuidado de soporte` + `Cuidado paliativo` + trat_complete2 + 
##     rta1 + seg_onco_cli + linea_2
## Model 2: fall_reg ~ ECOG + `Esquema completo radioterapia` + `Prescripcion braquiterapia` + 
##     linea_2
##   #Df  LogLik  Df  Chisq Pr(>Chisq)
## 1  19 -151.22                      
## 2   7 -158.00 -12 13.568     0.3292

Arbol de clasificacion

Se prueban las variables significativas en el modelo bi-variado con un arbol de clasificacion,

  • Primero se particiona la base de datos en entrenamiento (60%) y de validacion (40%)
  • Se realiza un muestreo estratificado (por la variable desenlace)
#install.packages("caret")
library(caret)
set.seed(2025)

index <- createDataPartition(BASE$fall, p = 0.60, list = FALSE)

train_data <- BASE[index, ]   # 60% de los datos
test_data  <- BASE[-index, ]  # 40% restante


#install.packages("table1")
library(table1)
table1(  ~ fall , data = BASE, rowlabelhead = "Base Completa")
Base Completa Overall
(N=494)
fall
-fall 405 (82.0%)
+fall 89 (18.0%) 
table1(  ~ fall , data = train_data , rowlabelhead = "Base entrenamiento")
Base entrenamiento Overall
(N=297)
fall
-fall 243 (81.8%)
+fall 54 (18.2%) 
table1(  ~ fall , data = test_data, rowlabelhead = "Base validacion")
Base validacion Overall
(N=197)
fall
-fall 162 (82.2%)
+fall 35 (17.8%)

Teniendo en cuenta las particiones que hacen los arboles para las variables cuantitativas, se incluyen dichas variables, además de las variables categoricas con un p valor igual o menos a 0.1 en el analisis bivariado.

Arbol inicial

# Ver si hay nombres con un salto de línea real
grep("\n", names(train_data), value = TRUE)
## [1] "N. partos \nvaginales"
names(train_data) <- gsub("\n", " ", names(train_data))
# Limpiar espacios extra al inicio y final
names(train_data) <- trimws(names(train_data))
# Verificar
grep("partos", names(train_data), value = TRUE, ignore.case = TRUE)
## [1] "N. partos  vaginales"
library(rpart)
library(rpart.plot)

arbolcomp <- rpart(formula = fall ~ Procedencia + `Edad a la fecha de diagnóstico` + `Lugar de residencia` + EDUCACION +  GRUPO_ET + `Estado civil` + AFILIACION + TABAQUISMO + `N.de gestaciones` + `N. partos  vaginales`+ Citologia + `P. molecular VPH` + `Historia de lesiones premalignas` +  Procedimiento_Cervix + charls_cat + ingreso + `Grado de diferenciación` + Estudios_completo + `Especialidad que realizó la primera consulta` + `Tamaño tumoral clínico` +   EST_clin_FIGO + ECOG + `Quimio-radiación concomitante` + `Esquema completo t sistemica` + `Prescripción de Radioterapia Externa (Primera Línea)` + `Esquema completo radioterapia` + `Intervalo entre Radioterapia Externa y Braquiterapia` + `Prescripcion braquiterapia` +   `Esquema completo braquiterapia`+  M_quim +M_quim0 + M_rad0 + M_rad + M_braq + M_braq0 +  dif_dx_primtrat + dif_quim_braq + `Frecuencia del seguimiento imagenológico: Número de imágenes en el Primer Año` + `Frecuencia de seguimiento por Oncología Clínica: Número de visitas en el Primer Año` + `Frecuencia de seguimiento por Ginecología Oncológica: Número de visitas en el Primer Año` + `Ningun cuidado de soporte` + `Cuidado paliativo` + Nutricion+ `Patologia oral` + `Psicologia`+ `Fertilidad/sexualidad` + trat_complete2+ retiro + rta1+ seg_onco_cli +linea_2+ linea_3 + `Especialista de seguimiento (choice=Ginecología oncológica)`, data = train_data , parms = list(split = "gini"), method="class", cp= 0.008)

printcp(arbolcomp)
## 
## Classification tree:
## rpart(formula = fall ~ Procedencia + `Edad a la fecha de diagnóstico` + 
##     `Lugar de residencia` + EDUCACION + GRUPO_ET + `Estado civil` + 
##     AFILIACION + TABAQUISMO + `N.de gestaciones` + `N. partos  vaginales` + 
##     Citologia + `P. molecular VPH` + `Historia de lesiones premalignas` + 
##     Procedimiento_Cervix + charls_cat + ingreso + `Grado de diferenciación` + 
##     Estudios_completo + `Especialidad que realizó la primera consulta` + 
##     `Tamaño tumoral clínico` + EST_clin_FIGO + ECOG + `Quimio-radiación concomitante` + 
##     `Esquema completo t sistemica` + `Prescripción de Radioterapia Externa (Primera Línea)` + 
##     `Esquema completo radioterapia` + `Intervalo entre Radioterapia Externa y Braquiterapia` + 
##     `Prescripcion braquiterapia` + `Esquema completo braquiterapia` + 
##     M_quim + M_quim0 + M_rad0 + M_rad + M_braq + M_braq0 + dif_dx_primtrat + 
##     dif_quim_braq + `Frecuencia del seguimiento imagenológico: Número de imágenes en el Primer Año` + 
##     `Frecuencia de seguimiento por Oncología Clínica: Número de visitas en el Primer Año` + 
##     `Frecuencia de seguimiento por Ginecología Oncológica: Número de visitas en el Primer Año` + 
##     `Ningun cuidado de soporte` + `Cuidado paliativo` + Nutricion + 
##     `Patologia oral` + Psicologia + `Fertilidad/sexualidad` + 
##     trat_complete2 + retiro + rta1 + seg_onco_cli + linea_2 + 
##     linea_3 + `Especialista de seguimiento (choice=Ginecología oncológica)`, 
##     data = train_data, method = "class", parms = list(split = "gini"), 
##     cp = 0.008)
## 
## Variables actually used in tree construction:
## [1] Edad a la fecha de diagnóstico linea_2                       
## [3] M_quim0                        M_rad                         
## [5] N. partos  vaginales           seg_onco_cli                  
## 
## Root node error: 54/297 = 0.18182
## 
## n= 297 
## 
##         CP nsplit rel error  xerror    xstd
## 1 0.175926      0   1.00000 1.00000 0.12309
## 2 0.055556      2   0.64815 0.68519 0.10539
## 3 0.024691      3   0.59259 0.68519 0.10539
## 4 0.008000      6   0.51852 0.88889 0.11748

Las variables realmente usadas para el arbol fueron: Edad a la fecha de diagnóstico, el haber recibido segunda linea, tiempo entre prescripcion e inicio de quimioterapia, (M_quim0), tiempo de inicio y fin de radio (M_rad), número de partos vaginales (N. partos vaginales) y el haber tenido seguimiento por oncologia clinica (seg_onco_cli).

#install.packages("rattle")
library(rattle)
rpart.plot(
  arbolcomp, 
  extra = 104,        # muestra counts, prob, etc.
  under = TRUE,       # pone las categorías debajo
  faclen = 0,         # no acorta nombres
  cex = 0.7, 
  tweak = 1.3,
  space = 0.8         # aumenta espacio entre título y divisiones
)

fancyRpartPlot(
  arbolcomp,
  sub = "Árbol Inicial",
  cex = 0.5,
  tweak = 1.3,
  palettes = c("Blues", "Greens"),
  main = "Árbol de Clasificación",
  cex.main = 1.4  # cambia tamaño del título principal
)

Extraer las tablas de decision (brinda la misma información que el arbol pero en tabla)

Se verifica la importancia de las variables

library(ggplot2)

# Pasar a data.frame
imp <- data.frame(
  Variable = names(arbolcomp$variable.importance),
  Importancia = arbolcomp$variable.importance
)

# Ordenar por importancia
imp <- imp[order(imp$Importancia, decreasing = TRUE), ]

# Gráfico
ggplot(imp, aes(x = reorder(Variable, Importancia), y = Importancia)) +
  geom_col(fill = "steelblue") +
  coord_flip() +  # para que quede horizontal
  labs(title = "Importancia de las variables en el Árbol de Decisión",
       x = "Variables",
       y = "Importancia") +
  theme_minimal(base_size = 14)

cp <- arbolcomp$cptable[which.min(arbolcomp$cptable[,"xerror"]),"CP"]
plotcp(arbolcomp)

El grafico muestra la busqueda del valor minimo del error de validación cruzada (xerror). Extrae el parámetro de complejidad (CP) asociado a ese mínimo. Con 7 nodos es lo máximo con lo que arbol “funciona” (una complejidad de 7 nodos)

Se procede a podar el arbol

arbolpod <- prune(arbolcomp, cp=cp)
fancyRpartPlot(arbolpod, sub='Árbol Podado')

Al podar el arbol (disminuir posile sobreajuste), se eliminan porpiamente las ramas (mas que las variables).

Se revisa el desempeño del modelo sin poda y con poda

#install.packages("rpart.plot")
library(rpart.plot)
library(caret)

Arbol podado

Muestra de entrenamiento

names(test_data) <- gsub("\n", " ", names(test_data))
pred_pod <- predict(arbolpod , newdata = train_data, type="class")
confusionMatrix(pred_pod, train_data$fall, positive="+fall")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction -fall +fall
##      -fall   231    23
##      +fall    12    31
##                                           
##                Accuracy : 0.8822          
##                  95% CI : (0.8399, 0.9165)
##     No Information Rate : 0.8182          
##     P-Value [Acc > NIR] : 0.001786        
##                                           
##                   Kappa : 0.5698          
##                                           
##  Mcnemar's Test P-Value : 0.090969        
##                                           
##             Sensitivity : 0.5741          
##             Specificity : 0.9506          
##          Pos Pred Value : 0.7209          
##          Neg Pred Value : 0.9094          
##              Prevalence : 0.1818          
##          Detection Rate : 0.1044          
##    Detection Prevalence : 0.1448          
##       Balanced Accuracy : 0.7623          
##                                           
##        'Positive' Class : +fall           
##

Muestra de validacion

pred_pod_test <- predict(arbolpod , newdata = test_data, type="class")
confusionMatrix(pred_pod_test, test_data$fall, positive="+fall")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction -fall +fall
##      -fall   148    21
##      +fall    14    14
##                                          
##                Accuracy : 0.8223         
##                  95% CI : (0.7617, 0.873)
##     No Information Rate : 0.8223         
##     P-Value [Acc > NIR] : 0.5450         
##                                          
##                   Kappa : 0.3403         
##                                          
##  Mcnemar's Test P-Value : 0.3105         
##                                          
##             Sensitivity : 0.40000        
##             Specificity : 0.91358        
##          Pos Pred Value : 0.50000        
##          Neg Pred Value : 0.87574        
##              Prevalence : 0.17766        
##          Detection Rate : 0.07107        
##    Detection Prevalence : 0.14213        
##       Balanced Accuracy : 0.65679        
##                                          
##        'Positive' Class : +fall          
##