Ecuaciones estructurales: el ajuste no elige el modelo, lo elige la teoria

Actividad 3, Parte 1 — Modulo 1 — Generacion de escenarios futuros con analitica (CD-3001B)

1 Como leer este documento

Los cuatro ejercicios comparten una sola pregunta: cuando dos modelos compiten, quien decide? La respuesta que sostengo es que los indices de ajuste son una condicion necesaria pero nunca suficiente, y que un modelo con mejor ajuste puede ser peor modelo. Los ejercicios 1 a 3 construyen la evidencia con datos; el ejercicio 4 la confronta con un caso publicado donde los autores rechazaron su propio modelo mejor ajustado.

Todos los modelos se estiman con lavaan. Los criterios de ajuste que uso a lo largo del documento son los convencionales en la literatura (Hu y Bentler, 1999):

Criterios de ajuste usados en todo el documento

Indice	Que_mide	Criterio
Chi-cuadrada	Distancia absoluta entre la matriz observada y la implicada	no significativa (sensible a N)
CFI / TLI	Ajuste comparativo contra el modelo nulo	>= .95 (aceptable >= .90)
RMSEA	Error de aproximacion por grado de libertad (penaliza falta de parsimonia)	<= .06 (aceptable <= .08)
SRMR	Residual estandarizado promedio	<= .08

# indices que reporto en cada modelo
IDX <- c("chisq", "df", "pvalue", "cfi", "tli", "rmsea", "srmr")

# tabla de ajuste de uno o varios modelos, para comparar en el mismo renglon
tabla_ajuste <- function(..., etiquetas = NULL) {
  modelos <- list(...)
  if (is.null(etiquetas)) etiquetas <- paste("Modelo", seq_along(modelos))
  out <- do.call(rbind, lapply(modelos, function(m) {
    fm <- fitMeasures(m, IDX)
    data.frame(chisq = round(fm[["chisq"]], 2), gl = fm[["df"]],
               p = round(fm[["pvalue"]], 3), CFI = round(fm[["cfi"]], 3),
               TLI = round(fm[["tli"]], 3), RMSEA = round(fm[["rmsea"]], 3),
               SRMR = round(fm[["srmr"]], 3))
  }))
  # post.check avisa de soluciones inadmisibles (varianzas negativas, cargas > 1)
  out$admisible <- sapply(modelos, function(m) lavInspect(m, "post.check"))
  rownames(out) <- etiquetas
  out
}

# prueba de diferencia de chi-cuadrada entre dos modelos anidados, como tabla con titulo
# (las salidas sin titulo se desalinean de su rotulo al compilar a PDF)
comparar <- function(modelo_a, modelo_b, etiquetas, caption) {
  gl <- c(fitMeasures(modelo_a, "df"), fitMeasures(modelo_b, "df"))
  a  <- suppressWarnings(lavTestLRT(modelo_a, modelo_b))
  # lavTestLRT devuelve los modelos ordenados por grados de libertad, no en el orden
  # en que se pasan: hay que reordenar las etiquetas igual o quedan cruzadas
  out <- data.frame(Modelo = etiquetas[match(a$Df, gl)],
                    gl = a$Df, AIC = round(a$AIC, 1), BIC = round(a$BIC, 1),
                    chisq = round(a$Chisq, 2),
                    dif_chisq = round(a$"Chisq diff", 3),
                    dif_gl = a$"Df diff",
                    p = round(a$"Pr(>Chisq)", 4))
  kable(out, row.names = FALSE,
        col.names = c("Modelo","gl","AIC","BIC","chisq","dif. chisq","dif. gl","p"),
        caption = caption)
}

# cargas estandarizadas ordenadas de menor a mayor
cargas <- function(fit) {
  s <- subset(standardizedSolution(fit), op == "=~")
  s <- s[order(s$est.std), c("lhs", "rhs", "est.std", "pvalue")]
  names(s) <- c("Factor", "Item", "Carga_estandarizada", "p")
  rownames(s) <- NULL
  s
}

2 Ejercicio 1: Holzinger y Swineford (1939)

2.1 El modelo teorico de tres factores ajusta mal, y el problema tiene nombre: x9

La base clasica de Holzinger y Swineford registra nueve pruebas mentales aplicadas a 301 estudiantes de dos escuelas. La teoria propone tres habilidades latentes: visual (x1–x3), verbal (x4–x6) y velocidad (x7–x9).

mod_hs <- ' visual  =~ x1 + x2 + x3
            textual =~ x4 + x5 + x6
            speed   =~ x7 + x8 + x9 '
fit_hs <- cfa(mod_hs, data = HolzingerSwineford1939)
kable(tabla_ajuste(fit_hs, etiquetas = "3 factores (teorico)"),
      caption = "El modelo teorico se queda corto: CFI por debajo de .95 y RMSEA arriba de .06")

El modelo teorico se queda corto: CFI por debajo de .95 y RMSEA arriba de .06

	chisq	gl	p	CFI	TLI	RMSEA	SRMR	admisible
3 factores (teorico)	85.31	24	0	0.931	0.896	0.092	0.065	TRUE

El CFI de 0.931 y el RMSEA de 0.092 son aceptables pero no buenos. Antes de tocar nada, conviene ver donde falla:

x2 (.42) y x3 (.58) sostienen mal al factor visual

Factor	Item	Carga_estandarizada	p
visual	x2	0.424	0
speed	x7	0.570	0
visual	x3	0.581	0
speed	x9	0.665	0
speed	x8	0.723	0
visual	x1	0.772	0
textual	x6	0.838	0
textual	x4	0.852	0
textual	x5	0.855	0

mi_hs <- modindices(fit_hs, sort. = TRUE)
kable(head(mi_hs[, c("lhs","op","rhs","mi","epc","sepc.all")], 6), row.names = FALSE,
      digits = 3, caption = "Indices de modificacion: x9 quiere cargar tambien en visual")

Indices de modificacion: x9 quiere cargar tambien en visual

lhs	op	rhs	mi	epc	sepc.all
visual	=~	x9	36.411	0.577	0.515
x7		x8	34.145	0.536	0.859
visual	=~	x7	18.631	-0.422	-0.349
x8		x9	14.946	-0.423	-0.805
textual	=~	x3	9.151	-0.272	-0.238
x2		x7	8.918	-0.183	-0.192

El indice mas grande no es un error residual cualquiera: es visual =~ x9, con un MI de 36.4. Eso tiene lectura sustantiva. La prueba x9 mide velocidad para contar puntos en figuras: es una tarea de rapidez, si, pero el estimulo es visual. No es raro que comparta varianza con el factor visual.

2.2 Depuracion: un solo parametro, elegido por teoria y no por el indice mas alto

mod_hs2 <- ' visual  =~ x1 + x2 + x3 + x9
             textual =~ x4 + x5 + x6
             speed   =~ x7 + x8 + x9 '
fit_hs2 <- cfa(mod_hs2, data = HolzingerSwineford1939)

# alternativa que el MI tambien sugiere, pero sin lectura sustantiva clara
mod_hs3 <- paste(mod_hs, "\n x7 ~~ x9")
fit_hs3 <- cfa(mod_hs3, data = HolzingerSwineford1939)

kable(tabla_ajuste(fit_hs, fit_hs2, fit_hs3,
      etiquetas = c("3 factores (teorico)", "x9 carga tambien en visual",
                    "covarianza residual x7 ~~ x9")),
      caption = "Solo la carga cruzada de x9 mueve el ajuste a territorio bueno")

Solo la carga cruzada de x9 mueve el ajuste a territorio bueno

	chisq	gl	p	CFI	TLI	RMSEA	SRMR	admisible
3 factores (teorico)	85.31	24	0	0.931	0.896	0.092	0.065	TRUE
x9 carga tambien en visual	52.38	23	0	0.967	0.948	0.065	0.045	TRUE
covarianza residual x7 x9	79.80	23	0	0.936	0.899	0.091	0.062	TRUE

comparar(fit_hs, fit_hs2,
         c("3 factores (teorico)", "x9 carga tambien en visual"),
         "Liberar un solo parametro mejora el ajuste de forma significativa")

Liberar un solo parametro mejora el ajuste de forma significativa

Modelo	gl	AIC	BIC	chisq	dif. chisq	dif. gl	p
x9 carga tambien en visual	23	7487	7568	52.38	NA	NA	NA
3 factores (teorico)	24	7518	7595	85.31	32.92	1	0

La diferencia de chi-cuadrada es significativa con un solo grado de libertad: liberar visual =~ x9 mejora el ajuste de forma real, no marginal. La covarianza residual x7 ~~ x9, en cambio, casi no mueve nada (CFI 0.936), lo cual confirma que el problema no es ruido compartido entre dos pruebas de velocidad sino que x9 mide dos cosas a la vez.

2.3 Honestidad sobre la depuracion: validarla en una muestra que no la sugirio

Aqui esta el riesgo del que casi nunca se habla. Un indice de modificacion se calcula sobre los mismos datos que se van a usar para juzgar el modelo mejorado. Seguirlo es, en el limite, ajustarle el modelo al ruido de esta muestra. La unica defensa real es verificar que el hallazgo se repite en datos que no participaron en la decision.

