requeridos <- c("readxl", "dplyr", "tidyr", "ggplot2", "knitr", "MASS")
faltantes  <- requeridos[!vapply(requeridos, requireNamespace, logical(1), quietly = TRUE)]
if (length(faltantes)) {
  stop("Faltan paquetes: ", paste(faltantes, collapse = ", "),
       "\nInstálalos con: install.packages(c('", paste(faltantes, collapse = "','"), "'))")
}
library(readxl); library(dplyr); library(tidyr); library(ggplot2); library(knitr)

mor_osc <- "#804bb2"; mor_cla <- "#daadfc"; mor_med <- "#b07fd6"; gris <- "#4A4A4A"
theme_set(
  theme_minimal(base_size = 11) +
    theme(panel.grid.minor = element_blank(),
          strip.text = element_text(face = "bold", colour = gris),
          plot.title = element_text(face = "bold", colour = gris))
)
tabla <- function(x, ...) knitr::kable(x, digits = 4, format.args = list(big.mark = ","), ...)

1 Qué se contrasta y por qué

Este cuaderno es la continuación del diagnóstico de normalidad. No repite el diagnóstico: parte de sus conclusiones y las convierte en decisiones de método.

Lo que mostró el diagnóstico Decisión que impone aquí
Los NUM_DOC coinciden fila a fila Todo contraste es pareado
\(\rho\) entre olas de 0,44 a 0,75 Tratarlas como independientes desperdiciaría 44–75 % de precisión
Diferencias simétricas (asimetría ≈ 0), \(n\) = 5.333 La \(t\) pareada es válida por el TLC
Simetría verificada de las diferencias Habilita el Wilcoxon de rangos con signo como robustez
\(\lambda\) de Yeo-Johnson ≈ 1 No transformar
E_CONTABILIDAD: 30 valores, 28,7 % de ceros Requiere prueba de signos, no Wilcoxon
8–9 % de atípicos robustos Obliga a un análisis de sensibilidad
Colas pesadas multivariadas Evitar \(T^2\) de Hotelling; contrastes univariados con ajuste por multiplicidad

Estrategia de contraste. Cada dimensión se somete a tres procedimientos con supuestos distintos —\(t\) pareada (media), Wilcoxon o signos (mediana) y bootstrap (sin supuesto distribucional)—. Si los tres coinciden, la conclusión no depende del supuesto; si difieren, la discrepancia es informativa y se reporta.

Advertencia que atraviesa todo el documento. Las dos olas no fueron medidas con el mismo instrumento: 2025 es DIME 1.0 y 2026 es DIME 1.0 reconstruido desde el DIME 2.0 vía la correlativa. Todo lo que sigue mide el cambio observado en el puntaje, que mezcla cambio real de las empresas con cualquier efecto del recálculo. La §8 documenta por qué esto es particularmente serio en B_DESARROLLO_PROD y F_INNOVACION.

2 Lectura y preparación

dims <- c("B_DESARROLLO_PROD", "C_LIDERAZGO", "D_MERCADO_VENTAS",
          "E_CONTABILIDAD", "F_INNOVACION", "General")
dims5 <- setdiff(dims, "General")
nombres_bloque <- c("GlobalID", "NUM_DOC", "LOCALIDAD_F", "RAZON_SOCIAL", dims, "Etapa")
etapas <- c("Ideación", "Nacimiento", "Crecimiento", "Aceleración", "Madurez")

crudo <- read_excel(params$archivo, sheet = params$hoja, skip = 2, col_names = FALSE)
stopifnot(ncol(crudo) == 2 * length(nombres_bloque))
names(crudo) <- c(paste0(nombres_bloque, "_25"), paste0(nombres_bloque, "_26"))

panel <- crudo %>%
  mutate(across(all_of(c(paste0(dims, "_25"), paste0(dims, "_26"))), as.numeric),
         Etapa_25 = factor(Etapa_25, levels = etapas),
         Etapa_26 = factor(Etapa_26, levels = etapas))

X25 <- as.matrix(panel[paste0(dims, "_25")]); colnames(X25) <- dims
X26 <- as.matrix(panel[paste0(dims, "_26")]); colnames(X26) <- dims
XD  <- X26 - X25
d25 <- as.data.frame(X25); d26 <- as.data.frame(X26); dif <- as.data.frame(XD)
cat("Empresas en el panel:", nrow(panel), "\n")
## Empresas en el panel: 5333

2.1 Marcado de casos problemáticos

Ningún caso se elimina de la base principal. Se marcan, y en §4 se repite todo el análisis sin ellos para ver si las conclusiones dependen de un puñado de empresas.

corte <- qchisq(0.975, df = length(dims5))
rob   <- MASS::cov.rob(XD[, dims5], method = "mcd", nsamp = 500, seed = params$semilla)
d_rob <- mahalanobis(XD[, dims5], rob$center, rob$cov)

