¿Qué es esta base y por qué es distinta?

Esta base contiene las mismas 5.333 unidades productivas (UP) que aparecen en DIME Efectivo, pero con una diferencia fundamental en la columna derecha:

DIME Efectivo: columna izquierda = DIME 1.0 real (2025), columna derecha = DIME 2.0 real (2026)
DIMES Comparativos: columna izquierda = DIME 1.0 real (2025), columna derecha = DIME 1.0 simulado — es decir, el puntaje que hubiera obtenido la UP en el instrumento 1.0 si hubiera respondido con sus respuestas de 2026

¿Para qué sirve esto? Para separar cuánto del cambio observado entre rondas se debe a la UP y cuánto se debe al cambio de instrumento. Si el instrumento 2.0 es más o menos exigente que el 1.0, eso contamina la comparación. Al recalcular el puntaje 2026 con las ponderaciones 2025, se elimina ese efecto y el cambio observado refleja solo el cambio real de la UP.

Interpretación del delta entre bases: la diferencia entre el delta de DIMES Comparativos (+0.19) y el delta de DIME Efectivo (+0.12) = 0.07 puntos atribuibles al cambio de instrumento. El instrumento 2.0 es ligeramente más exigente — las UP obtienen menos puntaje con el mismo comportamiento.

0. Paquetes y carga de datos

# Si no tenés alguno: install.packages("nombre")
library(readxl)
library(dplyr)
library(tidyr)
library(ggplot2)
library(knitr)
library(kableExtra)
library(nnet)        # regresión logística multinomial (multinom)
library(caret)       # train/test, métricas, matriz de confusión
library(pROC)        # curvas ROC
library(ggridges)    # gráficos de densidad por grupo
library(scales)      # formato de ejes

# Ajustá la ruta al archivo en tu computador
df_raw <- read_excel(
  "C:/Users/Helen Granados R/OneDrive - Universidad Nacional de Colombia/Escritorio/SDDE/DIMES COPARATIVOS.xlsx",
  skip = 1
)

# La primera fila (skip=1) es el encabezado real
# Columnas 1-11: DIME 1.0 real (2025)
# Columnas 12-22: DIME 1.0 simulado con ponderaciones 2025 aplicadas a respuestas 2026

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_sim", "NUM_DOC_sim", "LOCALIDAD_F_sim",
                           "RAZON_SOCIAL_sim",
                           "B_sim", "C_sim", "D_sim", "E_sim", "F_sim",
                           "General_sim", "Etapa_sim")

cat("Dimensiones del dataset:", nrow(df_raw), "filas x", ncol(df_raw), "columnas\n")

## Dimensiones del dataset: 5333 filas x 22 columnas

glimpse(df_raw)

## Rows: 5,333
## Columns: 22
## $ GlobalID_10      <chr> "a5a1cb3e-6694-4615-8d01-a0bc6aef8b22", "a6c04619-aa8…
## $ 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", "Ero…
## $ B_10             <dbl> 3.666700, 2.500150, 3.334000, 3.583275, 3.000000, 2.0…
## $ 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.0…
## $ E_10             <dbl> 1.1088, 1.1088, 1.5499, 2.6587, 3.4276, 0.5544, 1.991…
## $ F_10             <dbl> 3.788400, 3.752633, 2.337383, 3.803117, 2.448450, 1.3…
## $ General_10       <dbl> 2.730635, 2.174572, 2.261572, 2.912593, 2.599305, 1.1…
## $ Etapa_10         <chr> "Crecimiento", "Crecimiento", "Crecimiento", "Crecimi…
## $ GlobalID_sim     <chr> "75874f8e-d451-49d7-8a07-f537008581dd", "0526ffc9-28b…
## $ NUM_DOC_sim      <chr> "79627952", "1014290189", "1031129746", "900946632", …
## $ LOCALIDAD_F_sim  <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE,…
## $ RAZON_SOCIAL_sim <chr> "Go producción y publicidad", "vellier", "Eros Design…
## $ B_sim            <dbl> 4.333400, 3.000700, 4.000700, 3.916575, 2.333400, 3.9…
## $ C_sim            <dbl> 1.71970, 1.25205, 2.48330, 1.51530, 1.81360, 2.10100,…
## $ D_sim            <dbl> 2.667500, 2.006175, 2.795625, 2.359175, 1.690175, 1.5…
## $ E_sim            <dbl> 1.1088, 1.6632, 1.6632, 2.1043, 3.4276, 1.1088, 1.991…
## $ F_sim            <dbl> 2.837600, 2.599900, 3.443400, 2.599900, 2.751350, 2.3…
## $ General_sim      <dbl> 2.533400, 2.104405, 2.877245, 2.499050, 2.403225, 2.2…
## $ Etapa_sim        <chr> "Crecimiento", "Crecimiento", "Crecimiento", "Crecimi…

1. Construcción de variables derivadas

Antes de cualquier análisis necesitamos construir las variables que no están directamente en la base: el cambio de etapa, la dirección de ese cambio, y los deltas por dimensión.

# Orden numérico de las etapas de madurez empresarial
# Esto nos permite calcular diferencias numéricas entre etapas
orden_etapas <- c("Ideación" = 0, "Nacimiento" = 1,
                  "Crecimiento" = 2, "Aceleración" = 3, "Madurez" = 4)

df <- df_raw %>%
  mutate(
    # Convertir etapas a números para poder restarlas
    etapa_num_10  = orden_etapas[Etapa_10],
    etapa_num_sim = orden_etapas[Etapa_sim],

    # Diferencia numérica entre etapas: positivo = avanzó, negativo = retrocedió
    delta_etapa = etapa_num_sim - etapa_num_10,

    # Variable Y: dirección del cambio de etapa
    # Esta es la variable que queremos predecir con los modelos
    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: cuánto cambió cada área entre 1.0 real y 1.0 simulado
    # Un delta positivo = la UP mejoró en esa dimensión (controlando el instrumento)
    delta_B       = B_sim   - B_10,
    delta_C       = C_sim   - C_10,
    delta_D       = D_sim   - D_10,
    delta_E       = E_sim   - E_10,
    delta_F       = F_sim   - F_10,
    delta_General = General_sim - General_10
  )

# Resumen de la variable principal
cat("=== Distribución del cambio de etapa ===\n")

## === Distribución del cambio de etapa ===

print(table(df$cambio))

## 
##     Avanzó    Estable Retrocedió 
##       1466       3372        495

cat("\n")

cat("Porcentajes:\n")

## Porcentajes:

print(round(prop.table(table(df$cambio)) * 100, 1))

## 
##     Avanzó    Estable Retrocedió 
##       27.5       63.2        9.3

Nota metodológica: en esta base, el “cambio” de etapa se calcula comparando la etapa según el instrumento 1.0 real (2025) con la etapa que habría obtenido la UP si se le hubiera aplicado el instrumento 1.0 con sus respuestas de 2026. Esto es distinto a DIME Efectivo donde se compara la etapa real en ambas rondas.

2. Estadística descriptiva

2.1 Score general: DIME 1.0 real vs. 1.0 simulado

