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')

Data Frame Summary

BASE

Dimensions: 29146 x 19
Duplicates: 2
No Variable Stats / Values Freqs (% of Valid) Graph Valid Missing
1 Nombre profesional [character]
1. ACUÑA PARAMO ALFREDO JAVI
2. LUQUEZ MINDIOLA ADAN JOSE
3. MOYA VALENZUELA LAURA MAR
4. ANGARITA SANTOS OSCAR RIC
5. PINEDA OVALLE LUIS FERNAN
6. ROSAS ESPITIA MARTHA CECI
7. APONTE ORDOÑEZ PEDRO NEL
8. AGUDELO VARON FABIAN ORLA
9. BRAVO PEREZ MARIA ANGELIC
10. ARBELAEZ MENDEZ VICTOR H.
[ 34 others ]
3818(13.1%)
3692(12.7%)
2348(8.1%)
2185(7.5%)
2157(7.4%)
2031(7.0%)
1817(6.2%)
1763(6.0%)
1131(3.9%)
933(3.2%)
7271(24.9%)
29146 (100.0%) 0 (0.0%)
2 Documento [character]
1. 3267789
2. 35408399
3. 41570384
4. 74244431
5. 21166689
6. 21893720
7. 74180512
8. 1014300546
9. 1031171779
10. 19336905
[ 25289 others ]
10(0.0%)
8(0.0%)
8(0.0%)
8(0.0%)
7(0.0%)
7(0.0%)
7(0.0%)
6(0.0%)
6(0.0%)
6(0.0%)
29073(99.7%)
29146 (100.0%) 0 (0.0%)
3 Apellido 1 [character]
1. RODRIGUEZ
2. GOMEZ
3. GONZALEZ
4. MARTINEZ
5. SANCHEZ
6. GARCIA
7. RAMIREZ
8. LOPEZ
9. HERNANDEZ
10. ROJAS
[ 2541 others ]
941(3.2%)
460(1.6%)
441(1.5%)
432(1.5%)
412(1.4%)
374(1.3%)
374(1.3%)
366(1.3%)
341(1.2%)
340(1.2%)
24665(84.6%)
29146 (100.0%) 0 (0.0%)
4 Apellido 2 [character]
1. .
2. RODRIGUEZ
3. GONZALEZ
4. GOMEZ
5. SANCHEZ
6. MARTINEZ
7. LOPEZ
8. GARCIA
9. RAMIREZ
10. ROJAS
[ 2889 others ]
1039(3.6%)
800(2.7%)
417(1.4%)
407(1.4%)
392(1.3%)
352(1.2%)
347(1.2%)
344(1.2%)
337(1.2%)
332(1.1%)
24359(83.6%)
29126 (99.9%) 20 (0.1%)
5 Nombre 1 [character]
1. MARIA
2. LUZ
3. JOSE
4. LUIS
5. ANA
6. MARTHA
7. JUAN
8. CARLOS
9. GLORIA
10. SANDRA
[ 2746 others ]
2269(7.8%)
886(3.0%)
769(2.6%)
706(2.4%)
675(2.3%)
611(2.1%)
550(1.9%)
520(1.8%)
416(1.4%)
416(1.4%)
21328(73.2%)
29146 (100.0%) 0 (0.0%)
6 Nombre 2 [character]
1. .
2. MARIA
3. PATRICIA
4. ENRIQUE
5. LUCIA
6. ALBERTO
7. ANTONIO
8. CECILIA
9. MARINA
10. ANDRES
[ 2037 others ]
7820(26.9%)
614(2.1%)
555(1.9%)
377(1.3%)
365(1.3%)
361(1.2%)
332(1.1%)
318(1.1%)
300(1.0%)
299(1.0%)
17728(61.0%)
29069 (99.7%) 77 (0.3%)
7 Sexo [character]
1. F
2. M
18043(61.9%)
11103(38.1%)
29146 (100.0%) 0 (0.0%)
8 Fecha Proc [POSIXct, POSIXt]
min : 2018-01-09
med : 2022-03-12
max : 2025-07-01
range : 7y 5m 22d
2087 distinct values 29146 (100.0%) 0 (0.0%)
9 Edad [numeric]
Mean (sd) : 53.6 (15.4)
min ≤ med ≤ max:
2 ≤ 55 ≤ 800
IQR (CV) : 19 (0.3)
96 distinct values 29146 (100.0%) 0 (0.0%)
10 Procedimiento [character]
1. Colonoscopia Total
2. RESECCION DE LESION DE IN
3. RESECCION DE LESION DE IN
4. RESECCION ENDOSCOPICA DE
5. RESECCION ENDOSCOPICA DE
24274(83.3%)
4410(15.1%)
15(0.1%)
433(1.5%)
14(0.0%)
29146 (100.0%) 0 (0.0%)
11 Remisión [character]
1. AutoRemitido
2. Remitido
12081(41.4%)
17065(58.6%)
29146 (100.0%) 0 (0.0%)
12 Tipo [character]
1. DIAG
2. TCC
3. VIG
17934(61.5%)
7646(26.2%)
3566(12.2%)
29146 (100.0%) 0 (0.0%)
13 Foto [character]
1. N
2. NA
3. S
1075(3.7%)
959(3.3%)
27112(93.0%)
29146 (100.0%) 0 (0.0%)
14 Preparación [character]
1. AD
2. NA
3. NAD
24372(83.6%)
1161(4.0%)
3613(12.4%)
29146 (100.0%) 0 (0.0%)
15 Tiempo Retiro del equipo [numeric]
Mean (sd) : 8.6 (3.9)
min ≤ med ≤ max:
0 ≤ 8 ≤ 145
IQR (CV) : 2 (0.4)
47 distinct values 28388 (97.4%) 758 (2.6%)
16 Riesgo [character]
1. NA
2. RA
3. RP
4123(14.1%)
3709(12.7%)
21314(73.1%)
29146 (100.0%) 0 (0.0%)
17 Polipectomia [character]
1. N
2. S
21463(73.6%)
7683(26.4%)
29146 (100.0%) 0 (0.0%)
18 Adenomas 3 o mas [character]
1. N
2. S
161(3.3%)
4781(96.7%)
4942 (17.0%) 24204 (83.0%)
19 Adenocarci [character]
1. N
2. S
19(46.3%)
22(53.7%)
41 (0.1%) 29105 (99.9%)

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

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)
  )