marcas <- panel %>%
  transmute(
    NUM_DOC = NUM_DOC_25, Empresa = RAZON_SOCIAL_25,
    fuera_escala = apply(X25 > 5 | X25 < 0 | X26 > 5 | X26 < 0, 1, any),
    duplicado    = duplicated(NUM_DOC_25) | duplicated(NUM_DOC_25, fromLast = TRUE),
    atipico      = d_rob > corte
  ) %>%
  mutate(limpio = !(fuera_escala | duplicado | atipico))

tibble::tibble(
  Criterio = c("Fuera de la escala 0–5", "Documento duplicado",
               "Atípico multivariado (MCD)", "Excluidos en total (base depurada)",
               "Base depurada"),
  Casos = c(sum(marcas$fuera_escala), sum(marcas$duplicado), sum(marcas$atipico),
            sum(!marcas$limpio), sum(marcas$limpio)),
  `% del panel` = round(100 * c(mean(marcas$fuera_escala), mean(marcas$duplicado),
                                mean(marcas$atipico), mean(!marcas$limpio),
                                mean(marcas$limpio)), 1)
) %>% tabla(caption = "Casos marcados para el análisis de sensibilidad")
Casos marcados para el análisis de sensibilidad
Criterio Casos % del panel
Fuera de la escala 0–5 3 0.1
Documento duplicado 2 0.0
Atípico multivariado (MCD) 496 9.3
Excluidos en total (base depurada) 496 9.3
Base depurada 4,837 90.7

3 El cambio en el centro de la distribución

3.1 Los tres contrastes

## t pareada -----------------------------------------------------------------
prueba_t <- function(d) {
  tt <- t.test(d)
  c(dif = unname(tt$estimate), ic_lo = tt$conf.int[1], ic_hi = tt$conf.int[2],
    t = unname(tt$statistic), gl = unname(tt$parameter), p = tt$p.value)
}

## Wilcoxon de rangos con signo (mediana de Hodges-Lehmann) -------------------
prueba_w <- function(d) {
  ww <- suppressWarnings(wilcox.test(d, conf.int = TRUE, exact = FALSE, correct = TRUE))
  c(hl = unname(ww$estimate), hl_lo = ww$conf.int[1], hl_hi = ww$conf.int[2], p = ww$p.value)
}

## Prueba de signos (ignora la magnitud; correcta con empates masivos) --------
prueba_signos <- function(d) {
  nz <- d[d != 0 & is.finite(d)]
  bt <- binom.test(sum(nz > 0), length(nz), 0.5)
  c(n_efectivo = length(nz), prop_sube = unname(bt$estimate),
    ic_lo = bt$conf.int[1], ic_hi = bt$conf.int[2], p = bt$p.value)
}

## Bootstrap percentil de la media de las diferencias ------------------------
boot_media <- function(d, B = params$B_boot, semilla = params$semilla) {
  d <- d[is.finite(d)]; n <- length(d)
  set.seed(semilla)
  m <- vapply(seq_len(B), function(i) mean(d[sample.int(n, n, replace = TRUE)]), numeric(1))
  c(media = mean(d), boot_lo = unname(quantile(m, 0.025)),
    boot_hi = unname(quantile(m, 0.975)), ee_boot = sd(m))
}

## Tamaños de efecto ---------------------------------------------------------
efectos <- function(d, x25, x26) {
  c(dz   = mean(d) / sd(d),                                  # d de Cohen para datos pareados
    d_av = mean(d) / ((sd(x25) + sd(x26)) / 2),              # estandarizado por las olas
    pct_escala = 100 * mean(d) / 5)                          # % de la escala 0–5
}

Por qué tres. La \(t\) contrasta la media y supone normalidad (que aquí sostiene el TLC). Wilcoxon contrasta la pseudomediana y supone simetría (verificada en el diagnóstico). El bootstrap no supone nada sobre la forma: remuestrea las empresas y reconstruye la distribución del estimador. La prueba de signos solo usa la dirección del cambio, ignorando la magnitud: es la única válida cuando la variable es discreta con muchos empates.

contrastes <- bind_rows(lapply(dims, function(v) {
  d <- dif[[v]]
  tt <- prueba_t(d); ww <- prueba_w(d); ss <- prueba_signos(d)
  bb <- boot_media(d); ef <- efectos(d, d25[[v]], d26[[v]])
  tibble::tibble(
    Dimensión = v,
    `Cambio medio` = tt["dif"], `IC 95% inf` = tt["ic_lo"], `IC 95% sup` = tt["ic_hi"],
    `t` = tt["t"], `p (t)` = tt["p"],
    `Mediana HL` = ww["hl"], `p (Wilcoxon)` = ww["p"],
    `% que sube` = 100 * ss["prop_sube"], `p (signos)` = ss["p"],
    `IC boot inf` = bb["boot_lo"], `IC boot sup` = bb["boot_hi"],
    dz = ef["dz"], `d promedio` = ef["d_av"], `% de la escala` = ef["pct_escala"]
  )
})) %>%
  mutate(`p ajustado (Holm)` = p.adjust(`p (t)`, method = "holm"), .after = `p (t)`)