El punto de partida más básico: ¿cuánto cambió el score promedio de la muestra entre el instrumento real de 2025 y el simulado con respuestas de 2026?

resumen_general <- data.frame(
  Medición      = c("DIME 1.0 real (2025)",
                    "DIME 1.0 simulado — respuestas 2026 con ponderaciones 2025"),
  N             = c(nrow(df), nrow(df)),
  Media         = c(mean(df$General_10, na.rm = TRUE),
                    mean(df$General_sim, na.rm = TRUE)),
  Mediana       = c(median(df$General_10, na.rm = TRUE),
                    median(df$General_sim, na.rm = TRUE)),
  Std           = c(sd(df$General_10, na.rm = TRUE),
                    sd(df$General_sim, na.rm = TRUE)),
  Min           = c(min(df$General_10, na.rm = TRUE),
                    min(df$General_sim, na.rm = TRUE)),
  Max           = c(max(df$General_10, na.rm = TRUE),
                    max(df$General_sim, na.rm = TRUE))
)

kable(resumen_general, digits = 4,
      caption = "Score general promedio: 1.0 real vs. 1.0 simulado") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)

Score general promedio: 1.0 real vs. 1.0 simulado
Medición	N	Media	Mediana	Std	Min	Max
DIME 1.0 real (2025)	5333	2.1625	2.1296	0.6200	0.4351	4.3804
DIME 1.0 simulado — respuestas 2026 con ponderaciones 2025	5333	2.3535	2.3095	0.6018	0.6294	4.5878

cat("\nDiferencia (simulado - real):",
    round(mean(df$General_sim) - mean(df$General_10), 4), "\n")

## 
## Diferencia (simulado - real): 0.191

# Comparación de distribuciones
df %>%
  select(General_10, General_sim) %>%
  pivot_longer(everything(),
               names_to = "Medición",
               values_to = "Score") %>%
  mutate(Medición = recode(Medición,
    "General_10"  = "DIME 1.0 real (2025)",
    "General_sim" = "DIME 1.0 simulado (2026)")) %>%
  ggplot(aes(x = Score, fill = Medición)) +
  geom_density(alpha = 0.5) +
  geom_vline(xintercept = mean(df$General_10),
             linetype = "dashed", color = "#3498db", linewidth = 0.8) +
  geom_vline(xintercept = mean(df$General_sim),
             linetype = "dashed", color = "#e74c3c", linewidth = 0.8) +
  scale_fill_manual(values = c("DIME 1.0 real (2025)"     = "#3498db",
                               "DIME 1.0 simulado (2026)" = "#e74c3c")) +
  labs(title    = "Distribución del score general: 1.0 real vs. 1.0 simulado",
       subtitle = "Las líneas punteadas indican las medias de cada distribución",
       x = "Score general", y = "Densidad", fill = NULL) +
  theme_minimal(base_size = 13) +
  theme(legend.position = "bottom")

2.2 Score por dimensión: 1.0 real vs. 1.0 simulado

Ahora desagregamos el score general en sus cinco componentes para ver qué dimensión cambió más entre mediciones.

dims_comparativa <- data.frame(
  Dimension = c("B. Desarrollo producto", "C. Liderazgo",
                "D. Mercado y ventas", "E. Contabilidad", "F. Innovación"),
  Media_10  = c(mean(df$B_10), mean(df$C_10), mean(df$D_10),
                mean(df$E_10), mean(df$F_10)),
  Media_sim = c(mean(df$B_sim), mean(df$C_sim), mean(df$D_sim),
                mean(df$E_sim), mean(df$F_sim))
) %>%
  mutate(Delta = Media_sim - Media_10)

kable(dims_comparativa, digits = 4,
      col.names = c("Dimensión", "Media 1.0 real", "Media 1.0 simulado", "Delta"),
      caption = "Score promedio por dimensión: 1.0 real vs. 1.0 simulado") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE) %>%
  column_spec(4, color = ifelse(dims_comparativa$Delta > 0, "darkgreen", "red"))

Score promedio por dimensión: 1.0 real vs. 1.0 simulado
Dimensión	Media 1.0 real	Media 1.0 simulado	Delta
B. Desarrollo producto	2.8930	3.3259	0.4329
C. Liderazgo	1.7895	1.8364	0.0470
D. Mercado y ventas	1.8328	1.8271	-0.0058
E. Contabilidad	1.8514	1.8369	-0.0145
F. Innovación	2.4455	2.9411	0.4956

dims_comparativa %>%
  pivot_longer(c(Media_10, Media_sim),
               names_to = "Medicion", values_to = "Media") %>%
  mutate(Medicion = recode(Medicion,
    "Media_10"  = "1.0 real",
    "Media_sim" = "1.0 simulado")) %>%
  ggplot(aes(x = Dimension, y = Media, fill = Medicion)) +
  geom_col(position = "dodge", alpha = 0.85) +
  scale_fill_manual(values = c("1.0 real" = "#3498db",
                               "1.0 simulado" = "#e74c3c")) +
  labs(title    = "Score promedio por dimensión: 1.0 real vs. 1.0 simulado",
       subtitle = "Diferencia atribuible solo al cambio en las respuestas de las UP (instrumento controlado)",
       x = NULL, y = "Score promedio", fill = "Medición") +
  theme_minimal(base_size = 13) +
  theme(axis.text.x = element_text(angle = 20, hjust = 1),
        legend.position = "bottom")

2.3 Distribución del cambio de etapa por grupo

paso2 <- df %>%
  group_by(cambio) %>%
  summarise(
    n              = n(),
    Pct            = n() / nrow(df) * 100,
    Media_10       = mean(General_10, na.rm = TRUE),
    Media_sim      = mean(General_sim, na.rm = TRUE),
    Delta_General  = mean(delta_General, na.rm = TRUE)
  )

kable(paso2, digits = c(0, 0, 1, 4, 4, 4),
      col.names = c("Grupo", "n", "%", "Media 1.0 real",
                    "Media 1.0 sim", "Delta General"),
      caption = "Score general por grupo de cambio de etapa") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)

Score general por grupo de cambio de etapa
Grupo	n	%	Media 1.0 real	Media 1.0 sim	Delta General
Avanzó	1466	27.5	1.9656	2.5781	0.6126
Estable	3372	63.2	2.1870	2.2956	0.1086
Retrocedió	495	9.3	2.5787	2.0829	-0.4958

ggplot(df, aes(x = cambio, y = delta_General, fill = cambio)) +
  geom_violin(alpha = 0.4, trim = FALSE) +
  geom_boxplot(width = 0.15, alpha = 0.8, outlier.size = 0.5) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "gray40") +
  stat_summary(fun = mean, geom = "point", shape = 18,
               size = 4, color = "black") +
  scale_fill_manual(values = c("Avanzó"     = "#2ecc71",
                               "Estable"    = "#3498db",
                               "Retrocedió" = "#e74c3c")) +
  labs(title    = "Distribución del delta en score general por grupo",
       subtitle = "El rombo negro marca la media; la caja marca el rango intercuartílico",
       x = NULL, y = "Delta score general (simulado − real)",
       fill = "Grupo") +
  theme_minimal(base_size = 13) +
  theme(legend.position = "none")