La base trae dos escuelas. Uso una para descubrir y la otra para confirmar:

val <- do.call(rbind, lapply(levels(HolzingerSwineford1939$school), function(esc) {
  sub <- HolzingerSwineford1939[HolzingerSwineford1939$school == esc, ]
  a <- cfa(mod_hs,  data = sub)
  b <- cfa(mod_hs2, data = sub)
  data.frame(Escuela = esc, n = nrow(sub),
             CFI_base = round(fitMeasures(a, "cfi"), 3),
             CFI_depurado = round(fitMeasures(b, "cfi"), 3),
             RMSEA_base = round(fitMeasures(a, "rmsea"), 3),
             RMSEA_depurado = round(fitMeasures(b, "rmsea"), 3),
             carga_x9_visual = round(subset(standardizedSolution(b),
                                     lhs == "visual" & rhs == "x9")$est.std, 3))
}))
kable(val, row.names = FALSE, caption = "La carga cruzada de x9 aparece en las dos escuelas, pero no con la misma fuerza")

La carga cruzada de x9 aparece en las dos escuelas, pero no con la misma fuerza

Escuela	n	CFI_base	CFI_depurado	RMSEA_base	RMSEA_depurado	carga_x9_visual
Grant-White	145	0.941	0.989	0.089	0.040	0.447
Pasteur	156	0.903	0.927	0.104	0.092	0.310

El resultado se repite en ambas escuelas, asi que no es un artefacto: x9 carga en visual en las dos. Pero la magnitud cae de 0.447 en Grant-White a 0.31 en Pasteur, y en Pasteur el modelo depurado sigue sin alcanzar el criterio (CFI 0.927, RMSEA 0.092). Es decir: la correccion es real, pero el modelo depurado que reporto arriba se ve mejor de lo que es porque se estimo en la muestra completa, incluyendo la escuela donde el efecto es fuerte.

2.4 Conclusiones del ejercicio 1

1. El modelo teorico de tres factores es defendible pero incompleto: ajusta de forma aceptable (CFI 0.931) y no buena.
2. La causa es una variable que mide dos constructos. x9 pertenece a velocidad por su formato y a visual por su contenido. Es un problema de diseno del instrumento, no de estimacion.
3. Depurar guiado por indices de modificacion funciona, pero el ajuste que resulta esta inflado por haber usado los mismos datos para descubrir y para evaluar. La validacion entre escuelas lo demuestra.
4. Regla que me llevo: solo libero un parametro si puedo explicarlo antes de verlo en la tabla de MI. visual =~ x9 pasa esa prueba; x7 ~~ x9 no, y ademas no servia.

3 Ejercicio 2: democracia politica e industrializacion (Bollen)

3.1 El modelo obvio ajusta mal, y la razon es que ignora que son las mismas preguntas dos veces

La base de Bollen sigue a 75 paises en desarrollo. ind60 es industrializacion en 1960 (x1–x3); dem60 y dem65 son democracia politica en 1960 y 1965, medidas con los mismos cuatro indicadores (y1–y4 y y5–y8 respectivamente). La hipotesis es que la industrializacion impulsa la democracia, en parte de forma directa y en parte a traves de la democracia previa.

mod_pd <- '
  ind60 =~ x1 + x2 + x3
  dem60 =~ y1 + y2 + y3 + y4
  dem65 =~ y5 + y6 + y7 + y8
  dem60 ~ ind60
  dem65 ~ ind60 + dem60 '
fit_pd <- cfa(mod_pd, data = PoliticalDemocracy)
kable(tabla_ajuste(fit_pd, etiquetas = "sin errores correlacionados"),
      caption = "RMSEA de .101: el modelo deja algo importante fuera")

RMSEA de .101: el modelo deja algo importante fuera

	chisq	gl	p	CFI	TLI	RMSEA	SRMR	admisible
sin errores correlacionados	72.46	41	0.002	0.953	0.938	0.101	0.055	TRUE

Todos los indices altos son covarianzas entre errores de y

lhs	op	rhs	mi	epc
y2		y6	9.279	2.129
y6		y8	8.668	1.513
y1		y5	8.183	0.884
y3		y6	6.574	-1.590
y1		y3	5.204	1.024
y2		y4	4.911	1.432

Los seis indices mas grandes son covarianzas entre residuales de los indicadores y, y ninguno involucra a las x. Eso no es casualidad. El indicador y1 (libertad de prensa en 1960) y el y5 (libertad de prensa en 1965) son la misma pregunta aplicada cinco anios despues: comparten no solo el constructo democracia, sino la fuente, el sesgo del codificador y la idiosincrasia del pais. Esa varianza compartida es metodo, no constructo, y si no se modela se acumula en el residual del sistema.

3.2 El modelo correcto: dejar que los errores del mismo indicador se correlacionen en el tiempo

mod_pd2 <- '
  ind60 =~ x1 + x2 + x3
  dem60 =~ y1 + y2 + y3 + y4
  dem65 =~ y5 + y6 + y7 + y8
  dem60 ~ a*ind60
  dem65 ~ c*ind60 + b*dem60
  # errores autocorrelacionados: mismo indicador medido en 1960 y en 1965
  y1 ~~ y5
  y2 ~~ y4 + y6
  y3 ~~ y7
  y4 ~~ y8
  y6 ~~ y8
  # descomposicion del efecto de la industrializacion sobre la democracia de 1965
  indirecto := a*b
  total     := c + a*b '
fit_pd2 <- sem(mod_pd2, data = PoliticalDemocracy)
kable(tabla_ajuste(fit_pd, fit_pd2,
      etiquetas = c("sin errores correlacionados", "con errores correlacionados")),
      caption = "El ajuste pasa de dudoso a muy bueno con seis parametros que la teoria de medicion exige")

El ajuste pasa de dudoso a muy bueno con seis parametros que la teoria de medicion exige

	chisq	gl	p	CFI	TLI	RMSEA	SRMR	admisible
sin errores correlacionados	72.46	41	0.002	0.953	0.938	0.101	0.055	TRUE
con errores correlacionados	38.13	35	0.329	0.995	0.993	0.035	0.044	TRUE

comparar(fit_pd, fit_pd2,
         c("sin errores correlacionados", "con errores correlacionados"),
         "Los seis errores correlacionados no son opcionales: su omision es rechazada")

Los seis errores correlacionados no son opcionales: su omision es rechazada

Modelo	gl	AIC	BIC	chisq	dif. chisq	dif. gl	p
con errores correlacionados	35	3158	3229	38.13	NA	NA	NA
sin errores correlacionados	41	3180	3238	72.46	34.34	6	0

3.3 Efectos directo, indirecto y total

ef <- parameterEstimates(fit_pd2, standardized = TRUE)
ef <- subset(ef, op %in% c("~", ":="))[, c("lhs","rhs","label","est","se","pvalue","std.all")]
names(ef) <- c("Destino","Origen","Etiqueta","Estimado","EE","p","Estandarizado")
kable(ef, row.names = FALSE, digits = 3,
      caption = "El grueso del efecto de la industrializacion sobre la democracia de 1965 es indirecto")

El grueso del efecto de la industrializacion sobre la democracia de 1965 es indirecto

Destino	Origen	Etiqueta	Estimado	EE	p	Estandarizado
dem60	ind60	a	1.483	0.399	0.00	0.447
dem65	ind60	c	0.572	0.221	0.01	0.182
dem65	dem60	b	0.837	0.098	0.00	0.885
indirecto	a*b	indirecto	1.242	0.355	0.00	0.395
total	c+a*b	total	1.814	0.374	0.00	0.578

La lectura sustantiva: de un efecto total estandarizado de 0.578, la parte indirecta (0.395) es 68% del total. La industrializacion de 1960 no produce democracia en 1965 por si sola: la produce sobre todo porque ya habia producido democracia en 1960, y la democracia es altamente persistente (b estandarizado = 0.885, casi un techo).

3.4 Conclusiones del ejercicio 2

1. El mal ajuste inicial no era del modelo estructural, era del modelo de medicion. Las flechas entre latentes estaban bien; lo que faltaba era reconocer que el mismo indicador medido dos veces arrastra su propio error.
2. Los seis parametros que agregue no se justifican por su MI sino por el diseno del estudio: son datos longitudinales con indicadores repetidos. Ese es el caso donde liberar covarianzas residuales es obligatorio, no oportunista.
3. La descomposicion directo / indirecto cambia la conclusion de politica publica: industrializar hoy tiene efecto sobre la democracia futura principalmente a traves de la democracia presente, es decir, hay dependencia de la trayectoria.

4 Ejercicio 3: bienestar de los colaboradores

d <- read.csv("datos/datos_sem.csv")
c(observaciones = nrow(d), variables = ncol(d), valores_faltantes = sum(is.na(d)))

##     observaciones         variables valores_faltantes 
##               223                51                 0

La base tiene 223 colaboradores, sin valores faltantes. Las escalas de recuperacion y energia van de 1 a 7 y la de engagement de 0 a 7.