contrastes %>%
  dplyr::select(Dimensión, `Cambio medio`, `IC 95% inf`, `IC 95% sup`, `t`,
                `p (t)`, `p ajustado (Holm)`) %>%
  tabla(caption = "Contraste principal: t pareada sobre el cambio 2026 − 2025")
Contraste principal: t pareada sobre el cambio 2026 − 2025
Dimensión Cambio medio IC 95% inf IC 95% sup t p (t) p ajustado (Holm)
B_DESARROLLO_PROD 0.4329 0.4120 0.4539 40.5680 0.0000 0.0000
C_LIDERAZGO 0.0470 0.0315 0.0625 5.9388 0.0000 0.0000
D_MERCADO_VENTAS -0.0058 -0.0187 0.0072 -0.8689 0.3850 0.3850
E_CONTABILIDAD -0.0145 -0.0352 0.0061 -1.3786 0.1681 0.3362
F_INNOVACION 0.4956 0.4681 0.5231 35.3500 0.0000 0.0000
General 0.1910 0.1794 0.2027 32.2091 0.0000 0.0000 
contrastes %>%
  dplyr::select(Dimensión, `Cambio medio`, `IC boot inf`, `IC boot sup`,
                `Mediana HL`, `p (Wilcoxon)`, `% que sube`, `p (signos)`) %>%
  tabla(caption = "Contrastes de robustez: bootstrap, Wilcoxon y prueba de signos")
Contrastes de robustez: bootstrap, Wilcoxon y prueba de signos
Dimensión Cambio medio IC boot inf IC boot sup Mediana HL p (Wilcoxon) % que sube p (signos)
B_DESARROLLO_PROD 0.4329 0.4123 0.4533 0.5002 0.0000 74.15 0.0000
C_LIDERAZGO 0.0470 0.0317 0.0621 0.0493 0.0000 54.43 0.0000
D_MERCADO_VENTAS -0.0058 -0.0196 0.0073 -0.0065 0.4128 48.01 0.0039
E_CONTABILIDAD -0.0145 -0.0345 0.0063 0.0001 0.8749 51.37 0.0947
F_INNOVACION 0.4956 0.4673 0.5229 0.5100 0.0000 68.66 0.0000
General 0.1910 0.1794 0.2024 0.1922 0.0000 68.57 0.0000

3.2 Convergencia de los métodos

convergencia <- contrastes %>%
  transmute(
    Dimensión,
    `t pareada` = ifelse(`p ajustado (Holm)` < 0.05,
                         ifelse(`Cambio medio` > 0, "Sube", "Baja"), "Sin cambio"),
    `Wilcoxon` = ifelse(`p (Wilcoxon)` < 0.05,
                        ifelse(`Mediana HL` > 0, "Sube", "Baja"), "Sin cambio"),
    `Signos` = ifelse(`p (signos)` < 0.05,
                      ifelse(`% que sube` > 50, "Sube", "Baja"), "Sin cambio"),
    `Bootstrap` = ifelse(`IC boot inf` > 0, "Sube",
                  ifelse(`IC boot sup` < 0, "Baja", "Sin cambio")),
    Coinciden = ifelse(`t pareada` == Wilcoxon & Wilcoxon == Signos & Signos == Bootstrap,
                       "Sí", "No")
  )
tabla(convergencia, caption = "¿Coinciden los cuatro procedimientos?")
¿Coinciden los cuatro procedimientos?
Dimensión t pareada Wilcoxon Signos Bootstrap Coinciden
B_DESARROLLO_PROD Sube Sube Sube Sube Sí
C_LIDERAZGO Sube Sube Sube Sube Sí
D_MERCADO_VENTAS Sin cambio Sin cambio Baja Sin cambio No
E_CONTABILIDAD Sin cambio Sin cambio Sin cambio Sin cambio Sí
F_INNOVACION Sube Sube Sube Sube Sí
General Sube Sube Sube Sube Sí

Cuando las cuatro columnas coinciden, la conclusión es sólida y no depende del supuesto distribucional. Una discrepancia entre la \(t\) (media) y los signos (mediana) indica que el cambio típico y el cambio promedio apuntan en direcciones distintas: la distribución del cambio es asimétrica en su parte central aunque su asimetría global sea baja. Ese caso se comenta en §7.

3.3 Magnitud del cambio

contrastes %>%
  dplyr::select(Dimensión, `Cambio medio`, dz, `d promedio`, `% de la escala`) %>%
  mutate(Magnitud = cut(abs(dz), breaks = c(-Inf, 0.2, 0.5, 0.8, Inf),
                        labels = c("Trivial", "Pequeño", "Mediano", "Grande"))) %>%
  tabla(caption = "Tamaño de efecto (convención de Cohen: 0.2 pequeño, 0.5 mediano, 0.8 grande)")