2.4 Descriptivas completas del score inicial por grupo

¿Las UP que avanzaron partían de scores más bajos? Esta es una pregunta clave para entender el fenómeno: si hay un efecto de piso (las que tienen más margen suben más), el score inicial predice el cambio.

paso3 <- df %>%
  group_by(cambio) %>%
  summarise(
    n        = n(),
    Media    = mean(General_10, na.rm = TRUE),
    Mediana  = median(General_10, na.rm = TRUE),
    Std      = sd(General_10, na.rm = TRUE),
    Q1       = quantile(General_10, 0.25, na.rm = TRUE),
    Q3       = quantile(General_10, 0.75, na.rm = TRUE),
    IQR      = IQR(General_10, na.rm = TRUE),
    Min      = min(General_10, na.rm = TRUE),
    Max      = max(General_10, na.rm = TRUE)
  )

kable(paso3, digits = 4,
      caption = "Descriptivas del score inicial (1.0 real) por grupo de cambio") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = TRUE)

Descriptivas del score inicial (1.0 real) por grupo de cambio
cambio	n	Media	Mediana	Std	Q1	Q3	IQR	Min	Max
Avanzó	1466	1.9656	1.8859	0.5676	1.6437	2.4004	0.7567	0.4351	3.8268
Estable	3372	2.1870	2.1951	0.6111	1.7030	2.5732	0.8702	0.6028	3.9927
Retrocedió	495	2.5787	2.3788	0.5942	2.1185	3.0938	0.9753	1.0583	4.3804

Lectura: si el Q3 de “Avanzó” es menor que el Q1 de “Retrocedió”, significa que el 75% de las que avanzaron tenía un score inicial menor que el 75% de las que retrocedieron. Eso confirmaría el efecto de piso.

# Gráfico de densidad por grupo — muestra dónde se concentra cada grupo en el score inicial
ggplot(df, aes(x = General_10, y = cambio, fill = cambio)) +
  geom_density_ridges(alpha = 0.7, scale = 1.2,
                      quantile_lines = TRUE, quantiles = c(0.25, 0.5, 0.75)) +
  scale_fill_manual(values = c("Avanzó"     = "#2ecc71",
                               "Estable"    = "#3498db",
                               "Retrocedió" = "#e74c3c")) +
  labs(title    = "Distribución del score inicial (1.0 real) por grupo",
       subtitle = "Las líneas verticales dentro de cada banda marcan Q1, mediana y Q3",
       x = "Score general DIME 1.0 real", y = NULL, fill = "Grupo") +
  theme_minimal(base_size = 13) +
  theme(legend.position = "none")

2.5 Delta por dimensión y grupo

¿Qué dimensión se mueve más en las que avanzan? ¿Y en las que retroceden?

paso4 <- df %>%
  group_by(cambio) %>%
  summarise(
    `B. Desarrollo` = mean(delta_B, na.rm = TRUE),
    `C. Liderazgo`  = mean(delta_C, na.rm = TRUE),
    `D. Mercado`    = mean(delta_D, na.rm = TRUE),
    `E. Contabilidad` = mean(delta_E, na.rm = TRUE),
    `F. Innovación` = mean(delta_F, na.rm = TRUE),
    General         = mean(delta_General, na.rm = TRUE)
  )

kable(paso4, digits = 4,
      caption = "Delta promedio por dimensión y grupo de cambio") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = TRUE) %>%
  column_spec(2:7,
    color = ifelse(
      as.matrix(paso4[,-1]) > 0, "darkgreen", "red"
    ))

Delta promedio por dimensión y grupo de cambio
cambio	B. Desarrollo	C. Liderazgo	D. Mercado	E. Contabilidad	F. Innovación	General
Avanzó	0.8810	0.3750	0.2759	0.3583	1.1727	0.6126
Estable	0.3426	-0.0167	-0.0628	-0.0718	0.3517	0.1086
Retrocedió	-0.2791	-0.4904	-0.4514	-0.7287	-0.5292	-0.4958