Nota de verificacion. La descripcion de instrumentos nombra los items de energia recuperada como REG01–REG10 y marca REG01, REG09 y REG10 como eliminados; la base los trae como EN01–EN08 sin EN03. La correspondencia exacta entre las dos numeraciones no esta documentada, asi que trabajo con los siete items tal como vienen y no asumo que EN0k sea REG0k. Igual conviene confirmarlo con el profesor. La misma hoja indica que la escala de engagement es “Nunca = 0, Casi nunca = 2, …” (sin el 1), pero la base si contiene unos; lo trato como escala continua de 0 a 7.

4.1 Parte 1: analisis factorial confirmatorio de segundo orden de las experiencias de recuperacion

4.1.1 El modelo de primer orden con los 31 items no pasa

Las experiencias de recuperacion se miden con cuatro dominios: desapego psicologico, relajacion, maestria y control sobre el tiempo libre.

items_rec <- list(
  DESAPEGO   = grep("^RPD", names(d), value = TRUE),
  RELAJACION = grep("^RRE", names(d), value = TRUE),
  MAESTRIA   = grep("^RMA", names(d), value = TRUE),
  CONTROL    = grep("^RCO", names(d), value = TRUE))
sapply(items_rec, length)

##   DESAPEGO RELAJACION   MAESTRIA    CONTROL 
##          9          7          9          6

# arma la sintaxis de lavaan a partir de la lista de items
sintaxis <- function(lista) {
  paste(mapply(function(nombre, its) paste0(nombre, " =~ ", paste(its, collapse = " + ")),
               names(lista), lista), collapse = "\n")
}
fit_r1 <- cfa(sintaxis(items_rec), data = d, estimator = "MLR")
kable(tabla_ajuste(fit_r1, etiquetas = "4 factores, 31 items"),
      caption = "Ningun criterio se cumple: hay que depurar")

Ningun criterio se cumple: hay que depurar

	chisq	gl	p	CFI	TLI	RMSEA	SRMR	admisible
4 factores, 31 items	1215	428	0	0.888	0.879	0.091	0.071	TRUE

El diagnostico: items casi identicos entre si y un item que carga en el factor equivocado

lhs	op	rhs	mi	epc	sepc.all
RPD06		RPD08	109.27	1.232	0.758
RPD09		RPD10	96.96	0.840	0.813
RMA02		RMA03	47.44	0.812	0.504
CONTROL	=~	RMA06	44.90	0.437	0.455
RPD02		RPD07	41.02	0.544	0.500
RRE02		RRE03	33.78	0.298	0.468
RELAJACION	=~	RMA06	32.24	0.479	0.389
RRE04		RRE05	30.91	0.216	0.511

El diagnostico es claro y tiene sentido leyendo los reactivos:

• RPD06 ~~ RPD08 (MI = 109): “A proposito no hice, ni revise nada de mi trabajo” y “Con toda intencion no hice nada sobre mi trabajo” son la misma frase.
• RPD09 ~~ RPD10: “Logre desligarme de mis responsabilidades laborales” y “Me deslinde de mis actividades laborales”, igual.
• CONTROL =~ RMA06: “Utilice mi tiempo en actividades diferentes” habla de como dispongo de mi tiempo, no de retarme a aprender. Esta en el factor equivocado.

Esto no es ruido estadistico: es redundancia de redaccion en el instrumento. Dos items que dicen lo mismo comparten varianza que ningun factor comun puede explicar, y el modelo lo registra como desajuste.

4.1.2 Una regla de depuracion explicita, con piso de tres items por factor

Depurar a ojo es donde se cuela el sesgo. Escribo la regla como funcion para que sea auditable y para que el orden de eliminacion no dependa de mi criterio del momento:

# Regla, en este orden de prioridad:
#   1. carga estandarizada < .70            -> el item no mide el factor
#   2. carga cruzada con MI > 20            -> el item mide otro factor
#   3. residuales correlacionados con MI>20 -> redundancia: cae el de menor carga
# Restriccion dura: ningun factor puede quedar con menos de 3 items, porque
# un factor de 2 indicadores no se identifica por si solo y el constructo se vacia.
factor_de <- function(lista, item) names(lista)[sapply(lista, function(v) item %in% v)][1]
protegido <- function(lista, item, min_items) length(lista[[factor_de(lista, item)]]) <= min_items

depurar <- function(lista, datos, max_iter = 15, min_items = 3,
                    corte = c(cfi = .95, rmsea = .06, srmr = .08)) {
  traza <- NULL
  for (k in 0:max_iter) {
    fit <- cfa(sintaxis(lista), data = datos, estimator = "MLR")
    fm  <- fitMeasures(fit, IDX)
    fila <- data.frame(paso = k, items = sum(lengths(lista)),
                       chisq = round(fm[["chisq"]], 1), gl = fm[["df"]],
                       CFI = round(fm[["cfi"]], 3), TLI = round(fm[["tli"]], 3),
                       RMSEA = round(fm[["rmsea"]], 3), SRMR = round(fm[["srmr"]], 3),
                       eliminado = NA_character_, motivo = NA_character_)
    if (fm[["cfi"]] >= corte["cfi"] && fm[["rmsea"]] <= corte["rmsea"] &&
        fm[["srmr"]] <= corte["srmr"]) { traza <- rbind(traza, fila); break }

    ld <- subset(standardizedSolution(fit), op == "=~")
    mi <- modindices(fit)
    cand <- NA_character_; motivo <- NA_character_

    baja <- ld[order(ld$est.std), ]
    baja <- baja[baja$est.std < .70 & !sapply(baja$rhs, protegido, lista = lista,
                                              min_items = min_items), ]
    if (nrow(baja) > 0) {
      cand <- baja$rhs[1]; motivo <- sprintf("carga %.2f < .70", baja$est.std[1])
    }
    if (is.na(cand)) {
      cc <- subset(mi, op == "=~" & mi > 20); cc <- cc[order(-cc$mi), ]
      cc <- cc[!sapply(cc$rhs, protegido, lista = lista, min_items = min_items), ]
      if (nrow(cc) > 0) {
        cand <- cc$rhs[1]; motivo <- sprintf("carga cruzada en %s (MI=%.0f)", cc$lhs[1], cc$mi[1])
      }
    }
    if (is.na(cand)) {
      rr <- subset(mi, op == "~~" & lhs != rhs & mi > 20); rr <- rr[order(-rr$mi), ]
      for (i in seq_len(nrow(rr))) {
        par <- c(rr$lhs[i], rr$rhs[i])
        par <- par[order(ld$est.std[match(par, ld$rhs)])]   # primero el de menor carga
        libre <- par[!sapply(par, protegido, lista = lista, min_items = min_items)]
        if (length(libre) > 0) {
          cand <- libre[1]
          motivo <- sprintf("redundante con %s (MI=%.0f)", setdiff(par, cand), rr$mi[i])
          break
        }
      }
    }
    if (is.na(cand)) {
      fila$motivo <- "sin candidatos elegibles: se detiene"
      traza <- rbind(traza, fila); break
    }
    fila$eliminado <- cand; fila$motivo <- motivo
    traza <- rbind(traza, fila)
    lista[[factor_de(lista, cand)]] <- setdiff(lista[[factor_de(lista, cand)]], cand)
  }
  list(items = lista, traza = traza, fit = fit)
}

dep_rec <- depurar(items_rec, d)
kable(dep_rec$traza, row.names = FALSE,
      caption = "Traza completa de la depuracion: que se elimino, en que paso y por que")

Traza completa de la depuracion: que se elimino, en que paso y por que

paso	items	chisq	gl	CFI	TLI	RMSEA	SRMR	eliminado	motivo
0	31	1215.4	428	0.888	0.879	0.091	0.071	RMA06	carga 0.58 < .70
1	30	1117.6	399	0.896	0.887	0.090	0.057	RRE10	carga 0.70 < .70
2	29	1074.0	371	0.896	0.886	0.092	0.057	RPD06	redundante con RPD08 (MI=109)
3	28	910.7	344	0.912	0.903	0.086	0.056	RPD09	redundante con RPD10 (MI=102)
4	27	781.3	318	0.924	0.916	0.081	0.057	RMA02	redundante con RMA03 (MI=46)
5	26	695.5	293	0.931	0.924	0.078	0.056	RRE02	redundante con RRE03 (MI=34)
6	25	645.6	269	0.932	0.925	0.079	0.055	RRE04	carga cruzada en MAESTRIA (MI=23)
7	24	552.3	246	0.941	0.934	0.075	0.050	RRE03	redundante con RRE05 (MI=25)
8	23	474.5	224	0.949	0.943	0.071	0.050	RPD07	redundante con RPD02 (MI=23)
9	22	426.0	203	0.952	0.945	0.070	0.049	RMA03	redundante con RMA05 (MI=20)
10	21	361.6	183	0.959	0.953	0.066	0.047	NA	sin candidatos elegibles: se detiene

Instrumento depurado

Factor	Items_finales	Cuales
DESAPEGO	6	RPD01, RPD02, RPD03, RPD05, RPD08, RPD10
RELAJACION	3	RRE05, RRE06, RRE07
MAESTRIA	6	RMA04, RMA05, RMA07, RMA08, RMA09, RMA10
CONTROL	6	RCO02, RCO03, RCO04, RCO05, RCO06, RCO07