Tamaño de efecto (convención de Cohen: 0.2 pequeño, 0.5 mediano, 0.8 grande)
Dimensión Cambio medio dz d promedio % de la escala Magnitud
B_DESARROLLO_PROD 0.4329 0.5555 0.5261 8.6588 Mediano
C_LIDERAZGO 0.0470 0.0813 0.0671 0.9396 Trivial
D_MERCADO_VENTAS -0.0058 -0.0119 -0.0095 -0.1151 Trivial
E_CONTABILIDAD -0.0145 -0.0189 -0.0168 -0.2906 Trivial
F_INNOVACION 0.4956 0.4841 0.5122 9.9119 Pequeño
General 0.1910 0.4411 0.3127 3.8209 Pequeño

Con 5.333 empresas, la significancia estadística no distingue nada: un cambio de 0,05 puntos en una escala de 0 a 5 sale significativo. El tamaño de efecto es el que decide si el cambio es relevante para política pública. dz estandariza por la desviación del cambio; d promedio lo hace por la desviación de los puntajes, que es la referencia más comparable con otros estudios.

contrastes %>%
  mutate(Dimensión = factor(Dimensión, levels = rev(dims)),
         signo = ifelse(`IC 95% inf` > 0, "Aumento", ifelse(`IC 95% sup` < 0, "Descenso", "Sin cambio"))) %>%
  ggplot(aes(`Cambio medio`, Dimensión, colour = signo)) +
  geom_vline(xintercept = 0, colour = gris, linewidth = 0.5) +
  geom_errorbar(aes(xmin = `IC 95% inf`, xmax = `IC 95% sup`),
                orientation = "y", width = 0.18, linewidth = 0.8) +
  geom_point(size = 2.6) +
  scale_colour_manual(values = c(Aumento = mor_osc, Descenso = "#c0392b", `Sin cambio` = "grey55"),
                      name = NULL) +
  labs(title = "Cambio medio por dimensión, con intervalo de confianza del 95 %",
       subtitle = "Puntos a la derecha de la línea = el puntaje sube entre 2025 y 2026",
       x = "Diferencia media (2026 − 2025)", y = NULL)

4 Análisis de sensibilidad

¿Las conclusiones dependen de los 496 casos marcados en §2.1? Se repite el contraste principal sobre la base depurada y se comparan los dos resultados.

dif_limpio <- dif[marcas$limpio, , drop = FALSE]

sens <- bind_rows(lapply(dims, function(v) {
  a <- prueba_t(dif[[v]]); b <- prueba_t(dif_limpio[[v]])
  tibble::tibble(
    Dimensión = v,
    `Cambio (todos)` = a["dif"], `p (todos)` = a["p"],
    `Cambio (depurada)` = b["dif"], `p (depurada)` = b["p"],
    `Diferencia absoluta` = abs(b["dif"] - a["dif"]),
    `Misma conclusión` = ifelse((a["p"] < 0.05) == (b["p"] < 0.05) &
                                sign(a["dif"]) == sign(b["dif"]), "Sí", "No")
  )
}))
tabla(sens, caption = "Contraste principal con y sin los casos marcados")
Contraste principal con y sin los casos marcados
Dimensión Cambio (todos) p (todos) Cambio (depurada) p (depurada) Diferencia absoluta Misma conclusión
B_DESARROLLO_PROD 0.4329 0.0000 0.4410 0.0000 0.0081 Sí
C_LIDERAZGO 0.0470 0.0000 0.0556 0.0000 0.0086 Sí
D_MERCADO_VENTAS -0.0058 0.3850 -0.0009 0.8831 0.0049 Sí
E_CONTABILIDAD -0.0145 0.1681 -0.0012 0.8998 0.0134 Sí
F_INNOVACION 0.4956 0.0000 0.5022 0.0000 0.0066 Sí
General 0.1910 0.0000 0.1994 0.0000 0.0083 Sí

Si la columna Misma conclusión dice “Sí” en todas las filas, el análisis es robusto a los atípicos y el resultado no descansa en un grupo pequeño de empresas. Si alguna dice “No”, esa dimensión debe reportarse con la advertencia explícita de que su resultado depende de casos extremos.

5 La forma del cambio, no solo su centro

Una media que sube 0,2 puntos puede significar dos cosas muy distintas: que todas las empresas suben un poco, o que la mayoría no se mueve y unas pocas suben mucho. Las implicaciones de política son opuestas. Esta sección las distingue.

5.1 Cuantiles del cambio