paso4 %>%
  pivot_longer(-cambio, names_to = "Dimension", values_to = "Delta") %>%
  ggplot(aes(x = Dimension, y = Delta, 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")) +
  labs(title    = "Delta promedio por dimensión y grupo",
       subtitle = "Controlando el instrumento — diferencias atribuibles solo a cambio en las UP",
       x = NULL, y = "Delta promedio (sim − real)", fill = "Grupo") +
  theme_minimal(base_size = 13) +
  theme(axis.text.x = element_text(angle = 20, hjust = 1),
        legend.position = "bottom")

2.6 Score inicial y cambio por etapa de partida

etapas_orden <- c("Ideación","Nacimiento","Crecimiento","Aceleración","Madurez")

paso5 <- df %>%
  mutate(Etapa_10 = factor(Etapa_10, levels = etapas_orden)) %>%
  group_by(Etapa_10) %>%
  summarise(
    n           = n(),
    Media_10    = mean(General_10, na.rm = TRUE),
    Mediana_10  = median(General_10, na.rm = TRUE),
    Pct_Avanzó  = mean(cambio == "Avanzó",     na.rm = TRUE) * 100,
    Pct_Estable = mean(cambio == "Estable",    na.rm = TRUE) * 100,
    Pct_Retro   = mean(cambio == "Retrocedió", na.rm = TRUE) * 100
  ) %>%
  arrange(Etapa_10)

kable(paso5, digits = c(0, 0, 4, 4, 1, 1, 1),
      col.names = c("Etapa inicial", "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)

Score inicial y dirección de cambio por etapa de partida
Etapa inicial	n	Media 1.0	Mediana 1.0	% Avanzó	% Estable	% Retrocedió
Ideación	96	0.8307	0.8710	86.5	13.5	0.0
Nacimiento	2137	1.6196	1.6512	42.9	56.1	1.0
Crecimiento	2561	2.4244	2.3931	17.6	71.1	11.3
Aceleración	530	3.2922	3.2391	2.8	64.3	32.8
Madurez	9	4.1753	4.1542	0.0	0.0	100.0

paso5 %>%
  pivot_longer(c(Pct_Avanzó, Pct_Estable, Pct_Retro),
               names_to = "Direccion", values_to = "Pct") %>%
  mutate(Direccion = recode(Direccion,
    "Pct_Avanzó"  = "Avanzó",
    "Pct_Estable" = "Estable",
    "Pct_Retro"   = "Retrocedió")) %>%
  ggplot(aes(x = Etapa_10, y = Pct, fill = Direccion)) +
  geom_col(position = "stack", alpha = 0.85) +
  scale_fill_manual(values = c("Avanzó"     = "#2ecc71",
                               "Estable"    = "#3498db",
                               "Retrocedió" = "#e74c3c")) +
  labs(title    = "Dirección del cambio de etapa por etapa de partida",
       subtitle = "A menor etapa de partida, mayor probabilidad de avanzar",
       x = "Etapa inicial (DIME 1.0)", y = "% de UP", fill = "Dirección") +
  theme_minimal(base_size = 13) +
  theme(legend.position = "bottom")

3. Pruebas de hipótesis

3.1 ¿Qué estamos probando y por qué?

Las descriptivas muestran diferencias entre grupos. Pero esas diferencias se calcularon en una muestra de 5.333 UP — no en toda la población de empresas bogotanas. La pregunta estadística es:

¿Las diferencias observadas en la muestra reflejan diferencias reales en la población, o pudieron aparecer por azar?

Para responderla usamos la prueba t de Student para dos muestras independientes. Esta prueba contrasta:

H₀: la diferencia en el delta de score entre los dos grupos es 0 (no hay diferencia real — lo observado es azar)
H₁: la diferencia es distinta de 0 (hay una diferencia real en la población)

El estadístico t mide qué tan grande es la diferencia relativa al ruido (variabilidad) de los datos. Si t es muy grande, el p-valor es pequeño, y rechazamos H₀.

3.2 El problema de comparaciones múltiples y la corrección de Bonferroni

Tenemos 3 grupos × 6 dimensiones = 18 pruebas. Si usáramos p < 0.05 en cada una, la probabilidad de encontrar al menos un falso positivo por puro azar sería:

\[1 - (0.95)^{18} \approx 60\%\]

Para controlar esto, aplicamos la corrección de Bonferroni: dividimos el umbral entre el número de pruebas.

\[\alpha_{\text{corregido}} = \frac{0.05}{18} \approx 0.00278\]

Solo rechazamos H₀ si p < 0.00278.

alpha_bonf <- 0.05 / 18
cat("Alpha corregido (Bonferroni, 18 pruebas):", round(alpha_bonf, 5), "\n\n")

## Alpha corregido (Bonferroni, 18 pruebas): 0.00278

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, var.equal = FALSE)  # Welch t-test (no asume varianzas iguales)
    data.frame(
      Comparacion   = paste(par[1], "vs.", par[2]),
      Dimension     = dim_nombre,
      n_A           = length(a),
      n_B           = length(b),
      Media_A       = mean(a, na.rm = TRUE),
      Media_B       = mean(b, na.rm = TRUE),
      Diferencia    = mean(a, na.rm = TRUE) - mean(b, na.rm = TRUE),
      t_stat        = tt$statistic,
      gl            = tt$parameter,
      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(Comparacion, Dimension, Media_A, Media_B, Diferencia, t_stat, p_valor, Significativo),
  digits  = c(0, 0, 4, 4, 4, 3, 6, 0),
  col.names = c("Comparación", "Dimensión", "Media A", "Media B",
                "Diferencia", "t", "p-valor", "Significativo"),
  caption = paste0("Pruebas t de Welch con corrección Bonferroni (α = ",
                   round(alpha_bonf, 5), ")")
) %>%
  kable_styling(bootstrap_options = c("striped","hover"),
                full_width = TRUE, font_size = 12)

Pruebas t de Welch con corrección Bonferroni (α = 0.00278)
	Comparación	Dimensión	Media A	Media B	Diferencia	t	Significativo
t…1	Avanzó vs. Estable	B. Desarrollo	0.8810	0.3426	0.5384	24.986	Sí ✓
t…2	Avanzó vs. Estable	C. Liderazgo	0.3750	-0.0167	0.3917	23.000	Sí ✓
t…3	Avanzó vs. Estable	D. Mercado	0.2759	-0.0628	0.3386	24.183	Sí ✓
t…4	Avanzó vs. Estable	E. Contabilidad	0.3583	-0.0718	0.4300	19.844	Sí ✓
t…5	Avanzó vs. Estable	F. Innovación	1.1727	0.3517	0.8210	29.000	Sí ✓
t…6	Avanzó vs. Estable	General	0.6126	0.1086	0.5039	52.111	Sí ✓
t…7	Avanzó vs. Retrocedió	B. Desarrollo	0.8810	-0.2791	1.1601	31.314	Sí ✓
t…8	Avanzó vs. Retrocedió	C. Liderazgo	0.3750	-0.4904	0.8654	31.258	Sí ✓
t…9	Avanzó vs. Retrocedió	D. Mercado	0.2759	-0.4514	0.7273	29.226	Sí ✓
t…10	Avanzó vs. Retrocedió	E. Contabilidad	0.3583	-0.7287	1.0869	26.029	Sí ✓
t…11	Avanzó vs. Retrocedió	F. Innovación	1.1727	-0.5292	1.7019	34.335	Sí ✓
t…12	Avanzó vs. Retrocedió	General	0.6126	-0.4958	1.1083	69.146	Sí ✓
t…13	Estable vs. Retrocedió	B. Desarrollo	0.3426	-0.2791	0.6217	17.845	Sí ✓
t…14	Estable vs. Retrocedió	C. Liderazgo	-0.0167	-0.4904	0.4737	18.875	Sí ✓
t…15	Estable vs. Retrocedió	D. Mercado	-0.0628	-0.4514	0.3887	16.910	Sí ✓
t…16	Estable vs. Retrocedió	E. Contabilidad	-0.0718	-0.7287	0.6569	16.610	Sí ✓
t…17	Estable vs. Retrocedió	F. Innovación	0.3517	-0.5292	0.8809	19.129	Sí ✓
t…18	Estable vs. Retrocedió	General	0.1086	-0.4958	0.6044	41.247	Sí ✓

Nota metodológica: usamos la prueba t de Welch (var.equal = FALSE) en lugar de la t clásica porque no asume igualdad de varianzas entre grupos, lo que la hace más robusta. El precio es que los grados de libertad (gl) son decimales.

3.3 Tamaño del efecto — d de Cohen

El p-valor dice si la diferencia es real. La d de Cohen dice qué tan grande es esa diferencia en términos prácticos, independientemente del tamaño de muestra.

\[d = \frac{\bar{x}_A - \bar{x}_B}{s_{\text{combinada}}}\]

Donde \(s_{\text{combinada}}\) es la desviación estándar ponderada de los dos grupos.

Valor de	d
< 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) {
  na <- length(a); nb <- length(b)
  s_pool <- sqrt(((na - 1) * var(a, na.rm = TRUE) +
                  (nb - 1) * var(b, na.rm = TRUE)) / (na + nb - 2))
  (mean(a, na.rm = TRUE) - mean(b, na.rm = TRUE)) / s_pool
}

etiqueta_d <- function(d) {
  d <- abs(d)
  dplyr::case_when(
    d < 0.2 ~ "Trivial",
    d < 0.5 ~ "Pequeño",
    d < 0.8 ~ "Mediano",
    d < 1.0 ~ "Grande",
    TRUE    ~ "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, na.rm = TRUE) - mean(b, na.rm = TRUE),
      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)

Tamaño del efecto (d de Cohen) por comparación y dimensión
Comparacion	Dimension	Diferencia	d_Cohen	Magnitud
Avanzó vs. Estable	B. Desarrollo	0.5384	0.7633	Mediano
Avanzó vs. Estable	C. Liderazgo	0.3917	0.7469	Mediano
Avanzó vs. Estable	D. Mercado	0.3386	0.7825	Mediano
Avanzó vs. Estable	E. Contabilidad	0.4300	0.6175	Mediano
Avanzó vs. Estable	F. Innovación	0.8210	0.9183	Grande
Avanzó vs. Estable	General	0.5039	1.6759	Muy grande
Avanzó vs. Retrocedió	B. Desarrollo	1.1601	1.6852	Muy grande
Avanzó vs. Retrocedió	C. Liderazgo	0.8654	1.5723	Muy grande
Avanzó vs. Retrocedió	D. Mercado	0.7273	1.5623	Muy grande
Avanzó vs. Retrocedió	E. Contabilidad	1.0869	1.4887	Muy grande
Avanzó vs. Retrocedió	F. Innovación	1.7019	1.8359	Muy grande
Avanzó vs. Retrocedió	General	1.1083	3.5403	Muy grande
Estable vs. Retrocedió	B. Desarrollo	0.6217	0.8650	Grande
Estable vs. Retrocedió	C. Liderazgo	0.4737	0.9280	Grande
Estable vs. Retrocedió	D. Mercado	0.3887	0.9044	Grande
Estable vs. Retrocedió	E. Contabilidad	0.6569	0.9144	Grande
Estable vs. Retrocedió	F. Innovación	0.8809	0.9827	Grande
Estable vs. Retrocedió	General	0.6044	2.0445	Muy grande

resultados_d %>%
  mutate(
    Magnitud = factor(Magnitud,
                      levels = c("Trivial","Pequeño","Mediano",
                                 "Grande","Muy grande")),
    Comparacion = factor(Comparacion,
                         levels = c("Avanzó vs. Estable",
                                    "Avanzó vs. Retrocedió",
                                    "Estable vs. Retrocedió"))
  ) %>%
  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.55,
           y     = c(0.23, 0.53, 0.83, 1.03),
           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",
       subtitle = "Las líneas punteadas marcan los umbrales de magnitud convencionales",
       x = NULL, y = "|d de Cohen|", fill = "Comparación") +
  scale_fill_brewer(palette = "Set2") +
  theme_minimal(base_size = 13) +
  theme(axis.text.x = element_text(angle = 20, hjust = 1),
        legend.position = "bottom")

3.4 Intervalos de confianza al 95%

El intervalo de confianza (IC) al 95% estima el rango plausible de la diferencia real en la población.

Si el IC no contiene el 0 → la diferencia es significativa (consistent con p < 0.05)
Un IC estrecho indica mayor precisión en la estimación (más muestra, menos ruido)
Un IC ancho indica mayor incertidumbre

kable(
  resultados_t %>%
    select(Comparacion, Dimension, Diferencia, IC_inf, IC_sup, Significativo) %>%
    mutate(Ancho_IC = IC_sup - IC_inf),
  digits = 4,
  col.names = c("Comparación", "Dimensión", "Diferencia",
                "IC 95% inf", "IC 95% sup", "Significativo", "Ancho IC"),
  caption = "Intervalos de confianza al 95% para la diferencia de medias"
) %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = TRUE)

Intervalos de confianza al 95% para la diferencia de medias
	Comparación	Dimensión	Diferencia	IC 95% inf	IC 95% sup	Significativo	Ancho IC
t…1	Avanzó vs. Estable	B. Desarrollo	0.5384	0.4962	0.5807	Sí ✓	0.0845
t…2	Avanzó vs. Estable	C. Liderazgo	0.3917	0.3583	0.4251	Sí ✓	0.0668
t…3	Avanzó vs. Estable	D. Mercado	0.3386	0.3112	0.3661	Sí ✓	0.0549
t…4	Avanzó vs. Estable	E. Contabilidad	0.4300	0.3875	0.4725	Sí ✓	0.0850
t…5	Avanzó vs. Estable	F. Innovación	0.8210	0.7655	0.8765	Sí ✓	0.1110
t…6	Avanzó vs. Estable	General	0.5039	0.4850	0.5229	Sí ✓	0.0379
t…7	Avanzó vs. Retrocedió	B. Desarrollo	1.1601	1.0874	1.2329	Sí ✓	0.1454
t…8	Avanzó vs. Retrocedió	C. Liderazgo	0.8654	0.8110	0.9197	Sí ✓	0.1087
t…9	Avanzó vs. Retrocedió	D. Mercado	0.7273	0.6785	0.7761	Sí ✓	0.0977
t…10	Avanzó vs. Retrocedió	E. Contabilidad	1.0869	1.0050	1.1689	Sí ✓	0.1640
t…11	Avanzó vs. Retrocedió	F. Innovación	1.7019	1.6046	1.7992	Sí ✓	0.1946
t…12	Avanzó vs. Retrocedió	General	1.1083	1.0769	1.1398	Sí ✓	0.0629
t…13	Estable vs. Retrocedió	B. Desarrollo	0.6217	0.5533	0.6902	Sí ✓	0.1368
t…14	Estable vs. Retrocedió	C. Liderazgo	0.4737	0.4244	0.5230	Sí ✓	0.0986
t…15	Estable vs. Retrocedió	D. Mercado	0.3887	0.3435	0.4338	Sí ✓	0.0903
t…16	Estable vs. Retrocedió	E. Contabilidad	0.6569	0.5792	0.7346	Sí ✓	0.1553
t…17	Estable vs. Retrocedió	F. Innovación	0.8809	0.7904	0.9713	Sí ✓	0.1809
t…18	Estable vs. Retrocedió	General	0.6044	0.5756	0.6332	Sí ✓	0.0575

resultados_t %>%
  mutate(Comparacion = factor(Comparacion,
    levels = c("Avanzó vs. Estable",
               "Avanzó vs. Retrocedió",
               "Estable vs. Retrocedió"))) %>%
  ggplot(aes(x = Dimension, y = Diferencia,
             ymin = IC_inf, ymax = IC_sup,
             color = Comparacion)) +
  geom_pointrange(position = position_dodge(width = 0.5), size = 0.7) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "gray40") +
  scale_color_brewer(palette = "Set2") +
  labs(title    = "Diferencia de medias con IC 95%",
       subtitle = "Si el IC no cruza la línea en 0, la diferencia es estadísticamente significativa",
       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),
        legend.position = "bottom")

