Adherencia en LatAm-FINGERS
Reporte con las múltiples intervenciones
2026-06-16
# Leemos el dataset.
require(data.table)
library(arsenal)
library(dplyr)
library(ggplot2)
data <- fread("C:/Users/Nico/Desktop/FINGERS/FINAL FINGERS/data_fingers.csv")1 Preliminares
Las intervenciones figuran en la base de datos con el formato de check-list. Se encuentran ubicadas en los eventos “Baseline” y en “12m”. A diferencia de la lógica general, todo baseline representa, por tanto, el primer año. En ese mismo sentido, 12 meses representa todo el segundo año.
2 Ejercicio Físico
La intervención de Ejercicio Físico comienza en el mes 2. ¿Por qué? Porque tenemos las team meetings de ejercicio físico en el mes 1.
| Cantidad de encuentros | |
|---|---|
| Primer año | 48 semanas y 4 sesiones por semana. 192 en total. |
| Segundo año | 52 semanas y 4 sesiones por semana. 208 en total |
| Caso especial | Perú realizó una intervención de 23 meses. Por tanto, en el primer año tenemos 192 encuentros posibles y en el segundo año tenemos 192 encuentros posibles. |
Lo que vamos a hacer a continuación es filtrar por los eventos baseline y 12 meses. Luego, para ser prolijos, nos vamos a quedar con el grupo sistemático. Adicionalmente vamos a crear dos columnas que sean la suma de las sesiones totales y luego la vamos a sumar [suma_final] y pasar en porcentaje. En el caso de Perú, nuestro denominador va a cambiar.
creacion_ef <- data %>%
filter(Eventos %in% c("base", "12m")) %>% # Filtro 1: eventos
filter(Arm == "Systematic") %>% # Filtro 2: solo sistemáticos.
group_by(id, center) %>% # Agrupo por id y centro.
mutate(
# Suma de las sesiones en primer año (representado por base)
suma_inicial = sum(ef_count[Eventos == "base"], na.rm = TRUE),
# Suma de las sesiones en segundo año (representado por 12m)
suma_posterior = sum(ef_count[Eventos == "12m"], na.rm = TRUE),
# Suma total
suma_final = suma_inicial + suma_posterior,
# Denominador que varía
denominador = if_else(center == "Perú", 384, 400),
# Porcentaje
porcentaje_individual = (suma_final / denominador) * 100
) %>%
ungroup() %>%
select(
id, center, Eventos,
suma_inicial, suma_posterior, suma_final,
denominador, porcentaje_individual, EsDropout
) %>%
filter(Eventos == "base")Vamos a ver un poco los datos en general y por centro.
library(dplyr)
library(knitr)
library(kableExtra)
# Estadísticos de resumen general
tabla_adherencia <- creacion_ef %>%
#group_by(center) %>%
summarise(
N = sum(!is.na(porcentaje_individual)),
Media = mean(porcentaje_individual, na.rm = TRUE),
DE = sd(porcentaje_individual, na.rm = TRUE),
Mediana = median(porcentaje_individual, na.rm = TRUE),
Q1 = quantile(porcentaje_individual, 0.25, na.rm = TRUE),
Q3 = quantile(porcentaje_individual, 0.75, na.rm = TRUE),
Mínimo = min(porcentaje_individual, na.rm = TRUE),
Máximo = max(porcentaje_individual, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
Media = round(Media, 1),
DE = round(DE, 1),
Mediana = round(Mediana, 1),
Q1 = round(Q1, 1),
Q3 = round(Q3, 1),
Mínimo = round(Mínimo, 1),
Máximo = round(Máximo, 1),
`Media (DE)` = paste0(Media, " (", DE, ")"),
`Mediana [Q1-Q3]` = paste0(Mediana, " [", Q1, "-", Q3, "]"),
`Rango` = paste0(Mínimo, "-", Máximo)
) %>%
select(
N,
`Media (DE)`,
`Mediana [Q1-Q3]`,
Rango
)
tabla_adherencia %>%
kable(
format = "html",
caption = "Table 1. Physical activity adherence",
align = c("l", "c", "c", "c", "c")
) %>%
kable_styling(
full_width = FALSE,
position = "center",
bootstrap_options = c("striped", "hover", "condensed", "responsive")
) %>%
row_spec(0, bold = TRUE, background = "#D9D9D9") %>%
column_spec(1, bold = TRUE)| N | Media (DE) | Mediana [Q1-Q3] | Rango |
|---|---|---|---|
| 539 | 55.7 (29) | 62.8 [34.1-79.6] | 0-98.5 |
# Estadísticos de resumen por centro
tabla_adherencia <- creacion_ef %>%
group_by(center) %>%
summarise(
N = sum(!is.na(porcentaje_individual)),
Media = mean(porcentaje_individual, na.rm = TRUE),
DE = sd(porcentaje_individual, na.rm = TRUE),
Mediana = median(porcentaje_individual, na.rm = TRUE),
Q1 = quantile(porcentaje_individual, 0.25, na.rm = TRUE),
Q3 = quantile(porcentaje_individual, 0.75, na.rm = TRUE),
Mínimo = min(porcentaje_individual, na.rm = TRUE),
Máximo = max(porcentaje_individual, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
Media = round(Media, 1),
DE = round(DE, 1),
Mediana = round(Mediana, 1),
Q1 = round(Q1, 1),
Q3 = round(Q3, 1),
Mínimo = round(Mínimo, 1),
Máximo = round(Máximo, 1),
`Media (DE)` = paste0(Media, " (", DE, ")"),
`Mediana [Q1-Q3]` = paste0(Mediana, " [", Q1, "-", Q3, "]"),
`Rango` = paste0(Mínimo, "-", Máximo)
) %>%
select(
Centro = center,
N,
`Media (DE)`,
`Mediana [Q1-Q3]`,
Rango
)
tabla_adherencia %>%
kable(
format = "html",
caption = "Table 1. Physical activity adherence by center",
align = c("l", "c", "c", "c", "c")
) %>%
kable_styling(
full_width = FALSE,
position = "center",
bootstrap_options = c("striped", "hover", "condensed", "responsive")
) %>%
row_spec(0, bold = TRUE, background = "#D9D9D9") %>%
column_spec(1, bold = TRUE)| Centro | N | Media (DE) | Mediana [Q1-Q3] | Rango |
|---|---|---|---|---|
| Argentina | 48 | 48.1 (23.1) | 53.8 [32.8-68.6] | 0-91.8 |
| Bolivia | 46 | 73.7 (24.9) | 82 [68.6-92.6] | 11-95.8 |
| Brasil | 49 | 49.9 (27.7) | 56.2 [28.2-69] | 0-95.8 |
| Chile | 50 | 45.2 (25.7) | 49.5 [24.8-65.6] | 0-86 |
| Colombia | 52 | 42.6 (29.7) | 51.2 [11.1-70.8] | 0-88.2 |
| Costa Rica | 47 | 46.8 (26.3) | 47.8 [26.1-68] | 0-98.5 |
| Ecuador | 50 | 71 (28.5) | 83.4 [62.1-89.9] | 0-97.8 |
| México | 51 | 59.2 (26) | 65.2 [40.4-80.9] | 0-96.5 |
| Perú | 51 | 60.5 (32.5) | 75.5 [54.7-83.9] | 0-90.9 |
| RepDom | 44 | 58.3 (33.9) | 69 [35.1-89] | 0-97.5 |
| Uruguay | 51 | 58.4 (23.5) | 66.5 [39.1-77.8] | 0-87.2 |
Nos ponemos a graficar para tratar de brindar mejor panorama.
Veamos:
# Graficamos
library(ggplot2)
library(patchwork)
barras <- ggplot(creacion_ef, aes(x = porcentaje_individual))+
geom_histogram(color = "#00205B",
fill = "#BA0C2F",
bins = 100)+
theme_bw()+
labs(title = "Individual adherence (%) to Physical Intervention",
x = "Individual attendance %",
y = "Count")+
theme(plot.title = element_text(face = "bold"))
boxplot <- ggplot(creacion_ef, aes(x = porcentaje_individual))+
geom_boxplot(fill = "#BA0C2F")+
theme_bw()+
labs(title = "A general panorama",
x = "Individual attendance %",
y = "Count")+
theme(plot.title = element_text(face = "bold"))
centro <- ggplot(creacion_ef, aes(x = porcentaje_individual))+
geom_histogram(color = "#00205B",
fill = "#BA0C2F",
bins = 100)+
theme_bw()+
labs(title = "Individual adherence (%) by center",
x = "Individual attendance %",
y = "Count")+
theme(plot.title = element_text(face = "bold"))+
facet_wrap(~ center, nrow = 6)
drop <- ggplot(creacion_ef, aes(x = porcentaje_individual,
fill = EsDropout))+
geom_histogram(position = "dodge",
bins = 100)+
scale_fill_manual(values = c("Dropout" = "#BA0C2F",
"No-Dropout" = "#00205B"))+
theme_bw()+
labs(title = "% by Dropout status",
x = "Individual attendance %",
y = "Count")+
theme(plot.title = element_text(face = "bold"))
#Todo junto
barras
3 Nutrición
En el caso de la nutrición, tenemos que aclarar que comienza en el mes 3. En el año 2, tenemos 52 semanas. El registro se realiza una vez por semana. Vamos con la tabla.
| Cantidad de encuentros | |
|---|---|
| Primer año | 44 semanas y 1 registropor semana. 44 en total. |
| Segundo año | 52 semanas y 1 registro por semana. 52 en total |
| Caso especial | Perú realizó una intervención de 23 meses. Por tanto, en el primer año tenemos 44 registros posibles y en el segundo año tenemos 48 registros posibles. |
creacion_nis <- data %>%
filter(Eventos %in% c("base", "12m")) %>% # Filtro 1: eventos
filter(Arm == "Systematic") %>% # Filtro 2: solo sistemáticos.
group_by(id, center) %>% # Agrupo por id y centro.
mutate(
# Suma de las sesiones en primer año (representado por base)
suma_inicial = sum(nis_count[Eventos == "base"], na.rm = TRUE),
# Suma de las sesiones en segundo año (representado por 12m)
suma_posterior = sum(nis_count[Eventos == "12m"], na.rm = TRUE),
# Suma total
suma_final = suma_inicial + suma_posterior,
# Denominador que varía
denominador = if_else(center == "Perú", 90, 96),
# Porcentaje
porcentaje_individual = (suma_final / denominador) * 100
) %>%
ungroup() %>%
select(
id, center, Eventos,
suma_inicial, suma_posterior, suma_final,
denominador, porcentaje_individual, EsDropout
) %>%
filter(Eventos == "base")library(dplyr)
library(knitr)
library(kableExtra)
# Estadísticos de resumen general
tabla_adherencia <- creacion_nis %>%
#group_by(center) %>%
summarise(
N = sum(!is.na(porcentaje_individual)),
Media = mean(porcentaje_individual, na.rm = TRUE),
DE = sd(porcentaje_individual, na.rm = TRUE),
Mediana = median(porcentaje_individual, na.rm = TRUE),
Q1 = quantile(porcentaje_individual, 0.25, na.rm = TRUE),
Q3 = quantile(porcentaje_individual, 0.75, na.rm = TRUE),
Mínimo = min(porcentaje_individual, na.rm = TRUE),
Máximo = max(porcentaje_individual, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
Media = round(Media, 1),
DE = round(DE, 1),
Mediana = round(Mediana, 1),
Q1 = round(Q1, 1),
Q3 = round(Q3, 1),
Mínimo = round(Mínimo, 1),
Máximo = round(Máximo, 1),
`Media (DE)` = paste0(Media, " (", DE, ")"),
`Mediana [Q1-Q3]` = paste0(Mediana, " [", Q1, "-", Q3, "]"),
`Rango` = paste0(Mínimo, "-", Máximo)
) %>%
select(
N,
`Media (DE)`,
`Mediana [Q1-Q3]`,
Rango
)
tabla_adherencia %>%
kable(
format = "html",
caption = "Table 1. Nutrition adherence",
align = c("l", "c", "c", "c", "c")
) %>%
kable_styling(
full_width = FALSE,
position = "center",
bootstrap_options = c("striped", "hover", "condensed", "responsive")
) %>%
row_spec(0, bold = TRUE, background = "#D9D9D9") %>%
column_spec(1, bold = TRUE)| N | Media (DE) | Mediana [Q1-Q3] | Rango |
|---|---|---|---|
| 539 | 52.7 (38.7) | 57.3 [11.1-92.7] | 0-100 |
# Estadísticos de resumen por centro
tabla_adherencia <- creacion_nis %>%
group_by(center) %>%
summarise(
N = sum(!is.na(porcentaje_individual)),
Media = mean(porcentaje_individual, na.rm = TRUE),
DE = sd(porcentaje_individual, na.rm = TRUE),
Mediana = median(porcentaje_individual, na.rm = TRUE),
Q1 = quantile(porcentaje_individual, 0.25, na.rm = TRUE),
Q3 = quantile(porcentaje_individual, 0.75, na.rm = TRUE),
Mínimo = min(porcentaje_individual, na.rm = TRUE),
Máximo = max(porcentaje_individual, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
Media = round(Media, 1),
DE = round(DE, 1),
Mediana = round(Mediana, 1),
Q1 = round(Q1, 1),
Q3 = round(Q3, 1),
Mínimo = round(Mínimo, 1),
Máximo = round(Máximo, 1),
`Media (DE)` = paste0(Media, " (", DE, ")"),
`Mediana [Q1-Q3]` = paste0(Mediana, " [", Q1, "-", Q3, "]"),
`Rango` = paste0(Mínimo, "-", Máximo)
) %>%
select(
Centro = center,
N,
`Media (DE)`,
`Mediana [Q1-Q3]`,
Rango
)
tabla_adherencia %>%
kable(
format = "html",
caption = "Table 1. Nutrition adherence by center",
align = c("l", "c", "c", "c", "c")
) %>%
kable_styling(
full_width = FALSE,
position = "center",
bootstrap_options = c("striped", "hover", "condensed", "responsive")
) %>%
row_spec(0, bold = TRUE, background = "#D9D9D9") %>%
column_spec(1, bold = TRUE)| Centro | N | Media (DE) | Mediana [Q1-Q3] | Rango |
|---|---|---|---|---|
| Argentina | 48 | 70.6 (27) | 79.2 [60.2-91.7] | 0-100 |
| Bolivia | 46 | 88.3 (30.6) | 100 [100-100] | 0-100 |
| Brasil | 49 | 71.3 (35.5) | 88.5 [45.8-100] | 0-100 |
| Chile | 50 | 28.2 (32.6) | 13.5 [2.1-43.5] | 0-100 |
| Colombia | 52 | 8 (18.6) | 0 [0-4.2] | 0-78.1 |
| Costa Rica | 47 | 76.7 (32.9) | 93.8 [73.4-97.4] | 0-100 |
| Ecuador | 50 | 77.7 (28.6) | 90.6 [75.8-94.8] | 0-100 |
| México | 51 | 47.1 (33.1) | 54.2 [15.6-77.1] | 0-100 |
| Perú | 51 | 20 (17.6) | 15.6 [8.9-27.8] | 0-80 |
| RepDom | 44 | 54.3 (36.1) | 70.3 [16.4-84.6] | 0-96.9 |
| Uruguay | 51 | 46 (28.4) | 44.8 [26.6-68.2] | 0-95.8 |
# Graficamos
barras <- ggplot(creacion_nis, aes(x = porcentaje_individual))+
geom_histogram(color = "#00205B",
fill = "#BA0C2F",
bins = 100)+
theme_bw()+
labs(title = "Individual adherence (%) to Nutritional Intervention",
x = "Individual attendance %",
y = "Count")+
theme(plot.title = element_text(face = "bold"))
boxplot <- ggplot(creacion_nis, aes(x = porcentaje_individual))+
geom_boxplot(fill = "#BA0C2F")+
theme_bw()+
labs(title = "A general panorama",
x = "Individual attendance %",
y = "Count")+
theme(plot.title = element_text(face = "bold"))
centro <- ggplot(creacion_nis, aes(x = porcentaje_individual))+
geom_histogram(color = "#00205B",
fill = "#BA0C2F",
bins = 100)+
theme_bw()+
labs(title = "Individual adherence (%) by center",
x = "Individual attendance %",
y = "Count")+
theme(plot.title = element_text(face = "bold"))+
facet_wrap(~ center, nrow = 6)
drop <- ggplot(creacion_nis, aes(x = porcentaje_individual,
fill = EsDropout))+
geom_histogram(position = "dodge",
bins = 100)+
scale_fill_manual(values = c("Dropout" = "#BA0C2F",
"No-Dropout" = "#00205B"))+
theme_bw()+
labs(title = "% by Dropout status",
x = "Individual attendance %",
y = "Count")+
theme(plot.title = element_text(face = "bold"))
#Todo junto
barras
