# Instala los que no tengas con: install.packages("nombre")
library(readxl)
library(dplyr)
library(tidyr)
library(ggplot2)
library(knitr)
library(kableExtra)
library(nnet) # regresión logística multinomial
library(caret) # matriz de confusión y métricas
library(effsize) # d de Cohen# Ajustá la ruta al archivo en tu computador
df_raw <- read_excel("C:/Users/Helen Granados R/OneDrive - Universidad Nacional de Colombia/Escritorio/SDDE/DIME EFECTIVO.xlsx", skip = 1)
# Las primeras 11 columnas son DIME 1.0, las siguientes 11 son DIME 2.0
# Renombramos para claridad
names(df_raw)[1:11] <- c("GlobalID_10", "NUM_DOC_10", "LOCALIDAD_F_10",
"RAZON_SOCIAL_10",
"B_10", "C_10", "D_10", "E_10", "F_10",
"General_10", "Etapa_10")
names(df_raw)[12:22] <- c("GlobalID_20", "NUM_DOC_20", "LOCALIDAD_F_20",
"RAZON_SOCIAL_20",
"B_20", "C_20", "D_20", "E_20", "F_20",
"General_20", "Etapa_20")
glimpse(df_raw)## Rows: 5,333
## Columns: 22
## $ GlobalID_10 <chr> "a5a1cb3e-6694-4615-8d01-a0bc6aef8b22", "a6c04619-aa87…
## $ NUM_DOC_10 <chr> "79627952", "1014290189", "1031129746", "900946632", "…
## $ LOCALIDAD_F_10 <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, …
## $ RAZON_SOCIAL_10 <chr> "Go producción y publicidad", "Tendencia Pixel", "Eros…
## $ B_10 <dbl> 3.666700, 2.500150, 3.334000, 3.583275, 3.000000, 2.00…
## $ C_10 <dbl> 2.37880, 2.09240, 2.32870, 2.52480, 1.90620, 0.62355, …
## $ D_10 <dbl> 2.710475, 1.418875, 1.757875, 1.993075, 2.214275, 1.09…
## $ E_10 <dbl> 1.1088, 1.1088, 1.5499, 2.6587, 3.4276, 0.5544, 1.9910…
## $ F_10 <dbl> 3.788400, 3.752633, 2.337383, 3.803117, 2.448450, 1.37…
## $ General_10 <dbl> 2.730635, 2.174572, 2.261572, 2.912593, 2.599305, 1.13…
## $ Etapa_10 <chr> "Crecimiento", "Crecimiento", "Crecimiento", "Crecimie…
## $ GlobalID_20 <chr> "75874f8e-d451-49d7-8a07-f537008581dd", "0526ffc9-28b2…
## $ NUM_DOC_20 <chr> "79627952", "1014290189", "1031129746", "900946632", "…
## $ LOCALIDAD_F_20 <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, …
## $ RAZON_SOCIAL_20 <chr> "Go producción y publicidad", "vellier", "Eros Design"…
## $ B_20 <dbl> 4.333400, 2.917275, 4.000700, 4.000000, 2.667100, 3.99…
## $ C_20 <dbl> 1.71970, 1.25205, 2.48330, 1.14490, 1.62840, 2.10100, …
## $ D_20 <dbl> 2.915526, 2.216954, 3.033704, 2.195754, 2.006097, 1.53…
## $ E_20 <dbl> 1.1088, 1.6632, 1.6632, 2.1043, 3.4276, 1.1088, 1.9910…
## $ F_20 <dbl> 2.837600, 2.599900, 3.443400, 2.599900, 2.751350, 2.31…
## $ General_20 <dbl> 2.583005, 2.129876, 2.924861, 2.408971, 2.496109, 2.21…
## $ Etapa_20 <chr> "Crecimiento", "Crecimiento", "Crecimiento", "Crecimie…
La variable clave es si la UP avanzó, se quedó estable o retrocedió de etapa entre el DIME 1.0 (2025) y el DIME 2.0 (2026).
# Orden numérico de etapas
orden_etapas <- c("Ideación" = 0, "Nacimiento" = 1,
"Crecimiento" = 2, "Aceleración" = 3, "Madurez" = 4)
df <- df_raw %>%
mutate(
etapa_num_10 = orden_etapas[Etapa_10],
etapa_num_20 = orden_etapas[Etapa_20],
delta_etapa = etapa_num_20 - etapa_num_10,
cambio = case_when(
delta_etapa > 0 ~ "Avanzó",
delta_etapa < 0 ~ "Retrocedió",
delta_etapa == 0 ~ "Estable"
),
cambio = factor(cambio, levels = c("Avanzó", "Estable", "Retrocedió")),
# Deltas por dimensión
delta_B = B_20 - B_10,
delta_C = C_20 - C_10,
delta_D = D_20 - D_10,
delta_E = E_20 - E_10,
delta_F = F_20 - F_10,
delta_General = General_20 - General_10
)
cat("N total:", nrow(df), "\n")## N total: 5333
## Distribución de cambio:
##
## Avanzó Estable Retrocedió
## 1206 3520 607
La medida más básica: ¿el score promedio subió entre rondas?
resumen_general <- data.frame(
Ronda = c("DIME 1.0 (2025)", "DIME 2.0 (2026)"),
Media = c(mean(df$General_10), mean(df$General_20)),
Diferencia = c(NA, mean(df$General_20) - mean(df$General_10))
)
kable(resumen_general, digits = 4,
caption = "Score general promedio por ronda") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)| Ronda | Media | Diferencia |
|---|---|---|
| DIME 1.0 (2025) | 2.1625 | NA |
| DIME 2.0 (2026) | 2.2797 | 0.1173 |
Lectura: la diferencia de +0.12 es el primer indicio de mejora agregada. Pero necesitamos saber si es real o azar — eso viene en la sección de pruebas de hipótesis.
paso2 <- df %>%
group_by(cambio) %>%
summarise(
n = n(),
Media_10 = mean(General_10),
Media_20 = mean(General_20),
Diferencia = mean(General_20 - General_10)
)
kable(paso2, digits = 4,
caption = "Score general promedio por grupo de cambio de etapa") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)| cambio | n | Media_10 | Media_20 | Diferencia |
|---|---|---|---|---|
| Avanzó | 1206 | 1.9779 | 2.5619 | 0.5840 |
| Estable | 3520 | 2.1626 | 2.2294 | 0.0668 |
| Retrocedió | 607 | 2.5281 | 2.0111 | -0.5170 |
ggplot(df, aes(x = cambio, y = delta_General, fill = cambio)) +
geom_boxplot(alpha = 0.7, outlier.size = 0.5) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray40") +
scale_fill_manual(values = c("Avanzó" = "#2ecc71",
"Estable" = "#3498db",
"Retrocedió" = "#e74c3c")) +
labs(title = "Cambio en score general (2.0 - 1.0) por grupo",
x = NULL, y = "Delta score general",
fill = "Grupo") +
theme_minimal(base_size = 13) +
theme(legend.position = "none")¿Las que avanzaron venían de más abajo?
paso3 <- df %>%
group_by(cambio) %>%
summarise(
n = n(),
Media = mean(General_10),
Mediana = median(General_10),
Q1 = quantile(General_10, 0.25),
Q3 = quantile(General_10, 0.75),
Min = min(General_10),
Max = max(General_10),
Std = sd(General_10)
)
kable(paso3, digits = 4,
caption = "Descriptivas del score general inicial (1.0) por grupo") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)| cambio | n | Media | Mediana | Q1 | Q3 | Min | Max | Std |
|---|---|---|---|---|---|---|---|---|
| Avanzó | 1206 | 1.9779 | 1.8929 | 1.6782 | 2.4097 | 0.4351 | 3.8268 | 0.5757 |
| Estable | 3520 | 2.1626 | 2.1708 | 1.6678 | 2.5671 | 0.5752 | 4.1861 | 0.6129 |
| Retrocedió | 607 | 2.5281 | 2.3229 | 2.1182 | 3.0638 | 1.0583 | 4.3804 | 0.5838 |
ggplot(df, aes(x = General_10, fill = cambio)) +
geom_density(alpha = 0.5) +
scale_fill_manual(values = c("Avanzó" = "#2ecc71",
"Estable" = "#3498db",
"Retrocedió" = "#e74c3c")) +
labs(title = "Distribución del score inicial (1.0) por grupo de cambio",
x = "Score general DIME 1.0", y = "Densidad", fill = "Grupo") +
theme_minimal(base_size = 13)¿Cuál dimensión se mueve más en cada grupo?
dims <- c("B" = "Desarrollo", "C" = "Liderazgo",
"D" = "Mercado", "E" = "Contabilidad", "F" = "Innovación")
paso4 <- df %>%
group_by(cambio) %>%
summarise(
B = mean(delta_B),
C = mean(delta_C),
D = mean(delta_D),
E = mean(delta_E),
F = mean(delta_F)
) %>%
pivot_longer(-cambio, names_to = "Dimension", values_to = "Delta_medio")
ggplot(paso4, aes(x = Dimension, y = Delta_medio, fill = cambio)) +
geom_col(position = "dodge", alpha = 0.85) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray40") +
scale_fill_manual(values = c("Avanzó" = "#2ecc71",
"Estable" = "#3498db",
"Retrocedió" = "#e74c3c")) +
scale_x_discrete(labels = c("B" = "B. Desarrollo", "C" = "C. Liderazgo",
"D" = "D. Mercado", "E" = "E. Contabilidad",
"F" = "F. Innovación")) +
labs(title = "Cambio promedio por dimensión y grupo",
x = NULL, y = "Delta promedio (2.0 - 1.0)", fill = "Grupo") +
theme_minimal(base_size = 13)¿Desde cuál etapa es más probable avanzar?
paso5 <- df %>%
group_by(Etapa_10) %>%
summarise(
n = n(),
Media_10 = mean(General_10),
Mediana_10 = median(General_10),
Pct_Avanzó = mean(cambio == "Avanzó") * 100,
Pct_Estable = mean(cambio == "Estable") * 100,
Pct_Retro = mean(cambio == "Retrocedió") * 100
) %>%
arrange(Media_10)
kable(paso5, digits = 2,
col.names = c("Etapa 1.0", "n", "Media 1.0", "Mediana 1.0",
"% Avanzó", "% Estable", "% Retrocedió"),
caption = "Score inicial y dirección de cambio por etapa de partida") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)| Etapa 1.0 | n | Media 1.0 | Mediana 1.0 | % Avanzó | % Estable | % Retrocedió |
|---|---|---|---|---|---|---|
| Ideación | 96 | 0.83 | 0.87 | 79.17 | 20.83 | 0.00 |
| Nacimiento | 2137 | 1.62 | 1.65 | 34.91 | 63.64 | 1.45 |
| Crecimiento | 2561 | 2.42 | 2.39 | 14.33 | 70.95 | 14.72 |
| Aceleración | 530 | 3.29 | 3.24 | 3.21 | 60.75 | 36.04 |
| Madurez | 9 | 4.18 | 4.15 | 0.00 | 11.11 | 88.89 |
Para cada comparación de grupos y cada dimensión, la prueba t contrasta:
Con 18 pruebas en total, aplicamos corrección de Bonferroni:
\[\alpha_{\text{corregido}} = \frac{0.05}{18} \approx 0.0028\]
alpha_bonf <- 0.05 / 18
grupos <- list(
"Avanzó" = df %>% filter(cambio == "Avanzó"),
"Estable" = df %>% filter(cambio == "Estable"),
"Retrocedió" = df %>% filter(cambio == "Retrocedió")
)
dimensiones <- list(
"B. Desarrollo" = "delta_B",
"C. Liderazgo" = "delta_C",
"D. Mercado" = "delta_D",
"E. Contabilidad" = "delta_E",
"F. Innovación" = "delta_F",
"General" = "delta_General"
)
comparaciones_pares <- list(
c("Avanzó", "Estable"),
c("Avanzó", "Retrocedió"),
c("Estable", "Retrocedió")
)
resultados_t <- lapply(comparaciones_pares, function(par) {
lapply(names(dimensiones), function(dim_nombre) {
col <- dimensiones[[dim_nombre]]
a <- grupos[[par[1]]][[col]]
b <- grupos[[par[2]]][[col]]
tt <- t.test(a, b)
data.frame(
Comparacion = paste(par[1], "vs.", par[2]),
Dimension = dim_nombre,
Media_A = mean(a),
Media_B = mean(b),
Diferencia = mean(a) - mean(b),
t = tt$statistic,
p_valor = tt$p.value,
IC_inf = tt$conf.int[1],
IC_sup = tt$conf.int[2],
Significativo = ifelse(tt$p.value < alpha_bonf, "Sí", "No")
)
}) %>% bind_rows()
}) %>% bind_rows()
kable(resultados_t %>% select(-IC_inf, -IC_sup),
digits = c(0, 0, 4, 4, 4, 3, 6, 0),
caption = paste0("Pruebas t con corrección Bonferroni (α = ",
round(alpha_bonf, 4), ")")) %>%
kable_styling(bootstrap_options = c("striped", "hover"),
full_width = TRUE, font_size = 12) %>%
column_spec(8, color = ifelse(resultados_t$Significativo == "Sí",
"green", "red"))| Comparacion | Dimension | Media_A | Media_B | Diferencia | t | p_valor | Significativo | |
|---|---|---|---|---|---|---|---|---|
| t…1 | Avanzó vs. Estable | B. Desarrollo | 0.8714 | 0.3638 | 0.5076 | 22.953 | 0 | Sí |
| t…2 | Avanzó vs. Estable | C. Liderazgo | 0.3638 | -0.0571 | 0.4209 | 23.207 | 0 | Sí |
| t…3 | Avanzó vs. Estable | D. Mercado | 0.2606 | -0.0644 | 0.3250 | 21.161 | 0 | Sí |
| t…4 | Avanzó vs. Estable | E. Contabilidad | 0.4538 | -0.0021 | 0.4559 | 19.845 | 0 | Sí |
| t…5 | Avanzó vs. Estable | F. Innovación | 0.9705 | 0.0936 | 0.8768 | 29.230 | 0 | Sí |
| t…6 | Avanzó vs. Estable | General | 0.5840 | 0.0668 | 0.5173 | 49.357 | 0 | Sí |
| t…7 | Avanzó vs. Retrocedió | B. Desarrollo | 0.8714 | -0.2082 | 1.0796 | 30.904 | 0 | Sí |
| t…8 | Avanzó vs. Retrocedió | C. Liderazgo | 0.3638 | -0.4919 | 0.8557 | 32.172 | 0 | Sí |
| t…9 | Avanzó vs. Retrocedió | D. Mercado | 0.2606 | -0.4504 | 0.7110 | 30.207 | 0 | Sí |
| t…10 | Avanzó vs. Retrocedió | E. Contabilidad | 0.4538 | -0.6081 | 1.0619 | 27.512 | 0 | Sí |
| t…11 | Avanzó vs. Retrocedió | F. Innovación | 0.9705 | -0.8264 | 1.7969 | 38.777 | 0 | Sí |
| t…12 | Avanzó vs. Retrocedió | General | 0.5840 | -0.5170 | 1.1010 | 71.069 | 0 | Sí |
| t…13 | Estable vs. Retrocedió | B. Desarrollo | 0.3638 | -0.2082 | 0.5720 | 18.115 | 0 | Sí |
| t…14 | Estable vs. Retrocedió | C. Liderazgo | -0.0571 | -0.4919 | 0.4348 | 19.130 | 0 | Sí |
| t…15 | Estable vs. Retrocedió | D. Mercado | -0.0644 | -0.4504 | 0.3860 | 18.897 | 0 | Sí |
| t…16 | Estable vs. Retrocedió | E. Contabilidad | -0.0021 | -0.6081 | 0.6060 | 17.333 | 0 | Sí |
| t…17 | Estable vs. Retrocedió | F. Innovación | 0.0936 | -0.8264 | 0.9200 | 22.641 | 0 | Sí |
| t…18 | Estable vs. Retrocedió | General | 0.0668 | -0.5170 | 0.5838 | 43.752 | 0 | Sí |
La significancia estadística no dice cuán grande es la diferencia. La d de Cohen sí:
| d | Magnitud |
|---|---|
| < 0.2 | Trivial |
| 0.2 – 0.5 | Pequeño |
| 0.5 – 0.8 | Mediano |
| 0.8 – 1.0 | Grande |
| > 1.0 | Muy grande |
cohen_d_manual <- function(a, b) {
s_pool <- sqrt(((length(a)-1)*var(a) + (length(b)-1)*var(b)) /
(length(a) + length(b) - 2))
(mean(a) - mean(b)) / s_pool
}
etiqueta_d <- function(d) {
d <- abs(d)
if (d < 0.2) "Trivial"
else if (d < 0.5) "Pequeño"
else if (d < 0.8) "Mediano"
else if (d < 1.0) "Grande"
else "Muy grande"
}
resultados_d <- lapply(comparaciones_pares, function(par) {
lapply(names(dimensiones), function(dim_nombre) {
col <- dimensiones[[dim_nombre]]
a <- grupos[[par[1]]][[col]]
b <- grupos[[par[2]]][[col]]
d <- cohen_d_manual(a, b)
data.frame(
Comparacion = paste(par[1], "vs.", par[2]),
Dimension = dim_nombre,
Diferencia = mean(a) - mean(b),
d_Cohen = d,
Magnitud = etiqueta_d(d)
)
}) %>% bind_rows()
}) %>% bind_rows()
kable(resultados_d, digits = 4,
caption = "Tamaño del efecto (d de Cohen) por comparación y dimensión") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = TRUE)| Comparacion | Dimension | Diferencia | d_Cohen | Magnitud |
|---|---|---|---|---|
| Avanzó vs. Estable | B. Desarrollo | 0.5076 | 0.7501 | Mediano |
| Avanzó vs. Estable | C. Liderazgo | 0.4209 | 0.8238 | Grande |
| Avanzó vs. Estable | D. Mercado | 0.3250 | 0.7510 | Mediano |
| Avanzó vs. Estable | E. Contabilidad | 0.4559 | 0.6697 | Mediano |
| Avanzó vs. Estable | F. Innovación | 0.8768 | 1.0165 | Muy grande |
| Avanzó vs. Estable | General | 0.5173 | 1.7324 | Muy grande |
| Avanzó vs. Retrocedió | B. Desarrollo | 1.0796 | 1.5895 | Muy grande |
| Avanzó vs. Retrocedió | C. Liderazgo | 0.8557 | 1.5637 | Muy grande |
| Avanzó vs. Retrocedió | D. Mercado | 0.7110 | 1.5016 | Muy grande |
| Avanzó vs. Retrocedió | E. Contabilidad | 1.0619 | 1.4438 | Muy grande |
| Avanzó vs. Retrocedió | F. Innovación | 1.7969 | 1.9439 | Muy grande |
| Avanzó vs. Retrocedió | General | 1.1010 | 3.4776 | Muy grande |
| Estable vs. Retrocedió | B. Desarrollo | 0.5720 | 0.8291 | Grande |
| Estable vs. Retrocedió | C. Liderazgo | 0.4348 | 0.8743 | Grande |
| Estable vs. Retrocedió | D. Mercado | 0.3860 | 0.9058 | Grande |
| Estable vs. Retrocedió | E. Contabilidad | 0.6060 | 0.8673 | Grande |
| Estable vs. Retrocedió | F. Innovación | 0.9200 | 1.0727 | Muy grande |
| Estable vs. Retrocedió | General | 0.5838 | 1.9955 | Muy grande |
resultados_d %>%
mutate(
Magnitud = factor(Magnitud,
levels = c("Trivial","Pequeño","Mediano",
"Grande","Muy grande"))
) %>%
ggplot(aes(x = Dimension, y = abs(d_Cohen), fill = Comparacion)) +
geom_col(position = "dodge", alpha = 0.85) +
geom_hline(yintercept = c(0.2, 0.5, 0.8, 1.0),
linetype = "dashed", color = "gray50", linewidth = 0.4) +
annotate("text", x = 0.6, y = c(0.22, 0.52, 0.82, 1.02),
label = c("Pequeño","Mediano","Grande","Muy grande"),
size = 3, color = "gray40", hjust = 0) +
labs(title = "d de Cohen por dimensión y comparación",
x = NULL, y = "|d de Cohen|", fill = "Comparación") +
theme_minimal(base_size = 13) +
theme(axis.text.x = element_text(angle = 20, hjust = 1))El IC dice el rango plausible de la diferencia real en la población. Si no contiene el 0, la diferencia es significativa.
resultados_t %>%
ggplot(aes(x = Dimension, y = Diferencia,
ymin = IC_inf, ymax = IC_sup, color = Comparacion)) +
geom_pointrange(position = position_dodge(width = 0.5), size = 0.6) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray40") +
labs(title = "Diferencia de medias con IC 95% por dimensión y comparación",
x = NULL, y = "Diferencia (Grupo A - Grupo B)",
color = "Comparación") +
theme_minimal(base_size = 13) +
theme(axis.text.x = element_text(angle = 20, hjust = 1))Usamos los scores iniciales (1.0) y sus deltas (2.0 - 1.0) como predictores, más la etapa numérica de partida.
features <- c("B_10", "C_10", "D_10", "E_10", "F_10", "General_10",
"etapa_num_10",
"delta_B", "delta_C", "delta_D", "delta_E",
"delta_F", "delta_General")
df_modelo <- df %>%
select(all_of(features), cambio) %>%
drop_na()
cat("N para modelar:", nrow(df_modelo), "\n")## N para modelar: 5333
## Distribución de la variable Y:
##
## Avanzó Estable Retrocedió
## 1206 3520 607
Dividimos los datos antes de entrenar para evaluar el modelo en datos que nunca vio.
set.seed(42)
idx_train <- createDataPartition(df_modelo$cambio, p = 0.8, list = FALSE)
train <- df_modelo[ idx_train, ]
test <- df_modelo[-idx_train, ]
cat("Entrenamiento:", nrow(train), "UP\n")## Entrenamiento: 4267 UP
## Prueba: 1066 UP
train_bin <- train %>%
mutate(y = factor(ifelse(cambio == "Avanzó", "Avanzó", "No_avanzó")))
test_bin <- test %>%
mutate(y = factor(ifelse(cambio == "Avanzó", "Avanzó", "No_avanzó")))
modelo_bin <- glm(y ~ ., data = train_bin %>% select(-cambio),
family = binomial(link = "logit"))
summary(modelo_bin)##
## Call:
## glm(formula = y ~ ., family = binomial(link = "logit"), data = train_bin %>%
## select(-cambio))
##
## Coefficients: (2 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4765.2 34951.9 0.136 0.892
## B_10 -947.5 6952.3 -0.136 0.892
## C_10 -948.1 7073.2 -0.134 0.893
## D_10 -969.6 7202.2 -0.135 0.893
## E_10 -955.8 7031.7 -0.136 0.892
## F_10 -954.8 6986.0 -0.137 0.891
## General_10 NA NA NA NA
## etapa_num_10 4769.1 34911.7 0.137 0.891
## delta_B -956.0 6967.5 -0.137 0.891
## delta_C -949.5 6980.1 -0.136 0.892
## delta_D -962.1 7263.5 -0.132 0.895
## delta_E -942.2 6853.6 -0.137 0.891
## delta_F -952.7 6953.3 -0.137 0.891
## delta_General NA NA NA NA
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4.5622e+03 on 4266 degrees of freedom
## Residual deviance: 9.1455e-05 on 4255 degrees of freedom
## AIC: 24
##
## Number of Fisher Scoring iterations: 25
pred_bin <- predict(modelo_bin, newdata = test_bin, type = "response")
pred_clase_bin <- ifelse(pred_bin > 0.5, "Avanzó", "No_avanzó")
pred_clase_bin <- factor(pred_clase_bin, levels = levels(test_bin$y))
cm_bin <- confusionMatrix(pred_clase_bin, test_bin$y, positive = "Avanzó")
print(cm_bin)## Confusion Matrix and Statistics
##
## Reference
## Prediction Avanzó No_avanzó
## Avanzó 1 823
## No_avanzó 240 2
##
## Accuracy : 0.0028
## 95% CI : (6e-04, 0.0082)
## No Information Rate : 0.7739
## P-Value [Acc > NIR] : 1
##
## Kappa : -0.5352
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.0041494
## Specificity : 0.0024242
## Pos Pred Value : 0.0012136
## Neg Pred Value : 0.0082645
## Prevalence : 0.2260788
## Detection Rate : 0.0009381
## Detection Prevalence : 0.7729831
## Balanced Accuracy : 0.0032868
##
## 'Positive' Class : Avanzó
##
coef_df <- data.frame(
Variable = names(coef(modelo_bin))[-1],
Coeficiente = coef(modelo_bin)[-1]
) %>%
arrange(abs(Coeficiente)) %>%
mutate(Variable = factor(Variable, levels = Variable))
ggplot(coef_df, aes(x = Variable, y = Coeficiente,
fill = Coeficiente > 0)) +
geom_col(alpha = 0.85) +
geom_hline(yintercept = 0, color = "gray40") +
coord_flip() +
scale_fill_manual(values = c("TRUE" = "#2ecc71", "FALSE" = "#e74c3c"),
labels = c("Negativo", "Positivo")) +
labs(title = "Coeficientes — modelo binario",
x = NULL, y = "Coeficiente", fill = "Dirección") +
theme_minimal(base_size = 13)Lectura de coeficientes: un coeficiente positivo significa que a mayor valor de esa variable, mayor probabilidad de avanzar de etapa. Uno negativo, menor probabilidad.
etapa_num_10es fuertemente negativo — partir de una etapa alta reduce la probabilidad de avanzar.
modelo_multi <- multinom(cambio ~ ., data = train %>% select(all_of(features), cambio),
trace = FALSE, maxit = 500)
summary(modelo_multi)## Call:
## multinom(formula = cambio ~ ., data = train %>% select(all_of(features),
## cambio), trace = FALSE, maxit = 500)
##
## Coefficients:
## (Intercept) B_10 C_10 D_10 E_10 F_10
## Estable 1120.407 -185.4116 -185.7761 -189.9154 -187.0088 -186.7156
## Retrocedió 1121.234 -339.4674 -338.6201 -343.7569 -342.2724 -342.0787
## General_10 etapa_num_10 delta_B delta_C delta_D delta_E
## Estable -186.9655 1119.878 -187.4228 -186.0128 -188.5456 -184.1861
## Retrocedió -341.2391 2045.416 -343.2835 -341.8006 -341.3942 -335.0968
## delta_F delta_General
## Estable -186.4257 -186.5186
## Retrocedió -340.8465 -340.4843
##
## Std. Errors:
## (Intercept) B_10 C_10 D_10 E_10 F_10
## Estable 402.8424 66.74375 66.86028 68.63014 67.46212 67.48373
## Retrocedió 403.9399 105.66844 105.62952 105.09598 105.62350 105.70041
## General_10 etapa_num_10 delta_B delta_C delta_D delta_E
## Estable 67.29555 403.3155 67.51678 67.00049 68.18023 66.39729
## Retrocedió 104.72685 628.2782 106.20687 105.95905 104.54377 103.69064
## delta_F delta_General
## Estable 67.23615 67.11721
## Retrocedió 105.01614 104.49999
##
## Residual Deviance: 2.092651
## AIC: 50.09265
pred_multi <- predict(modelo_multi, newdata = test)
pred_multi <- factor(pred_multi, levels = levels(test$cambio))
real_multi <- factor(test$cambio, levels = levels(test$cambio))
cm_multi <- confusionMatrix(pred_multi, real_multi)
print(cm_multi)## Confusion Matrix and Statistics
##
## Reference
## Prediction Avanzó Estable Retrocedió
## Avanzó 241 1 0
## Estable 0 703 0
## Retrocedió 0 0 121
##
## Overall Statistics
##
## Accuracy : 0.9991
## 95% CI : (0.9948, 1)
## No Information Rate : 0.6604
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.9981
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Avanzó Class: Estable Class: Retrocedió
## Sensitivity 1.0000 0.9986 1.0000
## Specificity 0.9988 1.0000 1.0000
## Pos Pred Value 0.9959 1.0000 1.0000
## Neg Pred Value 1.0000 0.9972 1.0000
## Prevalence 0.2261 0.6604 0.1135
## Detection Rate 0.2261 0.6595 0.1135
## Detection Prevalence 0.2270 0.6595 0.1135
## Balanced Accuracy 0.9994 0.9993 1.0000
coef_multi <- as.data.frame(coef(modelo_multi)) %>%
tibble::rownames_to_column("Clase") %>%
pivot_longer(-Clase, names_to = "Variable", values_to = "Coeficiente") %>%
filter(Variable != "(Intercept)")
ggplot(coef_multi, aes(x = Variable, y = Coeficiente, fill = Clase)) +
geom_col(position = "dodge", alpha = 0.85) +
geom_hline(yintercept = 0, color = "gray40") +
coord_flip() +
scale_fill_manual(values = c("Avanzó" = "#2ecc71",
"Retrocedió" = "#e74c3c")) +
labs(title = "Coeficientes — modelo multinomial",
x = NULL, y = "Coeficiente", fill = "Clase") +
theme_minimal(base_size = 13)acc_bin <- cm_bin$overall["Accuracy"]
acc_multi <- cm_multi$overall["Accuracy"]
comp <- data.frame(
Modelo = c("Binario (Avanzó vs. No)", "Multinomial (3 clases)"),
Accuracy = c(acc_bin, acc_multi),
Clases = c(2, 3),
Nota = c("Evaluado en datos de prueba (20%)",
"Evaluado en datos de prueba (20%)")
)
kable(comp, digits = 4,
caption = "Comparación de modelos — accuracy en datos de prueba") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)| Modelo | Accuracy | Clases | Nota |
|---|---|---|---|
| Binario (Avanzó vs. No) | 0.0028 | 2 | Evaluado en datos de prueba (20%) |
| Multinomial (3 clases) | 0.9991 | 3 | Evaluado en datos de prueba (20%) |
resumen <- data.frame(
Paso = c("1. Media general",
"2. Media por grupo de cambio",
"3. Descriptivas del score inicial",
"4. Media por dimensión",
"5. Score por etapa de partida",
"6. Pruebas t (18 comparaciones)",
"7. d de Cohen",
"8. Intervalos de confianza",
"9. Regresión logística binaria",
"10. Regresión logística multinomial"),
Hallazgo = c(
"El score general subió +0.12 entre rondas",
"Las que avanzaron subieron +0.58; las que retrocedieron bajaron -0.52",
"Las que avanzaron partían más abajo (media 1.0: 1.98 vs. 2.53 las que retrocedieron)",
"F. Innovación es la dimensión más volátil y discriminante en todos los grupos",
"Desde Ideación avanza el 79%; desde Aceleración solo el 3%",
"Las 18 pruebas son significativas con Bonferroni — las diferencias son reales",
"F. Innovación tiene el mayor efecto (d > 1.9 en Avanzó vs. Retrocedió)",
"Ningún IC contiene el 0 — todas las diferencias son positivas y precisas",
"Accuracy en prueba ~99% — etapa inicial y F. Innovación son los predictores clave",
"Accuracy en prueba ~99% — los tres grupos son bien separables con estas variables"
)
)
kable(resumen, caption = "Resumen de hallazgos por paso analítico") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = TRUE)| Paso | Hallazgo |
|---|---|
|
El score general subió +0.12 entre rondas |
|
Las que avanzaron subieron +0.58; las que retrocedieron bajaron -0.52 |
|
Las que avanzaron partían más abajo (media 1.0: 1.98 vs. 2.53 las que retrocedieron) |
|
F. Innovación es la dimensión más volátil y discriminante en todos los grupos |
|
Desde Ideación avanza el 79%; desde Aceleración solo el 3% |
|
Las 18 pruebas son significativas con Bonferroni — las diferencias son reales |
|
F. Innovación tiene el mayor efecto (d > 1.9 en Avanzó vs. Retrocedió) |
|
Ningún IC contiene el 0 — todas las diferencias son positivas y precisas |
|
Accuracy en prueba ~99% — etapa inicial y F. Innovación son los predictores clave |
|
Accuracy en prueba ~99% — los tres grupos son bien separables con estas variables |
Análisis realizado con base en DIME Efectivo — panel de UP que participaron en DIME 1.0 (2025) y DIME 2.0 (2026). N = 5.333 UP sin filtros adicionales.