Analisis exploratorio de la base recibida
library(readxl)
library(summarytools)
BASE <- read_excel("Sivico 2018 a 2025.xls",
sheet = "SIVICO 2018-2025")
print(dfSummary(BASE), method = 'render')
- Primero se asigna una columna donde se encuentre el ID de cada
paciente
- Luego se revisa que pacientes tienen una edad mayor a 100 puesto que
en el análisis exploratorio salío que la edad máxima fue 800 años.
BASE$ID<- 1:nrow(BASE)
library(dplyr)
BASE_edad <- BASE %>% filter(Edad > 100)
BASE_edad$ID
## [1] 1172 9034 24814
Revisar los ID 1172, 9034 y 24814 que tienen edades mayores a 100
años.
Tabla 1 (cuidado con variable edad)
Se extrae en una columna en año de procedimiento
library(lubridate)
BASE$ANO_PROC <- year(BASE$`Fecha Proc`)
#dput(names(BASE))
myVars <- c("Sexo", "Edad", "ANO_PROC", "Procedimiento", "Remisión", "Tipo", "Foto", "Preparación", "Tiempo Retiro del equipo", "Riesgo", "Polipectomia", "Adenomas 3 o mas", "Adenocarci")
catVars <- c("Sexo", "ANO_PROC","Procedimiento", "Remisión", "Tipo", "Foto", "Preparación", "Riesgo", "Polipectomia", "Adenomas 3 o mas", "Adenocarci")
library(tableone)
tab <- CreateTableOne(vars = myVars, factorVars= catVars, data = BASE, includeNA = F, addOverall = T, testNonNormal = T)
table1 <- as.data.frame(print(tab, showAllLevels= TRUE, printToggle = FALSE, noSpaces = TRUE))
limpiar_nombres <- function(nombres) {
nombres %>%
gsub("\\(X.*?\\)", "", .) %>% # Quitar (X%)
gsub("X", "", .) %>% # Quitar X sueltas
gsub("\\.{1,}", " ", .) %>% # Puntos a espacios
gsub("\\s+", " ", .) %>% # Múltiples espacios a uno
trimws(.) # Quitar espacios inicio/final
}
rownames(table1) <- limpiar_nombres(rownames(table1))
library(openxlsx)
write.xlsx(table1, "tabla1.xlsx", rowNames = TRUE, colnames = TRUE )
library(tibble)
library(reactable)
tabla_reactable <- table1 %>%
rownames_to_column("Variable") %>%
reactable(
pagination = FALSE,
defaultPageSize = nrow(table1), # Alternativa: especificar número exacto de filas
columns = list(
Variable = colDef(
style = list(backgroundColor = "#2C3E50", color = "white", fontWeight = "bold"),
width = 180, # Un poco más angosta
align = "left"
)
),
theme = reactableTheme(
headerStyle = list(
backgroundColor = "#34495E",
color = "white",
fontWeight = "bold",
fontSize = "13px"
),
cellStyle = list(fontSize = "11px"), # Texto más pequeño para que quepa mejor
stripedColor = "#F8F9FA"
),
striped = TRUE,
highlight = TRUE,
bordered = TRUE,
compact = TRUE,
wrap = FALSE, # No envolver texto
resizable = TRUE # Columnas redimensionables
)
tabla_reactable
Taza de deteccion de adenomas por año
Tomar las variables: Adenomas 3 o mas & Adenocarci (S) y
dividirlo por el total de pacientes con TCC
Se crea primero la taza de adenomas
library(dplyr)
library(ggplot2)
# Filtramos solo TCC
BASETCC <- BASE %>% filter(Tipo== "TCC")
# Tasa global
tasa_global <- (sum(BASETCC$`Adenomas 3 o mas` == "S" | BASETCC$Adenocarci == "S", na.rm = TRUE) / nrow(BASETCC)) *100
# Tasa por año
tasa_por_anio <- BASETCC %>%
group_by(ANO_PROC) %>%
summarise(
num_casos = sum(`Adenomas 3 o mas` == "S" | Adenocarci == "S", na.rm = TRUE),
total_TCC = n(),
tasa = round((num_casos / total_TCC)*100,2)
)
# Crear resumen de datos (promedio por año)
tu_dataframe_resumen <- tasa_por_anio %>%
group_by(ANO_PROC) %>%
summarise(tasa_promedio = mean(tasa))
# Crear el diagrama de barras con estética mejorada
ggplot(tu_dataframe_resumen, aes(x = factor(ANO_PROC), y = tasa_promedio, fill = tasa_promedio)) +
geom_bar(stat = "identity", width = 0.8, color = "white", size = 0.5) +
geom_text(aes(label = paste0(round(tasa_promedio, 2), "%")),
vjust = -0.5, size = 3.2, color = "black") +
labs(
title = "Tasa de Detección por Año",
x = "Año",
y = "Tasa de Detección (%)"
) +
scale_fill_gradient(low = "lightskyblue1", high = "darkblue",
name = "Tasa (%)",
guide = guide_colorbar(barwidth = 1, barheight = 6)) +
scale_y_continuous(limits = c(0, max(tu_dataframe_resumen$tasa_promedio) * 1.15),
expand = c(0, 0)) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 18, face = "bold",
margin = margin(b = 20)),
axis.title.x = element_text(size = 14, face = "bold", margin = margin(t = 15)),
axis.title.y = element_text(size = 14, face = "bold", margin = margin(r = 15)),
axis.text.x = element_text(size = 12, face = "bold", color = "black"),
axis.text.y = element_text(size = 12, color = "black"),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
legend.title = element_text(size = 12),
legend.text = element_text(size = 8)
)