probs <- c(0.10, 0.25, 0.50, 0.75, 0.90)
bind_rows(lapply(dims, function(v) {
  q <- quantile(dif[[v]], probs, na.rm = TRUE)
  tibble::tibble(Dimensión = v, `P10` = q[1], `P25` = q[2], `Mediana` = q[3],
                 `P75` = q[4], `P90` = q[5],
                 `% sube` = round(100 * mean(dif[[v]] > 0, na.rm = TRUE), 1),
                 `% igual` = round(100 * mean(dif[[v]] == 0, na.rm = TRUE), 1),
                 `% baja` = round(100 * mean(dif[[v]] < 0, na.rm = TRUE), 1))
})) %>% tabla(caption = "Distribución del cambio intra-empresa por dimensión")
Distribución del cambio intra-empresa por dimensión
Dimensión P10 P25 Mediana P75 P90 % sube % igual % baja
B_DESARROLLO_PROD -0.5842 0.0000 0.3344 1.0004 1.3344 69.2 6.7 24.1
C_LIDERAZGO -0.6700 -0.2887 0.0146 0.4324 0.7523 52.3 4.0 43.8
D_MERCADO_VENTAS -0.6041 -0.2844 -0.0316 0.2827 0.5903 48.0 0.0 52.0
E_CONTABILIDAD -0.8822 -0.4411 0.0000 0.5544 0.8822 36.6 28.7 34.7
F_INNOVACION -0.7572 -0.1515 0.4594 1.1763 1.7821 66.6 3.0 30.4
General -0.3381 -0.0764 0.1928 0.4565 0.7231 68.6 0.0 31.4

5.2 Función de desplazamiento

Compara el cuantil \(q\) de 2026 contra el mismo cuantil de 2025. Una línea plana significa que toda la distribución se desplazó en paralelo —el cambio afecta por igual a empresas débiles y fuertes—. Una línea inclinada significa que el cambio se concentra en una parte de la distribución.

probs_s <- seq(0.05, 0.95, by = 0.05)

shift_boot <- function(v, B = 1000, semilla = params$semilla) {
  x <- d25[[v]]; y <- d26[[v]]; n <- length(x)
  obs <- quantile(y, probs_s) - quantile(x, probs_s)
  set.seed(semilla)
  bs <- vapply(seq_len(B), function(i) {
    id <- sample.int(n, n, replace = TRUE)          # remuestreo de empresas (mantiene el par)
    unname(quantile(y[id], probs_s) - quantile(x[id], probs_s))
  }, numeric(length(probs_s)))
  tibble::tibble(Dimensión = v, cuantil = probs_s, desplazamiento = unname(obs),
                 lo = apply(bs, 1, quantile, 0.025), hi = apply(bs, 1, quantile, 0.975))
}

shift <- bind_rows(lapply(dims, shift_boot)) %>%
  mutate(Dimensión = factor(Dimensión, levels = dims))

ggplot(shift, aes(cuantil, desplazamiento)) +
  geom_hline(yintercept = 0, colour = gris, linewidth = 0.4) +
  geom_ribbon(aes(ymin = lo, ymax = hi), fill = mor_cla, alpha = 0.55) +
  geom_line(colour = mor_osc, linewidth = 0.8) +
  facet_wrap(~ Dimensión, ncol = 2, scales = "free_y") +
  scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Función de desplazamiento: cuánto cambió cada cuantil de la distribución",
       subtitle = "Banda = intervalo bootstrap del 95 % (remuestreo de empresas, preservando el emparejamiento)",
       x = "Cuantil de la distribución", y = "Cuantil 2026 − cuantil 2025")

shift %>% group_by(Dimensión) %>%
  summarise(`Desplazamiento mínimo` = min(desplazamiento),
            `Desplazamiento máximo` = max(desplazamiento),
            `Rango` = max(desplazamiento) - min(desplazamiento),
            `Patrón` = ifelse(max(desplazamiento) - min(desplazamiento) < 0.15,
                              "Uniforme (traslación)", "Desigual entre cuantiles"),
            .groups = "drop") %>%
  tabla(caption = "¿El cambio fue uniforme en toda la distribución?")
¿El cambio fue uniforme en toda la distribución?
Dimensión Desplazamiento mínimo Desplazamiento máximo Rango Patrón
B_DESARROLLO_PROD 0.1671 0.6667 0.4995 Desigual entre cuantiles
C_LIDERAZGO -0.0306 0.1961 0.2267 Desigual entre cuantiles
D_MERCADO_VENTAS -0.2212 0.1040 0.3252 Desigual entre cuantiles
E_CONTABILIDAD -0.1133 0.1133 0.2266 Desigual entre cuantiles
F_INNOVACION 0.2671 0.7674 0.5002 Desigual entre cuantiles
General 0.1439 0.2323 0.0884 Uniforme (traslación)

5.3 Quién sube y quién baja