De 31 items quedan 21. Se eliminaron: RPD06, RPD07, RPD09, RRE02, RRE03, RRE04, RRE10, RMA02, RMA03, RMA06.

4.1.3 La depuracion redescubre lo que los autores del instrumento ya sabian

Este es el control de calidad que le da credibilidad al procedimiento. La hoja de instrumentos marca como (eliminated) varios items que sin embargo siguen en la base: RPD01, RPD06, RMA02 y RMA06. Si mi regla es buena, deberia volver a encontrarlos sin haberlos visto:

Coincidencia entre la depuracion ciega y las eliminaciones documentadas

Item	Marcado_por_los_autores	Mi_regla
RPD01	eliminado	lo conserva
RPD06	eliminado	tambien lo elimina
RMA02	eliminado	tambien lo elimina
RMA06	eliminado	tambien lo elimina

Tres de cuatro coinciden. El unico que conservo es RPD01 (“Me olvide del trabajo”), que en esta muestra carga 0.811 y no viola ningun criterio. Que una regla mecanica reproduzca decisiones que se tomaron por juicio de expertos es la mejor evidencia de que no estoy solo persiguiendo indices.

4.1.4 El modelo de segundo orden: los cuatro dominios son facetas de un mismo constructo

Hasta aqui tengo cuatro factores correlacionados. La pregunta del ejercicio es si existe un factor superior, experiencias de recuperacion, que explique por que esos cuatro correlacionan. Es una hipotesis mas fuerte y por lo tanto mas facil de refutar: el modelo de segundo orden reproduce las seis correlaciones entre dominios con solo cuatro cargas, asi que gasta dos grados de libertad menos.

mod_seg <- paste(sintaxis(dep_rec$items),
                 "\n RECUPERACION =~ DESAPEGO + RELAJACION + MAESTRIA + CONTROL")
fit_seg <- cfa(mod_seg, data = d, estimator = "MLR")
kable(tabla_ajuste(dep_rec$fit, fit_seg,
      etiquetas = c("1er orden: 4 factores correlacionados", "2o orden: RECUPERACION")),
      caption = "El factor de segundo orden no cuesta ajuste")

El factor de segundo orden no cuesta ajuste

	chisq	gl	p	CFI	TLI	RMSEA	SRMR	admisible
1er orden: 4 factores correlacionados	361.6	183	0	0.959	0.953	0.066	0.047	TRUE
2o orden: RECUPERACION	368.0	185	0	0.958	0.953	0.067	0.055	TRUE

comparar(dep_rec$fit, fit_seg,
         c("1er orden: 4 factores correlacionados", "2o orden: RECUPERACION"),
         "La estructura jerarquica no empeora el modelo de forma detectable")

La estructura jerarquica no empeora el modelo de forma detectable

Modelo	gl	AIC	BIC	chisq	dif. chisq	dif. gl	p
1er orden: 4 factores correlacionados	183	14529	14692	361.6	NA	NA	NA
2o orden: RECUPERACION	185	14531	14688	368.0	5.712	2	0.0575

Cargas de segundo orden: los cuatro dominios pertenecen al mismo constructo

Dominio	Carga estandarizada	EE	p
DESAPEGO	0.664	0.045	0
RELAJACION	0.915	0.039	0
MAESTRIA	0.632	0.059	0
CONTROL	0.836	0.043	0

La diferencia de chi-cuadrada con 2 grados de libertad no es significativa (p = 0.057): imponer la estructura jerarquica no empeora el modelo de forma detectable. Las cuatro cargas son significativas, pero desiguales: relajacion (0.915) y control (0.836) son casi sinonimos del constructo general, mientras desapego (0.664) y maestria (0.632) conservan bastante identidad propia. Traducido: quien se recupera bien casi siempre se relaja y controla su tiempo, pero desconectarse mentalmente y buscar retos son cosas que algunas personas hacen y otras no, con relativa independencia de su nivel general de recuperacion.

4.2 Parte 2: analisis factorial confirmatorio del constructo de energia recuperada

items_en <- grep("^EN0", names(d), value = TRUE)
fit_en <- cfa(paste0("ENERGIA =~ ", paste(items_en, collapse = " + ")),
              data = d, estimator = "MLR")
kable(tabla_ajuste(fit_en, etiquetas = "ENERGIA unidimensional, 7 items"),
      caption = "CFI, TLI y SRMR excelentes; RMSEA fuera de criterio")

CFI, TLI y SRMR excelentes; RMSEA fuera de criterio

	chisq	gl	p	CFI	TLI	RMSEA	SRMR	admisible
ENERGIA unidimensional, 7 items	47.22	14	0	0.986	0.978	0.103	0.012	TRUE

kable(cargas(fit_en), row.names = FALSE, digits = 3,
      caption = "Las siete cargas por arriba de .89")

Las siete cargas por arriba de .89

Factor	Item	Carga_estandarizada	p
ENERGIA	EN01	0.893	0
ENERGIA	EN04	0.924	0
ENERGIA	EN07	0.928	0
ENERGIA	EN02	0.933	0
ENERGIA	EN05	0.939	0
ENERGIA	EN06	0.940	0
ENERGIA	EN08	0.946	0

Los siete items se agrupan en una sola dimension, y de forma contundente: la carga mas baja es 0.893 y el SRMR es 0.012, practicamente cero. La respuesta a la pregunta del ejercicio es si.

El RMSEA de 0.103 parece contradecirlo. No lo hace, y vale la pena entender por que en lugar de “arreglarlo”:

dep_en <- depurar(list(ENERGIA = items_en), d)
kable(dep_en$traza, row.names = FALSE,
      caption = "La regla de depuracion no encuentra un solo item que eliminar")

La regla de depuracion no encuentra un solo item que eliminar

paso	items	chisq	gl	CFI	TLI	RMSEA	SRMR	eliminado	motivo
0	7	47.2	14	0.986	0.978	0.103	0.012	NA	sin candidatos elegibles: se detiene

Ningun item tiene carga baja, ninguno carga en otro factor, y el residual correlacionado mas grande tiene MI de 12, por debajo del umbral. No hay nada que depurar. El RMSEA alto es consecuencia de su formula: penaliza por grado de libertad, y con solo 14 grados de libertad y cargas tan altas, cualquier discrepancia minima se amplifica. Es el problema conocido de RMSEA en modelos pequenios (Kenny, Kaniskan y McCoach, 2015). Forzar la mejora eliminando items buenos seria maquillar el indice a costa del constructo.

Lo que si me preocupa es lo contrario: cargas de .89 a .95 entre siete reactivos sugieren que el instrumento pregunta lo mismo siete veces (“me siento renovado”, “me siento como nuevo”, “recupere mi energia”). Mide bien, pero es ineficiente: tres items probablemente darian la misma informacion.

4.3 Parte 3: analisis de senderos con la energia recuperada como mediadora

4.3.1 Construccion de los compuestos

for (nm in names(dep_rec$items)) d[[nm]] <- rowMeans(d[, dep_rec$items[[nm]]])
d$RECUP <- rowMeans(d[, names(dep_rec$items)])   # promedio de los 4 dominios
d$ENER  <- rowMeans(d[, items_en])
items_eng <- c("EVI01","EVI02","EVI03","EDE01","EDE02","EDE03","EAB01","EAB02","EAB03")
d$ENGA  <- rowMeans(d[, items_eng])
kable(round(cor(d[, c("DESAPEGO","RELAJACION","MAESTRIA","CONTROL","RECUP","ENER","ENGA")]), 2),
      caption = "Matriz de correlaciones de los compuestos")

Matriz de correlaciones de los compuestos

	DESAPEGO	RELAJACION	MAESTRIA	CONTROL	RECUP	ENER	ENGA
DESAPEGO	1.00	0.58	0.31	0.56	0.77	0.58	0.40
RELAJACION	0.58	1.00	0.56	0.70	0.88	0.65	0.43
MAESTRIA	0.31	0.56	1.00	0.51	0.74	0.55	0.39
CONTROL	0.56	0.70	0.51	1.00	0.85	0.71	0.48
RECUP	0.77	0.88	0.74	0.85	1.00	0.77	0.53
ENER	0.58	0.65	0.55	0.71	0.77	1.00	0.60
ENGA	0.40	0.43	0.39	0.48	0.53	0.60	1.00

Cada dominio pesa igual en RECUP (promedio de promedios, no promedio de items), para que desapego con seis items no domine a relajacion con tres.

4.3.2 Por que el modelo de mediacion simple no se puede evaluar por ajuste

mod_sat <- ' ENER ~ a*RECUP
             ENGA ~ cp*RECUP + b*ENER
             indirecto := a*b
             total     := cp + a*b '
fit_sat <- sem(mod_sat, data = d, se = "bootstrap", bootstrap = 1000)
kable(tabla_ajuste(fit_sat, etiquetas = "mediacion parcial (3 variables)"),
      caption = "Ajuste perfecto y vacio: el modelo esta saturado")

Ajuste perfecto y vacio: el modelo esta saturado

	chisq	gl	p	CFI	TLI	RMSEA	SRMR	admisible