4. Regresión logística

4.1 ¿Qué es y para qué sirve aquí?

Las pruebas anteriores comparan grupos de a pares en una variable a la vez. La regresión logística hace algo más potente: estima la probabilidad de pertenecer a cada grupo considerando todas las variables simultáneamente.

Esto responde la pregunta del Algoritmo 2: dado el perfil de una UP (scores iniciales, etapa de partida, cambios en cada dimensión), ¿cuál es la probabilidad de que avance de etapa?

Hay dos versiones:

Binaria: predice Avanzó (1) vs. No avanzó (0). Simple, directa.
Multinomial: predice los tres grupos a la vez (Avanzó / Estable / Retrocedió). Más completa y es lo que pide el Algoritmo 2.

4.2 Variables predictoras

features <- c(
  # Scores iniciales (1.0 real) — punto de partida de la UP
  "B_10", "C_10", "D_10", "E_10", "F_10", "General_10",
  # Etapa numérica de partida — dónde estaba la UP en 2025
  "etapa_num_10",
  # Deltas por dimensión — cuánto cambió cada área (controlando instrumento)
  "delta_B", "delta_C", "delta_D", "delta_E", "delta_F", "delta_General"
)

df_modelo <- df %>%
  select(all_of(features), cambio) %>%
  drop_na()