bind_rows(lapply(dims, function(v) {
  d <- dif[[v]]
  tibble::tibble(Dimensión = v,
                 `Magnitud media del aumento` = mean(d[d > 0]),
                 `Magnitud media del descenso` = mean(d[d < 0]),
                 `Razón aumento/descenso` = abs(mean(d[d > 0]) / mean(d[d < 0])),
                 `% que sube` = round(100 * mean(d > 0), 1))
})) %>% tabla(caption = "Intensidad del cambio entre quienes suben y quienes bajan")
Intensidad del cambio entre quienes suben y quienes bajan
Dimensión Magnitud media del aumento Magnitud media del descenso Razón aumento/descenso % que sube
B_DESARROLLO_PROD 0.8227 -0.5655 1.4548 69.2
C_LIDERAZGO 0.4730 -0.4577 1.0335 52.3
D_MERCADO_VENTAS 0.3774 -0.3596 1.0495 48.0
E_CONTABILIDAD 0.7149 -0.7971 0.8969 36.6
F_INNOVACION 1.0407 -0.6500 1.6012 66.6
General 0.4101 -0.2870 1.4292 68.6

Esta tabla separa dos mecanismos que la media confunde: cuántas empresas se mueven en cada dirección y cuánto se mueven. Un cambio medio positivo puede venir de que suban más empresas, de que las que suben lo hagan con más fuerza, o de ambas.

6 Transiciones entre etapas de madurez

El puntaje continuo responde “¿cuánto cambió?”. La etapa responde una pregunta distinta y más directa para política: ¿cuántas empresas cambiaron de categoría, y en qué dirección?

trans_tab <- table(Etapa_25 = panel$Etapa_25, Etapa_26 = panel$Etapa_26)
tabla(as.data.frame.matrix(trans_tab),
      caption = "Matriz de transiciones: etapa en 2025 (filas) × etapa en 2026 (columnas)")
Matriz de transiciones: etapa en 2025 (filas) × etapa en 2026 (columnas)
Ideación Nacimiento Crecimiento Aceleración Madurez
Ideación 13 76 7 0 0
Nacimiento 22 1,198 895 22 0
Crecimiento 0 290 1,820 451 0
Aceleración 0 1 173 341 15
Madurez 0 0 2 7 0 
T <- as.matrix(trans_tab); n_t <- sum(T)
mov <- tibble::tibble(
  Situación = c("Permanece en la misma etapa", "Avanza de etapa", "Retrocede de etapa"),
  Empresas = c(sum(diag(T)), sum(T[upper.tri(T)]), sum(T[lower.tri(T)])),
  `%` = round(100 * c(sum(diag(T)), sum(T[upper.tri(T)]), sum(T[lower.tri(T)])) / n_t, 1)
)
tabla(mov, caption = "Movilidad entre etapas")
Movilidad entre etapas
Situación Empresas %
Permanece en la misma etapa 3,372 63.2
Avanza de etapa 1,466 27.5
Retrocede de etapa 495 9.3 
as.data.frame(trans_tab) %>%
  rename(n = Freq) %>%
  group_by(Etapa_25) %>% mutate(pct = 100 * n / sum(n)) %>% ungroup() %>%
  ggplot(aes(Etapa_26, Etapa_25, fill = pct)) +
  geom_tile(colour = "white", linewidth = 1) +
  geom_text(aes(label = ifelse(n > 0, sprintf("%d\n%.0f%%", n, pct), "")),
            size = 2.9, colour = "grey15") +
  scale_fill_gradient(low = "white", high = mor_osc, name = "% de la fila") +
  labs(title = "Transiciones entre etapas de madurez",
       subtitle = "Porcentajes calculados sobre la etapa de origen (fila)",
       x = "Etapa en 2026", y = "Etapa en 2025")

6.1 Prueba de simetría (Bowker)

La matriz de transiciones es simétrica si el flujo de la etapa \(i\) a la \(j\) iguala al de \(j\) a \(i\); en ese caso hay movimiento pero no hay cambio neto en la distribución de etapas. La prueba de Bowker —la generalización de McNemar a \(k\) categorías— contrasta esa hipótesis.

bowker <- function(T) {
  k <- nrow(T); est <- 0; gl <- 0
  for (i in 1:(k - 1)) for (j in (i + 1):k) {
    s <- T[i, j] + T[j, i]
    if (s > 0) { est <- est + (T[i, j] - T[j, i])^2 / s; gl <- gl + 1 }
  }
  list(estadistico = est, gl = gl, p = pchisq(est, gl, lower.tail = FALSE))
}
bw <- bowker(T)
tibble::tibble(Prueba = "Bowker (simetría de la matriz de transiciones)",
               `χ²` = bw$estadistico, `gl` = bw$gl, p = bw$p) %>%
  tabla(caption = "Contraste de simetría; los pares vacíos se excluyen y los grados de libertad se ajustan")
Contraste de simetría; los pares vacíos se excluyen y los grados de libertad se ajustan
Prueba χ² gl p
Bowker (simetría de la matriz de transiciones) 493.6 7 0 
marg <- bind_rows(
  as.data.frame(prop.table(table(panel$Etapa_25))) %>% mutate(Ola = "2025"),
  as.data.frame(prop.table(table(panel$Etapa_26))) %>% mutate(Ola = "2026")
) %>% rename(Etapa = Var1, Proporción = Freq)