mediacion parcial (3 variables)	0	0	NA	1	1	0	0	TRUE

El ejercicio pide revisar los indices de ajuste, y aqui la respuesta correcta es que no dicen nada. Con tres variables observadas hay 6 momentos y el modelo estima 6 parametros: cero grados de libertad. CFI = 1 y RMSEA = 0 son aritmetica, no evidencia. Un modelo saturado reproduce cualquier matriz de covarianzas, incluida una generada al azar.

Para que el ajuste signifique algo hay que imponer una restriccion falsable. Dos caminos, y tomo los dos.

4.3.3 Camino 1: la mediacion completa como hipotesis contrastable

mod_full <- ' ENER ~ a*RECUP
              ENGA ~ b*ENER
              indirecto := a*b '
fit_full <- sem(mod_full, data = d)
kable(tabla_ajuste(fit_full, fit_sat,
      etiquetas = c("mediacion completa (gl=1)", "mediacion parcial (gl=0)")),
      caption = "Al fijar el camino directo en cero, el modelo por fin se puede refutar")

Al fijar el camino directo en cero, el modelo por fin se puede refutar

	chisq	gl	p	CFI	TLI	RMSEA	SRMR	admisible
mediacion completa (gl=1)	3.61	1	0.057	0.991	0.974	0.108	0.026	TRUE
mediacion parcial (gl=0)	0.00	0	NA	1.000	1.000	0.000	0.000	TRUE

comparar(fit_full, fit_sat,
         c("mediacion completa", "mediacion parcial"),
         "Prueba de la restriccion de mediacion completa (mediacion simple)")

Prueba de la restriccion de mediacion completa (mediacion simple)

Modelo	gl	AIC	BIC	chisq	dif. chisq	dif. gl	p
mediacion parcial	0	1388	1405	0.00	NA	NA	NA
mediacion completa	1	1390	1403	3.61	3.613	1	0.0573

4.3.4 Camino 2: abrir la recuperacion en sus cuatro dominios

mod_dom <- ' ENER ~ a1*DESAPEGO + a2*RELAJACION + a3*MAESTRIA + a4*CONTROL
             ENGA ~ b*ENER
             i_desapego   := a1*b
             i_relajacion := a2*b
             i_maestria   := a3*b
             i_control    := a4*b '
fit_dom <- sem(mod_dom, data = d, se = "bootstrap", bootstrap = 1000)

mod_dom_p <- ' ENER ~ a1*DESAPEGO + a2*RELAJACION + a3*MAESTRIA + a4*CONTROL
               ENGA ~ b*ENER + c1*DESAPEGO + c2*RELAJACION + c3*MAESTRIA + c4*CONTROL '
fit_dom_p <- sem(mod_dom_p, data = d)

kable(tabla_ajuste(fit_dom, fit_dom_p,
      etiquetas = c("mediacion completa (gl=4)", "mediacion parcial (saturado)")),
      caption = "El modelo de mediacion completa ajusta casi perfecto con 4 grados de libertad")

El modelo de mediacion completa ajusta casi perfecto con 4 grados de libertad

	chisq	gl	p	CFI	TLI	RMSEA	SRMR	admisible
mediacion completa (gl=4)	4.33	4	0.363	0.999	0.998	0.019	0.023	TRUE
mediacion parcial (saturado)	0.00	0	NA	1.000	1.000	0.000	0.000	TRUE

comparar(fit_dom, fit_dom_p,
         c("mediacion completa", "mediacion parcial"),
         "Quitar los cuatro caminos directos no empeora el modelo")

Quitar los cuatro caminos directos no empeora el modelo

Modelo	gl	AIC	BIC	chisq	dif. chisq	dif. gl	p
mediacion parcial	0	1392	1430	0.00	NA	NA	NA
mediacion completa	4	1389	1412	4.33	4.33	4	0.3632

La chi-cuadrada de 4.33 con 4 grados de libertad no es significativa (p = 0.363). Eliminar los cuatro caminos directos no empeora el modelo. Y el modelo saturado explica por que:

Ninguno de los cuatro caminos directos hacia engagement es significativo

Destino	Origen	Estimado	EE	p	Estandarizado
ENGA	ENER	0.410	0.072	0.000	0.477
ENGA	DESAPEGO	0.055	0.060	0.365	0.063
ENGA	RELAJACION	-0.016	0.081	0.842	-0.017
ENGA	MAESTRIA	0.077	0.062	0.215	0.084
ENGA	CONTROL	0.080	0.086	0.354	0.079

Ninguno de los cuatro dominios llega al engagement por su cuenta. Toda la relacion pasa por la energia recuperada.

4.3.5 Efectos indirectos, con intervalos bootstrap

ef3 <- parameterEstimates(fit_dom, boot.ci.type = "perc", standardized = TRUE)
ef3 <- subset(ef3, op %in% c("~", ":="))[, c("lhs","rhs","label","est","se",
                                             "pvalue","ci.lower","ci.upper","std.all")]
kable(ef3, row.names = FALSE, digits = 3,
      col.names = c("Destino","Origen","Etiqueta","Est","EE","p","IC 2.5%","IC 97.5%","Estand."),
      caption = "Efectos del modelo de mediacion completa (1000 remuestreos bootstrap)")

Efectos del modelo de mediacion completa (1000 remuestreos bootstrap)

Destino	Origen	Etiqueta	Est	EE	p	IC 2.5%	IC 97.5%	Estand.
ENER	DESAPEGO	a1	0.216	0.060	0.000	0.108	0.347	0.215
ENER	RELAJACION	a2	0.164	0.080	0.040	-0.006	0.310	0.148
ENER	MAESTRIA	a3	0.216	0.067	0.001	0.102	0.357	0.202
ENER	CONTROL	a4	0.452	0.086	0.000	0.280	0.605	0.383
ENGA	ENER	b	0.519	0.065	0.000	0.397	0.651	0.603
i_desapego	a1*b	i_desapego	0.112	0.033	0.001	0.056	0.190	0.130
i_relajacion	a2*b	i_relajacion	0.085	0.043	0.046	-0.003	0.167	0.089
i_maestria	a3*b	i_maestria	0.112	0.038	0.003	0.049	0.192	0.122
i_control	a4*b	i_control	0.235	0.057	0.000	0.128	0.349	0.231

r2 <- inspect(fit_dom, "r2")
kable(data.frame(Variable = names(r2), R2 = round(as.numeric(r2), 3)),
      row.names = FALSE, caption = "Varianza explicada")

Varianza explicada

Variable	R2
ENER	0.602
ENGA	0.364

El producto de coeficientes no se distribuye normal, por eso el intervalo bootstrap y no el error estandar de Wald. Y la diferencia importa: relajacion tiene p = 0.046 por Wald pero su intervalo bootstrap (-0.003 a 0.167) incluye el cero. Con el criterio mas exigente, que es el correcto aqui, su efecto no esta demostrado.

Orden de importancia por efecto indirecto estandarizado:

Control sobre el tiempo libre es, por mucho, el dominio que mas rinde

Dominio	Efecto indirecto estand.	IC 2.5%	IC 97.5%	Conclusion
i_control	0.231	0.128	0.349	efecto sostenido
i_desapego	0.130	0.056	0.190	efecto sostenido
i_maestria	0.122	0.049	0.192	efecto sostenido
i_relajacion	0.089	-0.003	0.167	no distinguible de cero

4.3.6 Lectura para la organizacion

El resultado tiene una implicacion practica concreta y algo incomoda para las areas de recursos humanos: el engagement no se compra con actividades de bienestar. Ninguna de las cuatro experiencias de recuperacion mueve el engagement directamente. Lo mueven solo en la medida en que el colaborador efectivamente recupera energia. Un programa de yoga al que la gente asiste sin desconectarse no cambia nada.

Y entre los cuatro dominios, el que mas rinde es control sobre el tiempo libre (0.231), que no cuesta presupuesto: cuesta politica de la empresa. Es la diferencia entre organizar actividades para la gente y dejar que la gente decida como usa su tiempo.

4.4 Parte 4: el modelo de medicion

El modelo de senderos de la Parte 3 supone algo fuerte y falso: que los compuestos miden sin error. Un promedio de items no es el constructo. El modelo de medicion levanta ese supuesto poniendo cada variable latente con sus indicadores.

kable(round(cor(d[, items_eng]), 2),
      caption = "Los items de engagement: correlaciones que decaen segun la distancia en el cuestionario")

Los items de engagement: correlaciones que decaen segun la distancia en el cuestionario

	EVI01	EVI02	EVI03	EDE01	EDE02	EDE03	EAB01	EAB02	EAB03
EVI01	1.00	0.94	0.80	0.82	0.74	0.61	0.70	0.53	0.44
EVI02	0.94	1.00	0.78	0.82	0.73	0.62	0.70	0.55	0.44
EVI03	0.80	0.78	1.00	0.87	0.78	0.60	0.73	0.53	0.44
EDE01	0.82	0.82	0.87	1.00	0.89	0.67	0.80	0.58	0.49
EDE02	0.74	0.73	0.78	0.89	1.00	0.74	0.79	0.59	0.53
EDE03	0.61	0.62	0.60	0.67	0.74	1.00	0.73	0.72	0.58
EAB01	0.70	0.70	0.73	0.80	0.79	0.73	1.00	0.66	0.58
EAB02	0.53	0.55	0.53	0.58	0.59	0.72	0.66	1.00	0.73
EAB03	0.44	0.44	0.44	0.49	0.53	0.58	0.58	0.73	1.00