cat("N disponible para modelar:", nrow(df_modelo), "\n\n")

## N disponible para modelar: 5333

cat("Distribución de la variable Y:\n")

## Distribución de la variable Y:

print(table(df_modelo$cambio))

## 
##     Avanzó    Estable Retrocedió 
##       1466       3372        495

cat("\nPorcentajes:\n")

## 
## Porcentajes:

print(round(prop.table(table(df_modelo$cambio)) * 100, 1))

## 
##     Avanzó    Estable Retrocedió 
##       27.5       63.2        9.3

4.3 División entrenamiento / prueba (80% / 20%)

¿Por qué dividir los datos?

Si entrenamos y evaluamos el modelo en los mismos datos, el modelo “memoriza” los datos en lugar de aprender patrones generalizables — esto se llama sobreajuste (overfitting). El accuracy en esos datos será artificialmente alto y no refleja el rendimiento real.

La solución es separar los datos antes de entrenar:

Entrenamiento (80%): el modelo aprende con estos datos
Prueba (20%): se evalúa con datos que el modelo nunca vio

El parámetro stratify garantiza que la proporción de cada clase (Avanzó / Estable / Retrocedió) sea igual en entrenamiento y prueba.

set.seed(42)  # Semilla para reproducibilidad

idx_train <- createDataPartition(df_modelo$cambio, p = 0.8, list = FALSE)
train <- df_modelo[ idx_train, ]
test  <- df_modelo[-idx_train, ]

cat("=== División de datos ===\n")

## === División de datos ===

cat("Entrenamiento:", nrow(train), "UP (80%)\n")

## Entrenamiento: 4267 UP (80%)

cat("Prueba:       ", nrow(test),  "UP (20%)\n\n")

## Prueba:        1066 UP (20%)

cat("Distribución en entrenamiento:\n")

## Distribución en entrenamiento:

print(round(prop.table(table(train$cambio)) * 100, 1))

## 
##     Avanzó    Estable Retrocedió 
##       27.5       63.2        9.3

cat("\nDistribución en prueba:\n")

## 
## Distribución en prueba:

print(round(prop.table(table(test$cambio)) * 100, 1))

## 
##     Avanzó    Estable Retrocedió 
##       27.5       63.2        9.3

4.4 Modelo binario — Avanzó vs. No avanzó

# Crear variable binaria
train_bin <- train %>%
  mutate(y = factor(ifelse(cambio == "Avanzó", "Avanzó", "No_avanzó"),
                    levels = c("No_avanzó", "Avanzó")))
test_bin  <- test %>%
  mutate(y = factor(ifelse(cambio == "Avanzó", "Avanzó", "No_avanzó"),
                    levels = c("No_avanzó", "Avanzó")))

modelo_bin <- glm(y ~ . - cambio,
                  data   = train_bin,
                  family = binomial(link = "logit"))

cat("=== Resumen del modelo binario ===\n")

## === Resumen del modelo binario ===

summary(modelo_bin)

## 
## Call:
## glm(formula = y ~ . - cambio, family = binomial(link = "logit"), 
##     data = train_bin)
## 
## Coefficients: (2 not defined because of singularities)
##               Estimate Std. Error z value Pr(>|z|)
## (Intercept)      -7883      42314  -0.186    0.852
## B_10              1573       8461   0.186    0.852
## C_10              1567       8483   0.185    0.853
## D_10              1569       8421   0.186    0.852
## E_10              1562       8412   0.186    0.853
## F_10              1581       8482   0.186    0.852
## General_10          NA         NA      NA       NA
## etapa_num_10     -7837      42169  -0.186    0.853
## delta_B           1572       8450   0.186    0.852
## delta_C           1552       8455   0.184    0.854
## delta_D           1557       8356   0.186    0.852
## delta_E           1559       8388   0.186    0.853
## delta_F           1574       8446   0.186    0.852
## delta_General       NA         NA      NA       NA
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 5.0186e+03  on 4266  degrees of freedom
## Residual deviance: 1.9074e-04  on 4255  degrees of freedom
## AIC: 24
## 
## Number of Fisher Scoring iterations: 25

# Predicción en datos de prueba
pred_prob_bin <- predict(modelo_bin, newdata = test_bin, type = "response")
pred_clase_bin <- factor(
  ifelse(pred_prob_bin > 0.5, "Avanzó", "No_avanzó"),
  levels = c("No_avanzó", "Avanzó")
)

cat("=== Evaluación en datos de PRUEBA ===\n")

## === Evaluación en datos de PRUEBA ===

cm_bin <- confusionMatrix(pred_clase_bin, test_bin$y, positive = "Avanzó")
print(cm_bin)

## Confusion Matrix and Statistics
## 
##            Reference
## Prediction  No_avanzó Avanzó
##   No_avanzó       773      1
##   Avanzó            0    292
##                                      
##                Accuracy : 0.9991     
##                  95% CI : (0.9948, 1)
##     No Information Rate : 0.7251     
##     P-Value [Acc > NIR] : <2e-16     
##                                      
##                   Kappa : 0.9976     
##                                      
##  Mcnemar's Test P-Value : 1          
##                                      
##             Sensitivity : 0.9966     
##             Specificity : 1.0000     
##          Pos Pred Value : 1.0000     
##          Neg Pred Value : 0.9987     
##              Prevalence : 0.2749     
##          Detection Rate : 0.2739     
##    Detection Prevalence : 0.2739     
##       Balanced Accuracy : 0.9983     
##                                      
##        'Positive' Class : Avanzó     
##

# Visualización de coeficientes
coef_bin <- data.frame(
  Variable    = names(coef(modelo_bin))[-1],
  Coeficiente = coef(modelo_bin)[-1],
  OR          = exp(coef(modelo_bin)[-1])   # Odds ratio
) %>%
  arrange(desc(abs(Coeficiente))) %>%
  mutate(Variable = factor(Variable, levels = Variable),
         Direccion = ifelse(Coeficiente > 0, "Positivo", "Negativo"))

ggplot(coef_bin, aes(x = Variable, y = Coeficiente, fill = Direccion)) +
  geom_col(alpha = 0.85) +
  geom_hline(yintercept = 0, color = "gray30") +
  coord_flip() +
  scale_fill_manual(values = c("Positivo" = "#2ecc71",
                               "Negativo" = "#e74c3c")) +
  labs(title    = "Coeficientes del modelo binario",
       subtitle = "Positivo = mayor probabilidad de avanzar; Negativo = menor probabilidad",
       x = NULL, y = "Coeficiente (log-odds)", fill = "Dirección") +
  theme_minimal(base_size = 13) +
  theme(legend.position = "bottom")

# Curva ROC — mide la capacidad discriminativa del modelo
roc_bin <- roc(as.numeric(test_bin$y == "Avanzó"), pred_prob_bin)
plot(roc_bin,
     main = paste("Curva ROC — Modelo binario | AUC =",
                  round(auc(roc_bin), 4)),
     col  = "#3498db", lwd = 2)