marg %>% pivot_wider(names_from = Ola, values_from = Proporción) %>%
  mutate(across(c(`2025`, `2026`), ~ round(100 * .x, 1)),
         `Cambio (pp)` = `2026` - `2025`) %>%
  tabla(caption = "Distribución de etapas por ola (%) y cambio en puntos porcentuales")
Distribución de etapas por ola (%) y cambio en puntos porcentuales
Etapa 2025 2026 Cambio (pp)
Ideación 1.8 0.7 -1.1
Nacimiento 40.1 29.3 -10.8
Crecimiento 48.0 54.3 6.3
Aceleración 9.9 15.4 5.5
Madurez 0.2 0.3 0.1 
ggplot(marg, aes(Etapa, 100 * Proporción, fill = Ola)) +
  geom_col(position = position_dodge(0.7), width = 0.65) +
  scale_fill_manual(values = c("2025" = mor_cla, "2026" = mor_osc)) +
  labs(title = "Composición del panel por etapa de madurez", x = NULL, y = "% de empresas")

7 Síntesis

veredicto <- contrastes %>%
  left_join(convergencia %>% dplyr::select(Dimensión, Coinciden), by = "Dimensión") %>%
  transmute(
    Dimensión,
    `Cambio medio`, `IC 95% inf`, `IC 95% sup`, dz,
    `Significativo (Holm)` = ifelse(`p ajustado (Holm)` < 0.05, "Sí", "No"),
    `Métodos coinciden` = Coinciden,
    Veredicto = case_when(
      `p ajustado (Holm)` >= 0.05 ~ "Sin evidencia de cambio",
      abs(dz) < 0.2               ~ "Significativo pero trivial",
      abs(dz) < 0.5               ~ "Cambio pequeño pero real",
      TRUE                        ~ "Cambio sustantivo"
    )
  )
tabla(veredicto, caption = "Veredicto por dimensión")
Veredicto por dimensión
Dimensión Cambio medio IC 95% inf IC 95% sup dz Significativo (Holm) Métodos coinciden Veredicto
B_DESARROLLO_PROD 0.4329 0.4120 0.4539 0.5555 Sí Sí Cambio sustantivo
C_LIDERAZGO 0.0470 0.0315 0.0625 0.0813 Sí Sí Significativo pero trivial
D_MERCADO_VENTAS -0.0058 -0.0187 0.0072 -0.0119 No No Sin evidencia de cambio
E_CONTABILIDAD -0.0145 -0.0352 0.0061 -0.0189 No Sí Sin evidencia de cambio
F_INNOVACION 0.4956 0.4681 0.5231 0.4841 Sí Sí Cambio pequeño pero real
General 0.1910 0.1794 0.2027 0.4411 Sí Sí Cambio pequeño pero real 
veredicto %>%
  mutate(Dimensión = factor(Dimensión, levels = rev(dims))) %>%
  ggplot(aes(abs(dz), Dimensión, fill = Veredicto)) +
  geom_col(width = 0.6) +
  geom_vline(xintercept = c(0.2, 0.5, 0.8), linetype = "dashed", colour = gris, linewidth = 0.35) +
  scale_fill_manual(values = c("Sin evidencia de cambio" = "grey70",
                               "Significativo pero trivial" = mor_cla,
                               "Cambio pequeño pero real" = mor_med,
                               "Cambio sustantivo" = mor_osc)) +
  labs(title = "Tamaño de efecto por dimensión",
       subtitle = "Líneas punteadas: umbrales de Cohen (0.2 / 0.5 / 0.8)",
       x = "|dz|", y = NULL) +
  theme(legend.position = "bottom")

7.1 Cómo leer estos resultados

  1. Distinguir significancia de relevancia. Con \(n\) = 5.333, la columna de valores \(p\) casi no discrimina; la columna dz sí. Una dimensión marcada “significativo pero trivial” no debe reportarse como una mejora del ecosistema.
  2. Mirar la convergencia. Las dimensiones donde los cuatro procedimientos coinciden tienen una conclusión que no depende de supuestos. Donde no coinciden, revisar si la discrepancia viene de la media frente a la mediana (asimetría del cambio) o de los empates (E_CONTABILIDAD).
  3. Leer la función de desplazamiento antes de concluir. Si el desplazamiento es uniforme, el enunciado correcto es “toda la distribución se movió”; si es desigual, hay que decir en qué tramo de la distribución ocurrió el cambio, porque eso identifica a qué empresas llegó.
  4. Las transiciones son la cifra comunicable. “X % de las empresas avanzó de etapa” se entiende fuera del ámbito técnico mucho mejor que una diferencia de medias, y la prueba de Bowker dice si ese movimiento tiene dirección neta o es solo ruido en ambos sentidos.