tasa_por_anio2 <- BASETCC %>%
group_by(ANO_PROC, Sexo) %>%
summarise(
num_casos = sum(`Adenomas 3 o mas` == "S" | Adenocarci == "S", na.rm = TRUE),
total_TCC = n(),
tasa = round((num_casos / total_TCC)*100,2)
)
tu_dataframe_resumen2 <- tasa_por_anio2 %>%
group_by(ANO_PROC, Sexo) %>%
summarise(tasa_promedio = mean(tasa))
# Crear el diagrama de barras con estética mejorada por sexo
ggplot(tu_dataframe_resumen2, aes(x = factor(ANO_PROC), y = tasa_promedio, fill = Sexo)) +
geom_bar(stat = "identity", position = "dodge", width = 0.8, color = "white", size = 0.5) +
geom_text(aes(label = paste0(round(tasa_promedio, 1), "%")),
position = position_dodge(width = 0.8), vjust = -0.5, size = 3, color = "black") +
labs(
title = "Tasa de Detección por Año y Sexo",
x = "Año",
y = "Tasa de Detección (%)",
fill = "Sexo"
) +
scale_fill_manual(values = c("F" = "darkorange1", "M" = "darkolivegreen4")) +
# Alternativamente, si prefieres tonos azules para ambos:
# scale_fill_manual(values = c("F" = "#87CEEB", "M" = "#1565C0")) +
scale_y_continuous(limits = c(0, max(tu_dataframe_resumen2$tasa_promedio) * 1.15),
expand = c(0, 0)) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 18, face = "bold",
margin = margin(b = 20)),
axis.title.x = element_text(size = 14, face = "bold", margin = margin(t = 15)),
axis.title.y = element_text(size = 14, face = "bold", margin = margin(r = 15)),
axis.text.x = element_text(size = 12, face = "bold", color = "black"),
axis.text.y = element_text(size = 12, color = "black"),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
legend.title = element_text(size = 12, face = "bold"),
legend.text = element_text(size = 10),
legend.position = "top"
)

Colonoscopia
Colonoscopia <- BASE %>%
group_by(ANO_PROC) %>%
summarise(
total_procedimientos = n(),
total_colono = sum(Procedimiento == "Colonoscopia Total", na.rm = TRUE),
porcentaje_colono = (total_colono / total_procedimientos) * 100,
.groups = "drop"
)
# Crear el diagrama de barras con estética mejorada
ggplot(Colonoscopia, aes(x = factor(ANO_PROC), y = porcentaje_colono, fill = porcentaje_colono)) +
geom_bar(stat = "identity", width = 0.8, color = "white", size = 0.5) +
geom_text(aes(label = paste0(round(porcentaje_colono, 2), "%")),
vjust = -0.5, size = 3.2, color = "black") +
labs(
title = "Porcentaje colonoscopia por Año",
x = "Año",
y = "Colonoscopias (%)"
) +
scale_fill_gradient(low = "lightskyblue1", high = "darkblue",
name = "Porcentaje",
guide = guide_colorbar(barwidth = 1, barheight = 6)) +
scale_y_continuous(limits = c(0, max(Colonoscopia$porcentaje_colono) * 1.15),
expand = c(0, 0)) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 18, face = "bold",
margin = margin(b = 20)),
axis.title.x = element_text(size = 14, face = "bold", margin = margin(t = 15)),
axis.title.y = element_text(size = 14, face = "bold", margin = margin(r = 15)),
axis.text.x = element_text(size = 12, face = "bold", color = "black"),
axis.text.y = element_text(size = 12, color = "black"),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
legend.title = element_text(size = 12),
legend.text = element_text(size = 8)
)