abline(a = 0, b = 1, lty = 2, col = "gray50")

Lectura de la curva ROC y el AUC: el área bajo la curva (AUC) mide cuánto mejor que el azar predice el modelo. AUC = 0.5 es puro azar; AUC = 1.0 es predicción perfecta. Un AUC > 0.8 se considera bueno.

4.5 Modelo multinomial — Avanzó / Estable / Retrocedió

modelo_multi <- multinom(
  cambio ~ . ,
  data   = train %>% select(all_of(features), cambio),
  trace  = FALSE,
  maxit  = 500
)

cat("=== Resumen del modelo multinomial ===\n")

## === Resumen del modelo multinomial ===

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       1281.692 -213.5635 -213.8614 -212.3918 -211.3786 -214.0716
## Retrocedió    1276.806 -405.6342 -416.2393 -403.6647 -403.6974 -409.0044
##            General_10 etapa_num_10   delta_B   delta_C   delta_D   delta_E
## Estable     -213.0534     1276.347 -213.0323 -211.3767 -211.4106 -211.2826
## Retrocedió  -407.6480     2445.018 -404.7801 -414.3576 -404.4413 -401.7055
##              delta_F delta_General
## Estable    -213.3573     -212.0919
## Retrocedió -405.9636     -406.2496
## 
## Std. Errors:
##            (Intercept)     B_10     C_10     D_10     E_10     F_10 General_10
## Estable       167.1420 27.81218 27.79688 27.84140 27.66024 28.04231    27.7318
## Retrocedió    169.2043 43.94090 48.61873 44.17008 44.67799 45.06617    45.0003
##            etapa_num_10  delta_B  delta_C  delta_D  delta_E  delta_F
## Estable        166.0917 27.82842 27.68577 27.59923 27.58579 27.88651
## Retrocedió     270.8890 43.82424 49.02502 45.07050 43.47078 44.12061
##            delta_General
## Estable         27.60701
## Retrocedió      44.87730
## 
## Residual Deviance: 5.521315 
## AIC: 53.52131

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

cat("=== Evaluación en datos de PRUEBA ===\n")

## === Evaluación en datos de PRUEBA ===

cm_multi <- confusionMatrix(pred_multi, real_multi)
print(cm_multi)

## Confusion Matrix and Statistics
## 
##             Reference
## Prediction   Avanzó Estable Retrocedió
##   Avanzó        292       0          0
##   Estable         1     673          0
##   Retrocedió      0       1         99
## 
## Overall Statistics
##                                           
##                Accuracy : 0.9981          
##                  95% CI : (0.9932, 0.9998)
##     No Information Rate : 0.6323          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.9964          
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: Avanzó Class: Estable Class: Retrocedió
## Sensitivity                 0.9966         0.9985           1.00000
## Specificity                 1.0000         0.9974           0.99897
## Pos Pred Value              1.0000         0.9985           0.99000
## Neg Pred Value              0.9987         0.9974           1.00000
## Prevalence                  0.2749         0.6323           0.09287
## Detection Rate              0.2739         0.6313           0.09287
## Detection Prevalence        0.2739         0.6323           0.09381
## Balanced Accuracy           0.9983         0.9980           0.99948

# Coeficientes del modelo multinomial
coef_multi_df <- 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_df,
       aes(x = Variable, y = Coeficiente, fill = Clase)) +
  geom_col(position = "dodge", alpha = 0.85) +
  geom_hline(yintercept = 0, color = "gray30") +
  coord_flip() +
  scale_fill_manual(values = c("Avanzó"     = "#2ecc71",
                               "Retrocedió" = "#e74c3c")) +
  labs(title    = "Coeficientes del modelo multinomial",
       subtitle = "Lo que suma probabilidad de avanzar, le resta a retroceder, y viceversa",
       x = NULL, y = "Coeficiente (log-odds)", fill = "Clase") +
  theme_minimal(base_size = 13) +
  theme(axis.text.y = element_text(size = 9),
        legend.position = "bottom")

# Probabilidades predichas promedio por clase real
probs_multi <- predict(modelo_multi,
                       newdata = test,
                       type    = "probs") %>%
  as.data.frame() %>%
  mutate(Real = test$cambio)

probs_resumen <- probs_multi %>%
  group_by(Real) %>%
  summarise(
    P_Avanzó     = mean(Avanzó,     na.rm = TRUE),
    P_Estable    = mean(Estable,    na.rm = TRUE),
    P_Retrocedió = mean(Retrocedió, na.rm = TRUE)
  )

kable(probs_resumen, digits = 4,
      col.names = c("Clase real", "P(Avanzó)", "P(Estable)", "P(Retrocedió)"),
      caption   = "Probabilidades predichas promedio por clase real (datos de prueba)") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)

Probabilidades predichas promedio por clase real (datos de prueba)
Clase real	P(Avanzó)	P(Estable)	P(Retrocedió)
Avanzó	0.9967	0.0033	0.0000
Estable	0.0001	0.9984	0.0014
Retrocedió	0.0000	0.0000	1.0000

Lectura: la diagonal (P(Avanzó) para las que realmente avanzaron, etc.) debería ser la más alta en cada fila. Si el modelo funciona bien, cada UP tiene mayor probabilidad asignada a su clase real.

4.6 Comparación de modelos

acc_bin   <- cm_bin$overall["Accuracy"]
acc_multi <- cm_multi$overall["Accuracy"]
auc_bin   <- round(auc(roc_bin), 4)

comp <- data.frame(
  Modelo       = c("Binario (Avanzó vs. No)", "Multinomial (3 clases)"),
  Clases       = c(2, 3),
  Accuracy     = c(acc_bin, acc_multi),
  AUC          = c(auc_bin, NA),
  Evaluado_en  = c("Datos de prueba (20%)", "Datos de prueba (20%)"),
  Nota         = c(
    "Si accuracy ≈ % de la clase mayoritaria, el modelo no aprendió nada",
    "Considera las tres trayectorias simultáneamente"
  )
)

kable(comp, digits = 4,
      caption = "Comparación de modelos — evaluación en datos de prueba") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = TRUE)

Comparación de modelos — evaluación en datos de prueba
Modelo	Clases	Accuracy	AUC	Evaluado_en	Nota
Binario (Avanzó vs. No)	2	0.9991	1	Datos de prueba (20%)	Si accuracy ≈ % de la clase mayoritaria, el modelo no aprendió nada
Multinomial (3 clases)	3	0.9981	NA	Datos de prueba (20%)	Considera las tres trayectorias simultáneamente

Advertencia sobre el modelo binario: si el accuracy del modelo binario es aproximadamente igual al porcentaje de UP que no avanzaron (~72.5%), significa que el modelo clasificó todo como “No avanza” y no aprendió a distinguir. En ese caso el modelo multinomial es preferible.

5. Comparación con DIME Efectivo

Esta sección es clave para entender qué aporta cada base.