8 Dos límites que este análisis no puede resolver

8.1 El instrumento cambió entre las dos olas

aporte <- tibble::tibble(
  Dimensión = dims5,
  `Cambio medio` = vapply(dims5, function(v) mean(dif[[v]], na.rm = TRUE), numeric(1)),
  `Aporte a General` = 0.2 * `Cambio medio`,
  `% del cambio en General` = round(100 * `Aporte a General` / mean(dif$General, na.rm = TRUE), 1)
)
tabla(aporte, caption = "Descomposición del cambio en el puntaje General")
Descomposición del cambio en el puntaje General
Dimensión Cambio medio Aporte a General % del cambio en General
B_DESARROLLO_PROD 0.4329 0.0866 45.3
C_LIDERAZGO 0.0470 0.0094 4.9
D_MERCADO_VENTAS -0.0058 -0.0012 -0.6
E_CONTABILIDAD -0.0145 -0.0029 -1.5
F_INNOVACION 0.4956 0.0991 51.9

El cambio agregado no está repartido: se concentra en B_DESARROLLO_PROD y F_INNOVACION, que son justamente las dimensiones donde la reconstrucción del puntaje vía la correlativa DIME 2.0 → 1.0 pudo alterar la escala —el máximo de B pasa de 6,501, fuera de rango, en 2025 a exactamente 5,000 en 2026—. Mientras no se verifique con quien construyó la correlativa que el mapeo de preguntas de esas dos dimensiones es equivalente entre versiones, el aumento del puntaje General no puede atribuirse a las empresas. Las dimensiones C, D y E, que la correlativa parece no afectar, son la parte más defendible del resultado.

8.2 El gradiente por etapa es regresión a la media

tibble::tibble(
  Dimensión = dims,
  `cor(cambio, nivel 2025)` = vapply(dims, function(v)
    cor(dif[[v]], d25[[v]], use = "complete.obs"), numeric(1)),
  `cor(cambio, promedio de olas)` = vapply(dims, function(v)
    cor(dif[[v]], (d25[[v]] + d26[[v]]) / 2, use = "complete.obs"), numeric(1))
) %>% tabla(caption = "Diagnóstico de Oldham: la correlación con el promedio se acerca a cero")
Diagnóstico de Oldham: la correlación con el promedio se acerca a cero
Dimensión cor(cambio, nivel 2025) cor(cambio, promedio de olas)
B_DESARROLLO_PROD -0.4234 0.0711
C_LIDERAZGO -0.4472 -0.0469
D_MERCADO_VENTAS -0.3164 0.1020
E_CONTABILIDAD -0.4716 -0.0359
F_INNOVACION -0.5840 -0.0936
General -0.3908 -0.0450

Las empresas que empiezan abajo suben y las que empiezan arriba bajan, pero la correlación entre el cambio y el promedio de las dos medidas es prácticamente nula: el patrón es regresión a la media, no un efecto diferencial por nivel de madurez. Con dos olas y sin grupo de comparación no hay forma de separar ambas cosas, así que la afirmación “las empresas menos maduras mejoraron más” no está sostenida por estos datos.

## R version 4.5.2 (2025-10-31 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 10 x64 (build 19045)
## 
## Matrix products: default
##   LAPACK version 3.12.1
## 
## locale:
## [1] LC_COLLATE=Spanish_Colombia.utf8  LC_CTYPE=Spanish_Colombia.utf8   
## [3] LC_MONETARY=Spanish_Colombia.utf8 LC_NUMERIC=C                     
## [5] LC_TIME=Spanish_Colombia.utf8    
## 
## time zone: America/Bogota
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] knitr_1.51    ggplot2_4.0.3 tidyr_1.3.2   dplyr_1.2.1   readxl_1.5.0 
## 
## loaded via a namespace (and not attached):
##  [1] gtable_0.3.6       jsonlite_2.0.0     compiler_4.5.2     tidyselect_1.2.1  
##  [5] jquerylib_0.1.4    scales_1.4.0       yaml_2.3.10        fastmap_1.2.0     
##  [9] R6_2.6.1           labeling_0.4.3     generics_0.1.4     MASS_7.3-65       
## [13] tibble_3.3.1       bslib_0.9.0        pillar_1.11.0      RColorBrewer_1.1-3
## [17] rlang_1.3.0        cachem_1.1.0       xfun_0.52          sass_0.4.10       
## [21] S7_0.2.0           cli_3.6.5          withr_3.0.2        magrittr_2.0.5    
## [25] digest_0.6.37      grid_4.5.2         rstudioapi_0.17.1  lifecycle_1.0.5   
## [29] vctrs_0.7.3        evaluate_1.0.5     glue_1.8.0         farver_2.1.2      
## [33] cellranger_1.1.0   rmarkdown_2.29     purrr_1.2.2        tools_4.5.2       
## [37] pkgconfig_2.0.3    htmltools_0.5.8.1