Antes de estimar hay que ver el problema. La matriz no tiene la estructura de bloques que predice la teoria de tres factores (vigor, dedicacion, absorcion). Tiene un gradiente: cada item correlaciona mas con el que esta a su lado en el cuestionario (EVI01–EVI02 = .94, EDE01–EDE02 = .89) y menos conforme se aleja (EVI01–EAB03 = .44). EDE01 correlaciona mas con EVI03 (.87), que es de otro factor, que con EDE03 (.67), que es del suyo. Eso es un efecto de proximidad en el instrumento, no la estructura del constructo.

mod_eng3 <- ' VIGOR      =~ EVI01 + EVI02 + EVI03
              DEDICACION =~ EDE01 + EDE02 + EDE03
              ABSORCION  =~ EAB01 + EAB02 + EAB03 '
fit_eng3 <- cfa(mod_eng3, data = d, estimator = "MLR")
fit_eng2 <- cfa(paste(mod_eng3, "\n ENGAGEMENT =~ VIGOR + DEDICACION + ABSORCION"),
                data = d, estimator = "MLR")
kable(tabla_ajuste(fit_eng3, fit_eng2,
      etiquetas = c("3 factores correlacionados", "2o orden: ENGAGEMENT")),
      caption = "El modelo de segundo orden entrega una solucion INADMISIBLE")

El modelo de segundo orden entrega una solucion INADMISIBLE

	chisq	gl	p	CFI	TLI	RMSEA	SRMR	admisible
3 factores correlacionados	271.2	24	0	0.889	0.833	0.215	0.07	TRUE
2o orden: ENGAGEMENT	271.2	24	0	0.889	0.833	0.215	0.07	FALSE

Una carga estandarizada mayor que 1: caso Heywood

Parametro	Valor
Carga DEDICACION en ENGAGEMENT	1.013
Correlacion DEDICACION–ABSORCION	0.913
Correlacion VIGOR–DEDICACION	0.881

Aqui esta el punto central de toda la actividad, y aparece antes de mirar ningun indice de ajuste: la carga estandarizada de dedicacion sobre engagement es mayor que 1, lo que implica una varianza de error negativa. Es un caso Heywood: un resultado imposible. Los indices de ajuste del modelo de segundo orden son identicos a los del de tres factores, asi que si me hubiera guiado solo por CFI y RMSEA no habria notado nada. Un modelo con una estimacion inadmisible se descarta, sin importar como ajuste.

La causa es visible en la tabla: dedicacion y absorcion correlacionan .91 y vigor con dedicacion .88. A ese nivel los tres factores no son distinguibles, y el factor de segundo orden intenta explicar mas covarianza de la que existe.

mod_medicion <- '
  DESAPEGO   =~ RPD01 + RPD02 + RPD03 + RPD05 + RPD08 + RPD10
  RELAJACION =~ RRE05 + RRE06 + RRE07
  MAESTRIA   =~ RMA04 + RMA05 + RMA07 + RMA08 + RMA09 + RMA10
  CONTROL    =~ RCO02 + RCO03 + RCO04 + RCO05 + RCO06 + RCO07
  ENERGIA    =~ EN01 + EN02 + EN04 + EN05 + EN06 + EN07 + EN08
  ENGAGEMENT =~ EVI01 + EVI02 + EVI03 + EDE01 + EDE02 + EDE03 + EAB01 + EAB02 + EAB03
  RECUPERACION =~ DESAPEGO + RELAJACION + MAESTRIA + CONTROL
  # los dos pares casi identicos que detecto el diagnostico de proximidad
  EVI01 ~~ EVI02
  EAB02 ~~ EAB03
  RECUPERACION ~~ ENERGIA + ENGAGEMENT
  ENERGIA ~~ ENGAGEMENT '
fit_med <- cfa(mod_medicion, data = d, estimator = "MLR")
kable(tabla_ajuste(fit_med, etiquetas = "modelo de medicion completo"),
      caption = "Ajuste aceptable y solucion admisible")

Ajuste aceptable y solucion admisible

	chisq	gl	p	CFI	TLI	RMSEA	SRMR	admisible
modelo de medicion completo	1290	620	0	0.93	0.925	0.07	0.059	TRUE

El modelo de medicion completo estima 83 parametros con 223 observaciones. Ajusta de forma aceptable pero no buena (CFI 0.93, RMSEA 0.07), y el desajuste esta concentrado en el bloque de engagement:

Los residuales mas grandes siguen siendo de los items de engagement

lhs	op	rhs	mi	epc
EDE03		EAB02	31.35	0.342
EDE01		EDE03	25.83	-0.253
EDE03		EAB01	21.32	0.294
RCO03		RCO06	20.77	-0.194
DESAPEGO	=~	RRE05	20.16	0.265
DESAPEGO	=~	EN01	19.36	0.232

4.4.1 El modelo estructural latente confirma la conclusion de la Parte 3

base_med <- sub("RECUPERACION ~~ ENERGIA \\+ ENGAGEMENT\n  ENERGIA ~~ ENGAGEMENT", "",
                mod_medicion)