Segreado por remitidos y auto-remitidos
Colonoscopia2 <- BASE %>%
group_by(ANO_PROC, Remisión) %>%
summarise(
total_procedimientos = n(),
total_colono = sum(Procedimiento == "Colonoscopia Total", na.rm = TRUE),
porcentaje_colono = (total_colono / total_procedimientos) * 100,
.groups = "drop"
)
ggplot(Colonoscopia2, aes(x = factor(ANO_PROC), y = porcentaje_colono, fill = Remisión)) +
geom_bar(stat = "identity", position = "dodge", width = 0.8, color = "white", size = 0.5) +
geom_text(aes(label = paste0(round(porcentaje_colono, 1), "%")),
position = position_dodge(width = 0.8), vjust = -0.5, size = 2.8, color = "black") +
labs(
title = "Porcentaje colonoscopias por año y por tipo de remisión",
x = "Año",
y = "Colonoscopias (%)",
fill = "Remisión"
) +
scale_fill_manual(values = c("AutoRemitido" = "darkorange1", "Remitido" = "darkolivegreen4")) +
# Alternativamente, si prefieres tonos azules para ambos:
# scale_fill_manual(values = c("F" = "#87CEEB", "M" = "#1565C0")) +
scale_y_continuous(limits = c(0, max(Colonoscopia2$porcentaje_colono) * 1.15),
expand = c(0, 0)) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold",
margin = margin(b = 20)),
axis.title.x = element_text(size = 14, face = "bold", margin = margin(t = 15)),
axis.title.y = element_text(size = 14, face = "bold", margin = margin(r = 15)),
axis.text.x = element_text(size = 12, face = "bold", color = "black"),
axis.text.y = element_text(size = 12, color = "black"),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
legend.title = element_text(size = 12, face = "bold"),
legend.text = element_text(size = 10),
legend.position = "bottom"
)

Fotodocuemntación
Colonoscopia3 <- BASE %>% filter(Procedimiento == "Colonoscopia Total")
# Tasa por año
tasa_foto <- Colonoscopia3 %>%
group_by(ANO_PROC) %>%
summarise(
num_casos = sum(Foto == "S", na.rm = TRUE),
total_Col = n(),
tasa = round((num_casos / total_Col)*100,2)
)
ggplot(tasa_foto, aes(x = factor(ANO_PROC), y = tasa, fill = tasa)) +
geom_bar(stat = "identity", width = 0.8, color = "white", size = 0.5) +
geom_text(aes(label = paste0(round(tasa, 2), "%")),
vjust = -0.5, size = 3.2, color = "black") +
labs(
title = "Tasa Colonoscopia con fotodoc./ Colonoscopias",
x = "Año",
y = "Porcentaje"
) +
scale_fill_gradient(low = "lightskyblue1", high = "darkblue",
name = "Porcentaje",
guide = guide_colorbar(barwidth = 1, barheight = 6)) +
scale_y_continuous(limits = c(0, max(tasa_foto$tasa) * 1.15),
expand = c(0, 0)) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 18, face = "bold",
margin = margin(b = 20)),
axis.title.x = element_text(size = 14, face = "bold", margin = margin(t = 15)),
axis.title.y = element_text(size = 14, face = "bold", margin = margin(r = 15)),
axis.text.x = element_text(size = 12, face = "bold", color = "black"),
axis.text.y = element_text(size = 12, color = "black"),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
legend.title = element_text(size = 12),
legend.text = element_text(size = 8)
)