comp_bases <- data.frame(
  Indicador = c(
    "N", "Delta score general",
    "% Avanzó", "% Estable", "% Retrocedió",
    "Media score inicial — Avanzó",
    "Media score inicial — Retrocedió",
    "F. Innovación delta — Avanzó",
    "E. Contabilidad delta — Retrocedió",
    "Accuracy multinomial (prueba)"
  ),
  DIME_Efectivo = c(
    "5.333", "+0.12",
    "22.6%", "66.0%", "11.4%",
    "1.9779", "2.5281",
    "+0.9705", "-0.6081", "~98.9%"
  ),
  DIMES_Comparativos = c(
    "5.333", "+0.19",
    "27.5%", "63.2%",  "9.3%",
    "1.9656", "2.5787",
    "+1.1727", "-0.7287", "~98.1%"
  ),
  Interpretacion = c(
    "Misma muestra",
    "Diferencia de 0.07 atribuible al instrumento",
    "Con ponderaciones 2025 hay más avances aparentes",
    "Menor proporción estable",
    "Menos retrocesos aparentes",
    "Similar — patrón de piso consistente",
    "Similar — patrón de techo consistente",
    "Mayor movimiento en Innovación (instrumento controlado)",
    "Mayor caída en Contabilidad (instrumento controlado)",
    "Desempeño similar en ambas bases"
  )
)

kable(comp_bases,
      col.names = c("Indicador", "DIME Efectivo", "DIMES Comparativos", "Interpretación"),
      caption   = "Comparación de resultados entre DIME Efectivo y DIMES Comparativos") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = TRUE,
                font_size = 12)

Comparación de resultados entre DIME Efectivo y DIMES Comparativos
Indicador	DIME Efectivo	DIMES Comparativos	Interpretación
N	5.333	5.333	Misma muestra
Delta score general	+0.12	+0.19	Diferencia de 0.07 atribuible al instrumento
% Avanzó	22.6%	27.5%	Con ponderaciones 2025 hay más avances aparentes
% Estable	66.0%	63.2%	Menor proporción estable
% Retrocedió	11.4%	9.3%	Menos retrocesos aparentes
Media score inicial — Avanzó	1.9779	1.9656	Similar — patrón de piso consistente
Media score inicial — Retrocedió	2.5281	2.5787	Similar — patrón de techo consistente
F. Innovación delta — Avanzó	+0.9705	+1.1727	Mayor movimiento en Innovación (instrumento controlado)
E. Contabilidad delta — Retrocedió	-0.6081	-0.7287	Mayor caída en Contabilidad (instrumento controlado)
Accuracy multinomial (prueba)	~98.9%	~98.1%	Desempeño similar en ambas bases

6. Resumen ejecutivo

resumen <- data.frame(
  Paso = c(
    "1. Score general",
    "2. Score por dimensión",
    "3. Descriptivas por grupo",
    "4. Delta por dimensión y grupo",
    "5. Score por etapa de partida",
    "6. Pruebas t (Bonferroni)",
    "7. d de Cohen",
    "8. Intervalos de confianza",
    "9. Regresión binaria",
    "10. Regresión multinomial"
  ),
  Hallazgo = c(
    "Con ponderaciones 2025, el score simulado (2026) es +0.19 mayor que el real (2025). Diferencia de +0.07 vs. DIME Efectivo — atribuible al cambio de instrumento.",
    "F. Innovación tiene el mayor delta (+0.40 agregado). B. Desarrollo el segundo. C. Liderazgo y D. Mercado casi no cambian.",
    "Las UP que avanzan parten más abajo (media 1.98) que las que retroceden (2.58). El patrón es consistente con DIME Efectivo — confirma efecto de piso.",
    "F. Innovación es la dimensión más discriminante: +1.17 en Avanzó vs. -0.53 en Retrocedió. E. Contabilidad tiene el mayor retroceso en las que caen (-0.73).",
    "Desde Ideación avanza el 86.5%; desde Aceleración solo el 2.8%. Madurez: 100% retrocede (n=9, interpretar con cautela).",
    "Las 18 pruebas son significativas (α Bonferroni = 0.00278). Las diferencias son reales en la población, no solo en la muestra.",
    "F. Innovación tiene el mayor efecto en todas las comparaciones (d=1.84 en Avanzó vs. Retrocedió). Todos los efectos son medianos o mayores.",
    "Ningún IC contiene el 0. Intervalos estrechos — estimaciones precisas gracias al tamaño de muestra.",
    "Revisar accuracy: si ≈ 72.5% el modelo no discriminó. AUC en curva ROC da mejor diagnóstico.",
    "Accuracy ~98% en datos de prueba. Etapa de partida y F. Innovación son los predictores con mayor peso."
  )
)

kable(resumen,
      col.names = c("Paso", "Hallazgo principal"),
      caption   = "Resumen de hallazgos — DIMES Comparativos") %>%
  kable_styling(bootstrap_options = c("striped","hover"),
                full_width = TRUE, font_size = 12) %>%
  column_spec(1, bold = TRUE, width = "25%") %>%
  column_spec(2, width = "75%")

Resumen de hallazgos — DIMES Comparativos
Paso	Hallazgo principal
Score general	Con ponderaciones 2025, el score simulado (2026) es +0.19 mayor que el real (2025). Diferencia de +0.07 vs. DIME Efectivo — atribuible al cambio de instrumento.
Score por dimensión	F. Innovación tiene el mayor delta (+0.40 agregado). B. Desarrollo el segundo. C. Liderazgo y D. Mercado casi no cambian.
Descriptivas por grupo	Las UP que avanzan parten más abajo (media 1.98) que las que retroceden (2.58). El patrón es consistente con DIME Efectivo — confirma efecto de piso.
Delta por dimensión y grupo	F. Innovación es la dimensión más discriminante: +1.17 en Avanzó vs. -0.53 en Retrocedió. E. Contabilidad tiene el mayor retroceso en las que caen (-0.73).
Score por etapa de partida	Desde Ideación avanza el 86.5%; desde Aceleración solo el 2.8%. Madurez: 100% retrocede (n=9, interpretar con cautela).
Pruebas t (Bonferroni)	Las 18 pruebas son significativas (α Bonferroni = 0.00278). Las diferencias son reales en la población, no solo en la muestra.
d de Cohen	F. Innovación tiene el mayor efecto en todas las comparaciones (d=1.84 en Avanzó vs. Retrocedió). Todos los efectos son medianos o mayores.
Intervalos de confianza	Ningún IC contiene el 0. Intervalos estrechos — estimaciones precisas gracias al tamaño de muestra.
Regresión binaria	Revisar accuracy: si ≈ 72.5% el modelo no discriminó. AUC en curva ROC da mejor diagnóstico.
Regresión multinomial	Accuracy ~98% en datos de prueba. Etapa de partida y F. Innovación son los predictores con mayor peso.

Base: DIMES Comparativos — 5.333 UP que respondieron DIME 1.0 (2025) y DIME 2.0 (2026). La columna derecha es el puntaje recalculado con ponderaciones 2025 aplicadas a las respuestas de 2026. Sin filtros adicionales.

Análisis de Cambio de Etapa — DIMES Comparativos

DIME 1.0 real (2025) vs. DIME 1.0 simulado con ponderaciones 2025 aplicadas a respuestas 2026

2026-08-27