fit_lat_c <- sem(paste(base_med, "
  ENERGIA    ~ a*RECUPERACION
  ENGAGEMENT ~ b*ENERGIA
  indirecto := a*b "), data = d, estimator = "MLR")
fit_lat_p <- sem(paste(base_med, "
  ENERGIA    ~ a*RECUPERACION
  ENGAGEMENT ~ b*ENERGIA + cp*RECUPERACION
  indirecto := a*b
  total     := cp + a*b "), data = d, estimator = "MLR")
kable(tabla_ajuste(fit_lat_c, fit_lat_p,
      etiquetas = c("latente: mediacion completa", "latente: mediacion parcial")),
      caption = "Mismo resultado que con compuestos: el camino directo no hace falta")

Mismo resultado que con compuestos: el camino directo no hace falta

	chisq	gl	p	CFI	TLI	RMSEA	SRMR	admisible
latente: mediacion completa	1294	621	0	0.929	0.924	0.07	0.063	TRUE
latente: mediacion parcial	1290	620	0	0.930	0.925	0.07	0.059	TRUE

comparar(fit_lat_c, fit_lat_p,
         c("latente: mediacion completa", "latente: mediacion parcial"),
         "Con variables latentes la conclusion no cambia")

Con variables latentes la conclusion no cambia

Modelo	gl	AIC	BIC	chisq	dif. chisq	dif. gl	p
latente: mediacion parcial	620	24164	24447	1290	NA	NA	NA
latente: mediacion completa	621	24166	24445	1294	2.205	1	0.1375

Efectos con variables latentes (mediacion parcial)

Destino	Origen	Etiqueta	Est	EE	p	Estand.
ENERGIA	RECUPERACION	a	1.433	0.144	0.000	0.835
ENGAGEMENT	ENERGIA	b	0.379	0.129	0.003	0.428
ENGAGEMENT	RECUPERACION	cp	0.353	0.228	0.121	0.233
indirecto	a*b	indirecto	0.543	0.195	0.005	0.357
total	cp+a*b	total	0.897	0.132	0.000	0.590

La conclusion sustantiva no depende de como se mida: es robusta

Especificacion	Camino directo estand.	p del directo	R2 de engagement
Compuestos (Parte 3)	0.158	0.110	0.374
Latente (Parte 4)	0.233	0.121	0.403

Corregir por error de medicion sube la magnitud de los efectos, como se espera (las correlaciones atenuadas por falta de fiabilidad se desatenuan), pero no cambia la conclusion: el camino directo sigue sin ser significativo y la varianza explicada del engagement es practicamente la misma. La mediacion completa se sostiene con las dos especificaciones.

4.5 Conclusiones del ejercicio 3

1. El instrumento de recuperacion tenia grasa. De 31 items quedaron
   21. Lo que se elimino no fueron items malos sino items repetidos: pares que dicen lo mismo con otras palabras. La regla de depuracion redescubrio tres de las cuatro eliminaciones que ya habian documentado los autores.
2. El constructo de segundo orden se sostiene. Los cuatro dominios son facetas de una sola capacidad de recuperacion, y renunciar a las seis correlaciones libres a cambio de cuatro cargas no cuesta ajuste (p = 0.057).
3. La energia recuperada es unidimensional, con cargas de .89 a .95. El RMSEA alto es un artefacto de tener pocos grados de libertad, no evidencia de mala estructura, y no se corrige tirando items.
4. La mediacion es completa. Las experiencias de recuperacion no tocan el engagement por su cuenta: lo tocan solo a traves de la energia efectivamente recuperada (p = 0.363 para la restriccion de mediacion completa, y ningun camino directo significativo).
5. Control sobre el tiempo libre es la palanca. Efecto indirecto estandarizado de 0.231, casi el doble del siguiente. Relajacion, en cambio, no sobrevive al intervalo bootstrap.
6. La escala de engagement no replica su estructura teorica en esta muestra. El modelo de segundo orden produce un caso Heywood, y el patron de correlaciones apunta a un efecto de proximidad en el cuestionario. Este es el hallazgo que conecta directamente con el ejercicio 4.

5 Ejercicio 4: Behson, Eddy y Lorenzet (2000)

5.1 Los dos modelos que compiten

Behson, Eddy y Lorenzet (2000) juntan 13 estudios sobre el Modelo de Caracteristicas del Puesto de Hackman y Oldham en un meta-analisis, arman con el una matriz de correlaciones y estiman sobre ella dos modelos rivales:

Los dos modelos del articulo

Modelo	Estructura	Caminos	Supuesto
Modelo 1: JCM original (3 etapas)	5 caracteristicas del puesto -> 3 estados psicologicos criticos -> 3 resultados	14	mediacion completa por los estados psicologicos
Modelo 2: JCM como se prueba (2 etapas)	5 caracteristicas del puesto -> 3 resultados (los estados se omiten)	15	efecto directo, sin mecanismo intermedio

El Modelo 1 es la teoria original: las caracteristicas del puesto (variedad, significado, identidad, autonomia, retroalimentacion) producen tres estados psicologicos criticos (significado experimentado, responsabilidad experimentada, conocimiento de resultados) y son estos los que producen satisfaccion, satisfaccion de crecimiento y motivacion interna. El Modelo 2 es como casi toda la literatura posterior lo ha probado: brincandose los estados psicologicos.

5.2 Lo que reporta el articulo

Tabla 4 del articulo. El Modelo 2 gana en GFI, CFI, AIC y CAIC

Estadistico	Modelo_1	Modelo_2
Chi-cuadrada (gl)	124.25 (25)	12.09 (3)
RMSEA	.14	.16
GFI	.91	.99
CFI	.89	.98
Caminos significativos	12 de 14	7 de 15
R2 satisfaccion	.42	.37
R2 crecimiento	.42	.43
R2 motivacion	.38	.32
AIC	294.48	80.09
CAIC	446.29	227.56

Los autores lo dicen sin rodeos: el AIC y el CAIC, que son los unicos estadisticos que usan para comparar formalmente los dos modelos, favorecen al Modelo 2. Y aun asi eligen el Modelo 1.

5.3 Replicacion: la matriz del articulo esta publicada, asi que se puede verificar

La Tabla 2 del articulo publica la matriz de correlaciones meta-analitica completa y las desviaciones estandar normativas de Oldham, Hackman y Stepina (1979). Con eso se puede reconstruir la matriz de covarianzas y volver a estimar los dos modelos.

v   <- c("VAR","SIG","IDE","AUT","FBK","MEA","RES","KNO","SAT","GRO","MOT")
sdv <- c(1.57, 1.25, 1.44, 1.39, 1.34, 1.14, 0.96, 1.14, 1.07, 1.15, 0.77)
R <- diag(11); dimnames(R) <- list(v, v)
tri <- list(c(.41), c(.22,.20), c(.43,.32,.32), c(.35,.34,.26,.39),
            c(.46,.45,.24,.42,.38), c(.34,.33,.27,.39,.34,.59),
            c(.16,.23,.28,.29,.49,.40,.34), c(.35,.29,.22,.42,.36,.65,.49,.42),
            c(.50,.38,.26,.54,.44,.65,.51,.40,.69),
            c(.35,.33,.17,.30,.42,.57,.59,.25,.43,.50))
for (i in 2:11) { R[i, 1:(i-1)] <- tri[[i-1]]; R[1:(i-1), i] <- tri[[i-1]] }
S <- diag(sdv) %*% R %*% diag(sdv); dimnames(S) <- dimnames(R)
N <- 208   # los autores usan la mediana del tamanio de muestra, no la suma

mod_b1 <- '
  MEA ~ VAR + SIG + IDE
  RES ~ AUT
  KNO ~ FBK
  SAT ~ MEA + RES + KNO
  GRO ~ MEA + RES + KNO
  MOT ~ MEA + RES + KNO
  MEA ~~ RES + KNO
  RES ~~ KNO
  SAT ~~ GRO + MOT
  GRO ~~ MOT '
fit_b1 <- sem(mod_b1, sample.cov = S, sample.nobs = N, fixed.x = FALSE)
round(fitMeasures(fit_b1, c("chisq","df","cfi","rmsea","gfi")), 3)

##   chisq      df     cfi   rmsea     gfi 
## 106.967  25.000   0.884   0.126   0.943

round(inspect(fit_b1, "r2"), 3)

##   MEA   RES   KNO   SAT   GRO   MOT 
## 0.205 0.082 0.187 0.419 0.418 0.382

El Modelo 1 se reproduce casi exactamente

Cantidad	Articulo	Replicacion
Grados de libertad	25	25
Caminos significativos	12 de 14	12 de 14
R2 satisfaccion	.42	0.419
R2 crecimiento	.42	0.418
R2 motivacion	.38	0.382

La replicacion del Modelo 1 es practicamente exacta: mismos grados de libertad, mismos 12 de 14 caminos significativos y las tres R2 coinciden al segundo decimal. Eso valida que la matriz esta bien reconstruida y que entendi la especificacion.

o8 <- c("VAR","SIG","IDE","AUT","FBK","SAT","GRO","MOT")
mod_b2 <- '
  SAT ~ VAR + SIG + IDE + AUT + FBK
  GRO ~ VAR + SIG + IDE + AUT + FBK
  MOT ~ VAR + SIG + IDE + AUT + FBK '
# auto.cov.y = FALSE reproduce los 3 grados de libertad que reporta el articulo
fit_b2 <- sem(mod_b2, sample.cov = S[o8, o8], sample.nobs = N,
              fixed.x = FALSE, auto.cov.y = FALSE)
round(fitMeasures(fit_b2, c("chisq","df","cfi","rmsea","gfi")), 3)

##   chisq      df     cfi   rmsea     gfi 
## 100.258   3.000   0.692   0.395   0.897

Nota de verificacion. Los grados de libertad coinciden (3), pero la chi-cuadrada que obtengo es 100.26 contra los 12.09 publicados, y el CFI me da 0.692 contra .98. La razon es identificable: con 3 grados de libertad las tres covarianzas entre los residuales de los resultados estan fijas en cero, y satisfaccion con crecimiento correlacionan .69 en la matriz publicada, asi que esa restriccion tiene que producir un desajuste enorme. Si se liberan esas tres covarianzas el modelo queda saturado (gl = 0, ajuste perfecto). No existe una especificacion que de al mismo tiempo gl = 3 y chi-cuadrada = 12.09 con la matriz que ellos publican. Dado que el Modelo 1 si se reproduce, la inconsistencia esta en el reporte del Modelo 2, no en mi reconstruccion. Conviene contrastarlo con el profesor.

5.4 La comparacion por AIC del articulo no es valida, y eso refuerza su propia decision

Independientemente del punto anterior, hay un problema mas grave con el argumento cuantitativo del articulo. El AIC y el CAIC son el unico criterio formal que usan para declarar superior al Modelo 2. Pero comparan dos modelos ajustados a conjuntos distintos de variables observadas: el Modelo 1 usa 11 variables (66 momentos) y el Modelo 2 usa 8 (36 momentos). La verosimilitud de ambos no esta en la misma escala.

# dos modelos de ajuste PERFECTO, uno con 11 variables y otro con 8
sat11 <- paste(apply(t(combn(v, 2)), 1, function(p) paste(p[1], "~~", p[2])), collapse = "\n")
fit_s11 <- sem(sat11, sample.cov = S, sample.nobs = N)
fit_s8  <- sem(paste(mod_b2, "\n SAT ~~ GRO + MOT \n GRO ~~ MOT"),
               sample.cov = S[o8, o8], sample.nobs = N, fixed.x = FALSE)
kable(data.frame(
  Modelo = c("Saturado, 11 variables (ajuste perfecto)",
             "Saturado, 8 variables (ajuste perfecto)"),
  chisq = c(0, 0), gl = c(0, 0),
  AIC = round(c(fitMeasures(fit_s11, "aic"), fitMeasures(fit_s8, "aic")), 0)),
  row.names = FALSE,
  caption = "Dos modelos con ajuste identicamente perfecto y AIC separados por mas de mil puntos")

Dos modelos con ajuste identicamente perfecto y AIC separados por mas de mil puntos

Modelo	chisq	gl	AIC
Saturado, 11 variables (ajuste perfecto)	0	0	6455
Saturado, 8 variables (ajuste perfecto)	0	0	4952

Los dos modelos de la tabla ajustan perfecto, y aun asi sus AIC difieren en 1503 puntos. La diferencia no mide calidad de ajuste: mide cuantas variables entraron al modelo. Un modelo con menos variables siempre va a tener menor AIC, aunque sea peor teoria. Por lo tanto el argumento “el AIC y el CAIC favorecen al Modelo 2” no sostiene lo que se le pide sostener.

5.5 Por que eligieron el Modelo 1: la respuesta del articulo

Los autores no invocan el argumento anterior. Su razon es distinta y, en mi lectura, mas fuerte todavia. La formulan asi: comparar modelos rivales exige mas que comparar razones de ajuste, porque la razonabilidad de los valores del modelo y su correspondencia con la teoria son igual o mas importantes.

El hecho concreto que los decide esta en los coeficientes:

pb2 <- subset(parameterEstimates(fit_b2, standardized = TRUE), op == "~")
tres <- pb2[pb2$rhs %in% c("VAR","SIG","IDE"), ]
kable(tres[, c("lhs","rhs","est","se","pvalue","std.all")], row.names = FALSE, digits = 3,
      col.names = c("Resultado","Caracteristica","Estimado","EE","p","Estandarizado"),
      caption = "Modelo 2: los caminos desde variedad, significado e identidad hacia los resultados")

Modelo 2: los caminos desde variedad, significado e identidad hacia los resultados

Resultado	Caracteristica	Estimado	EE	p	Estandarizado
SAT	VAR	0.093	0.048	0.056	0.136
SAT	SIG	0.073	0.058	0.210	0.086
SAT	IDE	0.035	0.048	0.460	0.048
GRO	VAR	0.182	0.046	0.000	0.248
GRO	SIG	0.099	0.055	0.071	0.108
GRO	IDE	0.028	0.045	0.535	0.035
MOT	VAR	0.078	0.035	0.026	0.159
MOT	SIG	0.088	0.042	0.036	0.143
MOT	IDE	0.005	0.035	0.885	0.009

En el Modelo 2, 6 de los 9 caminos que van de variedad de habilidades, significado de la tarea e identidad de la tarea hacia los resultados no son significativos. El articulo reporta 8 de 9; yo obtengo 6 de 9, con dos casos al filo. La conclusion es la misma: si el Modelo 2 fuera cierto, enriquecer un puesto dandole variedad y significado no serviria de nada. Eso contradice dos decadas de investigacion sobre rediseno del trabajo.

El Modelo 1 resuelve la paradoja:

mod_b1_ind <- '
  MEA ~ v*VAR + s*SIG + i*IDE
  RES ~ AUT
  KNO ~ FBK
  SAT ~ m1*MEA + RES + KNO
  GRO ~ m2*MEA + RES + KNO
  MOT ~ m3*MEA + RES + KNO
  MEA ~~ RES + KNO
  RES ~~ KNO
  SAT ~~ GRO + MOT
  GRO ~~ MOT
  variedad_sat        := v*m1
  variedad_crec       := v*m2
  significado_sat     := s*m1
  significado_crec    := s*m2 '
fit_b1i <- sem(mod_b1_ind, sample.cov = S, sample.nobs = N, fixed.x = FALSE)
kable(subset(parameterEstimates(fit_b1i, standardized = TRUE), op == ":=")[
        , c("lhs","est","se","pvalue","std.all")], row.names = FALSE, digits = 3,
      col.names = c("Efecto indirecto","Estimado","EE","p","Estandarizado"),
      caption = "En el Modelo 1 esos mismos caminos SI existen, pero pasan por el significado experimentado")

En el Modelo 1 esos mismos caminos SI existen, pero pasan por el significado experimentado

Efecto indirecto	Estimado	EE	p	Estandarizado
variedad_sat	0.094	0.023	0	0.144
variedad_crec	0.099	0.024	0	0.142
significado_sat	0.095	0.027	0	0.116
significado_crec	0.101	0.028	0	0.114

Variedad y significado si afectan la satisfaccion y el crecimiento, pero lo hacen a traves del significado experimentado. Al borrar los estados psicologicos, el Modelo 2 no elimina un rodeo innecesario: elimina el mecanismo, y con el desaparece el efecto.

Los autores eligen el Modelo 1, entonces, por cuatro razones acumuladas:

1. Los coeficientes del Modelo 2 contradicen la teoria establecida. Un modelo cuyos parametros no tienen sentido sustantivo no es utilizable, ajuste lo que ajuste.
2. El Modelo 1 explica mas varianza en dos de los tres resultados y tiene mejor proporcion de caminos significativos (12 de 14 contra 7 de 15).
3. El mejor ajuste del Modelo 2 es en buena medida mecanico. Con 3 grados de libertad esta a un paso de estar saturado, y un modelo casi saturado casi no puede desajustar. Los 25 grados de libertad del Modelo 1 son una hipotesis mucho mas expuesta a refutacion. De hecho el RMSEA, que es el unico indice de la tabla que penaliza la falta de parsimonia, es peor en el Modelo 2 (.16 contra .14).
4. El proposito del modelo es explicar, no solo describir. Los estados psicologicos son lo unico sobre lo que un gerente puede actuar con criterio: le dicen por que funciona el rediseno del puesto y cuando no va a funcionar.

5.6 Conclusiones del ejercicio 4: la leccion

Un indice de ajuste mide si el modelo reproduce la matriz de covarianzas. No mide si el modelo es verdadero, ni si es util, ni siquiera si es posible. Elegir modelo por CFI es como elegir un pronostico por su R2 dentro de muestra.

Las tres verificaciones que este articulo me deja como rutina, en este orden:

1. Admisibilidad primero. Antes de leer un solo indice, revisar que no haya varianzas negativas ni cargas estandarizadas mayores que 1. En el ejercicio 3 esto descarto el modelo de engagement de segundo orden antes de que su ajuste identico al de tres factores me hiciera pasarlo por alto.
2. Signo y magnitud de los coeficientes contra la teoria. Un modelo que ajusta mejor pero dice que dar variedad al trabajo no sirve, esta diciendo algo falso.
3. Comparabilidad de la comparacion. Chi-cuadrada solo entre modelos anidados; AIC solo entre modelos sobre las mismas variables. En el ejercicio 3 esto me obligo a fijar el camino directo en cero para poder contrastar algo, en vez de celebrar el CFI = 1 de un modelo saturado.

Y la leccion de fondo, que es la que conecta los cuatro ejercicios: borrar el mediador mejora el ajuste y destruye la explicacion. El Modelo 2 de Behson ajusta mejor porque pide menos; mi modelo de mediacion parcial de la Parte 3 ajustaba perfecto porque no pedia nada. En los dos casos, el modelo que vale es el que se atreve a afirmar el mecanismo y sobrevive a la prueba.

6 Limitaciones

1. Los datos del ejercicio 3 son transversales. Todo el lenguaje causal (“las experiencias de recuperacion producen energia, que produce engagement”) describe la estructura del modelo, no una causalidad demostrada. Con una sola medicion, el modelo inverso (colaboradores comprometidos se recuperan mejor) ajusta igual de bien. Para distinguirlos hace falta medicion repetida, como en el ejercicio 2.
2. Varianza de metodo comun. Recuperacion, energia y engagement se midieron en el mismo cuestionario, con la misma persona y en el mismo momento. Parte de las correlaciones observadas es del instrumento, no de los constructos. El gradiente de proximidad en los items de engagement es evidencia directa de que ese efecto existe en esta base.
3. La depuracion se valido dentro de la misma muestra. En el ejercicio 1 pude usar las dos escuelas como muestras de descubrimiento y confirmacion; en el ejercicio 3, con 223 casos, partir la muestra habria dejado submuestras demasiado chicas para 21 items. Los indices de ajuste del modelo depurado estan por lo tanto optimistas.
4. La escala de engagement no se depuro porque el enunciado la da por depurada. Es la fuente principal del desajuste del modelo de medicion, y su estructura teorica no se sostiene en esta muestra.
5. La replicacion del ejercicio 4 parte de una matriz publicada, no de los datos originales. Las diferencias con lo reportado pueden deberse a decisiones de especificacion en LISREL que el articulo no documenta.

7 Referencias

• Behson, S. J., Eddy, E. R., y Lorenzet, S. J. (2000). The importance of the critical psychological states in the job characteristics model: A meta-analytic and structural equations modeling examination. Current Research in Social Psychology, 5(12), 170–189.
• Bollen, K. A. (1989). Structural equations with latent variables. Wiley.
• Hackman, J. R., y Oldham, G. R. (1976). Motivation through the design of work: Test of a theory. Organizational Behavior and Human Performance, 16(2), 250–279.
• Holzinger, K. J., y Swineford, F. (1939). A study in factor analysis: The stability of a bi-factor solution. University of Chicago.
• Hu, L., y Bentler, P. M. (1999). Cutoff criteria for fit indexes in covariance structure analysis. Structural Equation Modeling, 6(1), 1–55.
• Kenny, D. A., Kaniskan, B., y McCoach, D. B. (2015). The performance of RMSEA in models with small degrees of freedom. Sociological Methods and Research, 44(3), 486–507.
• Rosseel, Y. (2012). lavaan: An R package for structural equation modeling. Journal of Statistical Software, 48(2), 1–36.
• Schaufeli, W. B., y Bakker, A. B. (2003). UWES: Utrecht Work Engagement Scale. Occupational Health Psychology Unit, Utrecht University.

Entorno de ejecucion

Componente	Valor
R	R version 4.6.1 (2026-06-24)
lavaan	0.7.2
Semilla	2026
Observaciones	223