Fotodocuemntación para pacientes con tamización
BASETCC <- BASE %>% filter(Tipo== "TCC")
Colonoscopia4 <- BASETCC %>% filter(Procedimiento == "Colonoscopia Total")
# Tasa por año
tasa_foto2 <- Colonoscopia4 %>%
group_by(ANO_PROC) %>%
summarise(
num_casos = sum(Foto == "S", na.rm = TRUE),
total_TCC = n(),
tasa = round((num_casos / total_TCC)*100,2)
)
ggplot(tasa_foto2, aes(x = factor(ANO_PROC), y = tasa, fill = tasa)) +
geom_bar(stat = "identity", width = 0.8, color = "white", size = 0.5) +
geom_text(aes(label = paste0(round(tasa, 2), "%")),
vjust = -0.5, size = 3.2, color = "black") +
labs(
title = "Tasa Colonoscopia con fotodoc./ Colonoscopias TCC",
x = "Año",
y = "Porcentaje"
) +
scale_fill_gradient(low = "lightskyblue1", high = "darkblue",
name = "Porcentaje",
guide = guide_colorbar(barwidth = 1, barheight = 6)) +
scale_y_continuous(limits = c(0, max(tasa_foto$tasa) * 1.15),
expand = c(0, 0)) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 18, face = "bold",
margin = margin(b = 20)),
axis.title.x = element_text(size = 14, face = "bold", margin = margin(t = 15)),
axis.title.y = element_text(size = 14, face = "bold", margin = margin(r = 15)),
axis.text.x = element_text(size = 12, face = "bold", color = "black"),
axis.text.y = element_text(size = 12, color = "black"),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
legend.title = element_text(size = 12),
legend.text = element_text(size = 8)
)

Tiempo mayor a 6 minutos.
BASE <- BASE %>% mutate(Tiempo_cat = cut(`Tiempo Retiro del equipo`, breaks = c(-Inf, 6, Inf), right = F,labels = c("Menor a 6", "mayor o igual a 6")))
Colonoscopia3 <- BASE %>% filter(Procedimiento == "Colonoscopia Total")
# Tasa por año
tasa_tiempo <- Colonoscopia3 %>%
group_by(ANO_PROC) %>%
summarise(
num_casos = sum(Tiempo_cat == "mayor o igual a 6", na.rm = TRUE),
total_Col = n(),
tasa = round((num_casos / total_Col)*100,2)
)
ggplot(tasa_tiempo, aes(x = factor(ANO_PROC), y = tasa, fill = tasa)) +
geom_bar(stat = "identity", width = 0.8, color = "white", size = 0.5) +
geom_text(aes(label = paste0(round(tasa, 2), "%")),
vjust = -0.5, size = 3.2, color = "black") +
labs(
title = "Tiempo retiro colonoscopias >= 6",
x = "Año",
y = "Porcentaje"
) +
scale_fill_gradient(low = "lightskyblue1", high = "darkblue",
name = "Porcentaje",
guide = guide_colorbar(barwidth = 1, barheight = 6)) +
scale_y_continuous(limits = c(0, max(tasa_foto$tasa)* 1.15),
expand = c(0, 0)) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 18, face = "bold",
margin = margin(b = 20)),
axis.title.x = element_text(size = 14, face = "bold", margin = margin(t = 15)),
axis.title.y = element_text(size = 14, face = "bold", margin = margin(r = 15)),
axis.text.x = element_text(size = 12, face = "bold", color = "black"),
axis.text.y = element_text(size = 12, color = "black"),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
legend.title = element_text(size = 12),
legend.text = element_text(size = 8)
)

Tiempo mayor a 6 minutos pacientes tamización
BASETCC <- BASE %>% filter(Tipo== "TCC")
Colonoscopia5 <- BASETCC %>% filter(Procedimiento == "Colonoscopia Total")
# Tasa por año
tasa_tiempo2 <- Colonoscopia5 %>%
group_by(ANO_PROC) %>%
summarise(
num_casos = sum(Tiempo_cat == "mayor o igual a 6", na.rm = TRUE),
total_Col = n(),
tasa = round((num_casos / total_Col)*100,2)
)
ggplot(tasa_tiempo2, aes(x = factor(ANO_PROC), y = tasa, fill = tasa)) +
geom_bar(stat = "identity", width = 0.8, color = "white", size = 0.5) +
geom_text(aes(label = paste0(round(tasa, 2), "%")),
vjust = -0.5, size = 3.2, color = "black") +
labs(
title = "Tiempo retiro colonoscopias >= 6, Tamización",
x = "Año",
y = "Porcentaje"
) +
scale_fill_gradient(low = "lightskyblue1", high = "darkblue",
name = "Porcentaje",
guide = guide_colorbar(barwidth = 1, barheight = 6)) +
scale_y_continuous(limits = c(0, max(tasa_foto$tasa)* 1.15),
expand = c(0, 0)) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 18, face = "bold",
margin = margin(b = 20)),
axis.title.x = element_text(size = 14, face = "bold", margin = margin(t = 15)),
axis.title.y = element_text(size = 14, face = "bold", margin = margin(r = 15)),
axis.text.x = element_text(size = 12, face = "bold", color = "black"),
axis.text.y = element_text(size = 12, color = "black"),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
legend.title = element_text(size = 12),
legend.text = element_text(size = 8)
)
