Propósito
Este documento reproduce los análisis definitivos utilizados para
evaluar la consistencia y la evidencia de validez basada en la
estructura interna del CAPL-2 versión Colombia en la base
multicéntrica consolidada.
El flujo reproduce, en este orden:
- Competencia física.
- Motivación y confianza.
- Comportamiento diario.
- Conocimiento y comprensión.
- Correlaciones entre dominios.
- Modelo multidimensional híbrido.
- Modelo jerárquico de segundo orden.
- Análisis de sensibilidad de la estructura global.
- Robustez del puntaje total oficial.
El documento parte de la base final auditada y no reconstruye los
procesos previos de depuración, adaptación transcultural o puntuación
del CAPL-2.
1. Entorno
reproducible
paquetes <- c(
"readxl",
"dplyr",
"tidyr",
"tibble",
"psych",
"lavaan",
"Hmisc",
"knitr"
)
faltantes <- paquetes[
!vapply(paquetes, requireNamespace, logical(1), quietly = TRUE)
]
if (length(faltantes) > 0) {
stop(
paste0(
"Instale antes de continuar: ",
paste(faltantes, collapse = ", ")
)
)
}
library(readxl)
library(dplyr)
library(tidyr)
library(tibble)
library(psych)
library(lavaan)
library(Hmisc)
library(knitr)
set.seed(20260905)
2. Lectura y auditoría
de la base final
archivo <- params$archivo_excel
hoja <- params$hoja_excel
if (!file.exists(archivo)) {
stop(
paste0(
"No se encontró el archivo '", archivo, "'. ",
"Ubíquelo en la misma carpeta del Rmd o ajuste params$archivo_excel."
)
)
}
base_nacional_analitica <- read_excel(
archivo,
sheet = hoja
)
cat("Dimensiones de la base:", dim(base_nacional_analitica), "\n")
## Dimensiones de la base: 843 268
variables_requeridas <- c(
# Identificación
"id_nacional", "region",
# Competencia física
"pacer_20m_laps",
"pacer_score_final",
"plank_time",
"plank_score_final",
"camsa_score_final",
"pc_score_final",
# Comportamiento diario
"step_average_final",
"step_score_final",
"self_report_pa_num",
"self_report_pa_score_final",
"db_score_final",
# Motivación y confianza: reactivos
"csappa1_pos", "csappa2_pos", "csappa3_pos",
"csappa4_pos", "csappa5_pos", "csappa6_pos",
"why_active1_num", "why_active2_num", "why_active3_num",
"feelings_about_pa1_num",
"feelings_about_pa2_num",
"feelings_about_pa3_num",
# Motivación y confianza: componentes
"predilection_score_final",
"adequacy_score_final",
"intrinsic_motivation_score_final",
"pa_competence_score_final",
"mc_score_final",
# Conocimiento y comprensión
"pa_guideline_score_final",
"crf_means_score_final",
"ms_means_score_final",
"sports_skill_score_final",
"fill_in_the_blanks_score_final",
"pa_is_score_item",
"pa_is_also_score_item",
"improve_score_item",
"increase_score_item",
"cooling_score_item",
"heart_rate_score_item",
"ku_score_final",
# Puntaje total
"capl_total_final"
)
faltan_variables <- setdiff(
variables_requeridas,
names(base_nacional_analitica)
)
if (length(faltan_variables) > 0) {
stop(
paste(
"Faltan variables necesarias:",
paste(faltan_variables, collapse = ", ")
)
)
}
disponibilidad <- tibble(
puntaje = c(
"Competencia física",
"Comportamiento diario",
"Motivación y confianza",
"Conocimiento y comprensión",
"CAPL-2 total"
),
variable = c(
"pc_score_final",
"db_score_final",
"mc_score_final",
"ku_score_final",
"capl_total_final"
),
n_valido = c(
sum(!is.na(base_nacional_analitica$pc_score_final)),
sum(!is.na(base_nacional_analitica$db_score_final)),
sum(!is.na(base_nacional_analitica$mc_score_final)),
sum(!is.na(base_nacional_analitica$ku_score_final)),
sum(!is.na(base_nacional_analitica$capl_total_final))
)
)
knitr::kable(
disponibilidad,
caption = "Disponibilidad de los puntajes finales"
)
Disponibilidad de los puntajes finales
| Competencia física |
pc_score_final |
843 |
| Comportamiento diario |
db_score_final |
840 |
| Motivación y confianza |
mc_score_final |
842 |
| Conocimiento y comprensión |
ku_score_final |
842 |
| CAPL-2 total |
capl_total_final |
838 |
n_esperados <- c(
pc_score_final = 843,
db_score_final = 840,
mc_score_final = 842,
ku_score_final = 842,
capl_total_final = 838
)
n_observados <- c(
pc_score_final = sum(!is.na(base_nacional_analitica$pc_score_final)),
db_score_final = sum(!is.na(base_nacional_analitica$db_score_final)),
mc_score_final = sum(!is.na(base_nacional_analitica$mc_score_final)),
ku_score_final = sum(!is.na(base_nacional_analitica$ku_score_final)),
capl_total_final = sum(!is.na(base_nacional_analitica$capl_total_final))
)
auditoria_n <- tibble(
variable = names(n_esperados),
esperado = unname(n_esperados),
observado = unname(n_observados),
coincide = unname(n_esperados == n_observados)
)
knitr::kable(
auditoria_n,
caption = "Control de tamaños analíticos frente a la base definitiva"
)
Control de tamaños analíticos frente a la base
definitiva
| pc_score_final |
843 |
843 |
TRUE |
| db_score_final |
840 |
840 |
TRUE |
| mc_score_final |
842 |
842 |
TRUE |
| ku_score_final |
842 |
842 |
TRUE |
| capl_total_final |
838 |
838 |
TRUE |
if (!all(auditoria_n$coincide)) {
warning(
"Al menos un tamaño analítico no coincide con la versión definitiva de la tesis."
)
}
3. Competencia
física
El dominio se examinó mediante las asociaciones entre PACER, plancha
y CAMSA y mediante un modelo factorial unidimensional. Al contar con
tres indicadores, el modelo es exactamente identificado; por ello, la
interpretación se centra en las cargas factoriales y la admisibilidad de
la solución.
3.1. Correlaciones
entre indicadores
vars_pc <- c(
"pacer_score_final",
"plank_score_final",
"camsa_score_final"
)
pc_rcorr <- Hmisc::rcorr(
as.matrix(
base_nacional_analitica[, vars_pc]
),
type = "pearson"
)
cat("Correlaciones de Pearson:\n")
## Correlaciones de Pearson:
print(round(pc_rcorr$r, 3))
## pacer_score_final plank_score_final camsa_score_final
## pacer_score_final 1.000 0.796 0.740
## plank_score_final 0.796 1.000 0.688
## camsa_score_final 0.740 0.688 1.000
cat("\nN por pareja:\n")
##
## N por pareja:
print(pc_rcorr$n)
## pacer_score_final plank_score_final camsa_score_final
## pacer_score_final 843 843 843
## plank_score_final 843 843 843
## camsa_score_final 843 843 843
3.2. Modelo factorial
unidimensional
modelo_pc_1f <- '
Competencia_fisica =~
pacer_score_final +
plank_score_final +
camsa_score_final
'
ajuste_pc_1f <- cfa(
model = modelo_pc_1f,
data = base_nacional_analitica,
estimator = "MLR",
std.lv = TRUE,
missing = "fiml"
)
pe_pc <- parameterEstimates(
ajuste_pc_1f,
standardized = TRUE
)
cargas_pc <- pe_pc %>%
as_tibble() %>%
filter(op == "=~") %>%
select(
factor = lhs,
indicador = rhs,
estimacion = est,
error_estandar = se,
z,
p = pvalue,
carga_estandarizada = std.all
)
knitr::kable(
cargas_pc,
digits = 3,
caption = "Cargas factoriales del dominio de Competencia física"
)
Cargas factoriales del dominio de Competencia física
| Competencia_fisica |
pacer_score_final |
1.812 |
0.056 |
32.32 |
0 |
0.925 |
| Competencia_fisica |
plank_score_final |
1.439 |
0.045 |
31.92 |
0 |
0.860 |
| Competencia_fisica |
camsa_score_final |
0.840 |
0.031 |
26.78 |
0 |
0.800 |
cat("\nConvergencia:", lavInspect(ajuste_pc_1f, "converged"), "\n")
##
## Convergencia: TRUE
varianzas_negativas_pc <- pe_pc %>%
as_tibble() %>%
filter(
op == "~~",
lhs == rhs,
est < 0
)
cat(
"Número de varianzas negativas:",
nrow(varianzas_negativas_pc),
"\n"
)
## Número de varianzas negativas: 0
4. Motivación y
confianza
Los 12 reactivos se analizaron como variables ordinales. Se evaluó
primero una estructura de cuatro factores correlacionados y después un
modelo jerárquico de segundo orden.
4.1. Reactivos y
estructura de cuatro factores
items_mc <- c(
# Predilección
"csappa1_pos",
"csappa3_pos",
"csappa5_pos",
# Adecuación
"csappa2_pos",
"csappa4_pos",
"csappa6_pos",
# Motivación intrínseca
"why_active1_num",
"why_active2_num",
"why_active3_num",
# Competencia percibida
"feelings_about_pa1_num",
"feelings_about_pa2_num",
"feelings_about_pa3_num"
)
modelo_mc_4f <- '
Predileccion =~
csappa1_pos +
csappa3_pos +
csappa5_pos
Adecuacion =~
csappa2_pos +
csappa4_pos +
csappa6_pos
Motivacion_intrinseca =~
why_active1_num +
why_active2_num +
why_active3_num
Competencia_percibida =~
feelings_about_pa1_num +
feelings_about_pa2_num +
feelings_about_pa3_num
'
ajuste_mc_4f <- cfa(
model = modelo_mc_4f,
data = base_nacional_analitica,
estimator = "WLSMV",
ordered = items_mc,
parameterization = "theta",
std.lv = TRUE
)
extraer_fit <- function(modelo, nombre) {
fm <- fitMeasures(
modelo,
c(
"chisq.scaled",
"df.scaled",
"pvalue.scaled",
"cfi.scaled",
"tli.scaled",
"rmsea.scaled",
"rmsea.ci.lower.scaled",
"rmsea.ci.upper.scaled",
"srmr"
)
)
tibble(
modelo = nombre,
chi2 = unname(fm["chisq.scaled"]),
gl = unname(fm["df.scaled"]),
p = unname(fm["pvalue.scaled"]),
CFI = unname(fm["cfi.scaled"]),
TLI = unname(fm["tli.scaled"]),
RMSEA = unname(fm["rmsea.scaled"]),
RMSEA_LI = unname(fm["rmsea.ci.lower.scaled"]),
RMSEA_LS = unname(fm["rmsea.ci.upper.scaled"]),
SRMR = unname(fm["srmr"])
)
}
fit_mc_4f <- extraer_fit(
ajuste_mc_4f,
"Cuatro factores correlacionados"
)
knitr::kable(
fit_mc_4f,
digits = 3,
caption = "Ajuste del modelo de cuatro factores de Motivación y confianza"
)
Ajuste del modelo de cuatro factores de Motivación y
confianza
| Cuatro factores correlacionados |
86.27 |
48 |
0.001 |
0.99 |
0.986 |
0.031 |
0.02 |
0.041 |
0.034 |
pe_mc_4f <- parameterEstimates(
ajuste_mc_4f,
standardized = TRUE
)
cargas_mc_4f <- pe_mc_4f %>%
as_tibble() %>%
filter(op == "=~") %>%
select(
factor = lhs,
indicador = rhs,
carga_estandarizada = std.all,
p = pvalue
)
knitr::kable(
cargas_mc_4f,
digits = 3,
caption = "Cargas factoriales de los cuatro componentes de Motivación y confianza"
)
Cargas factoriales de los cuatro componentes de Motivación y
confianza
| Predileccion |
csappa1_pos |
0.592 |
0 |
| Predileccion |
csappa3_pos |
0.574 |
0 |
| Predileccion |
csappa5_pos |
0.841 |
0 |
| Adecuacion |
csappa2_pos |
0.557 |
0 |
| Adecuacion |
csappa4_pos |
0.666 |
0 |
| Adecuacion |
csappa6_pos |
0.820 |
0 |
| Motivacion_intrinseca |
why_active1_num |
0.756 |
0 |
| Motivacion_intrinseca |
why_active2_num |
0.725 |
0 |
| Motivacion_intrinseca |
why_active3_num |
0.784 |
0 |
| Competencia_percibida |
feelings_about_pa1_num |
0.706 |
0 |
| Competencia_percibida |
feelings_about_pa2_num |
0.581 |
0 |
| Competencia_percibida |
feelings_about_pa3_num |
0.726 |
0 |
cor_latentes_mc <- pe_mc_4f %>%
as_tibble() %>%
filter(
op == "~~",
lhs != rhs,
lhs %in% c(
"Predileccion",
"Adecuacion",
"Motivacion_intrinseca",
"Competencia_percibida"
),
rhs %in% c(
"Predileccion",
"Adecuacion",
"Motivacion_intrinseca",
"Competencia_percibida"
)
) %>%
select(
factor_1 = lhs,
factor_2 = rhs,
correlacion_estandarizada = std.all,
p = pvalue
)
knitr::kable(
cor_latentes_mc,
digits = 3,
caption = "Correlaciones entre los factores de Motivación y confianza"
)
Correlaciones entre los factores de Motivación y
confianza
| Predileccion |
Adecuacion |
0.243 |
0 |
| Predileccion |
Motivacion_intrinseca |
0.336 |
0 |
| Predileccion |
Competencia_percibida |
0.289 |
0 |
| Adecuacion |
Motivacion_intrinseca |
0.424 |
0 |
| Adecuacion |
Competencia_percibida |
0.457 |
0 |
| Motivacion_intrinseca |
Competencia_percibida |
0.865 |
0 |
4.2. Consistencia
interna ordinal por componente
El alfa ordinal se obtiene a partir de la matriz de correlaciones
policóricas. El omega total se estima sobre la misma matriz, manteniendo
la dirección definitiva de los reactivos.
fiabilidad_ordinal <- function(datos, items, nombre) {
x <- datos %>%
select(all_of(items)) %>%
filter(if_all(everything(), ~ !is.na(.x)))
R <- psych::polychoric(
x,
correct = 0
)$rho
alfa <- psych::alpha(
R,
n.obs = nrow(x),
check.keys = FALSE,
warnings = FALSE
)
omega <- psych::omega(
R,
nfactors = 1,
n.obs = nrow(x),
plot = FALSE
)
tibble(
componente = nombre,
n = nrow(x),
alfa_ordinal = unname(alfa$total$std.alpha),
omega_total = unname(omega$omega.tot)
)
}
tabla_fiabilidad_mc <- bind_rows(
fiabilidad_ordinal(
base_nacional_analitica,
c("csappa1_pos", "csappa3_pos", "csappa5_pos"),
"Predilección"
),
fiabilidad_ordinal(
base_nacional_analitica,
c("csappa2_pos", "csappa4_pos", "csappa6_pos"),
"Adecuación"
),
fiabilidad_ordinal(
base_nacional_analitica,
c("why_active1_num", "why_active2_num", "why_active3_num"),
"Motivación intrínseca"
),
fiabilidad_ordinal(
base_nacional_analitica,
c(
"feelings_about_pa1_num",
"feelings_about_pa2_num",
"feelings_about_pa3_num"
),
"Competencia percibida"
)
)
knitr::kable(
tabla_fiabilidad_mc,
digits = 3,
caption = "Consistencia interna ordinal de los componentes de Motivación y confianza"
)
Consistencia interna ordinal de los componentes de Motivación y
confianza
| Predilección |
841 |
0.701 |
0.711 |
| Adecuación |
838 |
0.723 |
0.727 |
| Motivación intrínseca |
842 |
0.793 |
0.795 |
| Competencia percibida |
843 |
0.711 |
0.713 |
4.3. Modelo
jerárquico de segundo orden
modelo_mc_2orden <- '
Predileccion =~
csappa1_pos +
csappa3_pos +
csappa5_pos
Adecuacion =~
csappa2_pos +
csappa4_pos +
csappa6_pos
Motivacion_intrinseca =~
why_active1_num +
why_active2_num +
why_active3_num
Competencia_percibida =~
feelings_about_pa1_num +
feelings_about_pa2_num +
feelings_about_pa3_num
Motivacion_Confianza =~
Predileccion +
Adecuacion +
Motivacion_intrinseca +
Competencia_percibida
'
ajuste_mc_2orden <- cfa(
model = modelo_mc_2orden,
data = base_nacional_analitica,
estimator = "WLSMV",
ordered = items_mc,
parameterization = "theta",
std.lv = TRUE
)
fit_mc_2orden <- extraer_fit(
ajuste_mc_2orden,
"Modelo jerárquico de segundo orden"
)
knitr::kable(
bind_rows(fit_mc_4f, fit_mc_2orden),
digits = 3,
caption = "Comparación descriptiva de los modelos de Motivación y confianza"
)
Comparación descriptiva de los modelos de Motivación y
confianza
| Cuatro factores correlacionados |
86.27 |
48 |
0.001 |
0.990 |
0.986 |
0.031 |
0.02 |
0.041 |
0.034 |
| Modelo jerárquico de segundo orden |
89.39 |
50 |
0.001 |
0.989 |
0.986 |
0.031 |
0.02 |
0.041 |
0.037 |
pe_mc_2orden <- parameterEstimates(
ajuste_mc_2orden,
standardized = TRUE
)
cargas_mc_segundo <- pe_mc_2orden %>%
as_tibble() %>%
filter(
op == "=~",
lhs == "Motivacion_Confianza"
) %>%
select(
factor = lhs,
componente = rhs,
carga_estandarizada = std.all,
p = pvalue
)
knitr::kable(
cargas_mc_segundo,
digits = 3,
caption = "Cargas de segundo orden de Motivación y confianza"
)
Cargas de segundo orden de Motivación y confianza
| Motivacion_Confianza |
Predileccion |
0.357 |
0.000 |
| Motivacion_Confianza |
Adecuacion |
0.485 |
0.000 |
| Motivacion_Confianza |
Motivacion_intrinseca |
0.922 |
0.000 |
| Motivacion_Confianza |
Competencia_percibida |
0.932 |
0.001 |
cat("\nPrueba robusta de diferencia entre modelos:\n")
##
## Prueba robusta de diferencia entre modelos:
print(
lavTestLRT(
ajuste_mc_4f,
ajuste_mc_2orden
)
)
##
## Scaled Chi-Squared Difference Test (method = "satorra.2000")
##
## lavaan->lavTestLRT():
## lavaan NOTE: The "Chisq" column contains standard test statistics, not the
## robust test that should be reported per model. A robust difference test is
## a function of two standard (not robust) statistics.
##
## Df AIC BIC Chisq Chisq diff RMSEA Df diff Pr(>Chisq)
## ajuste_mc_4f 48 58.5
## ajuste_mc_2orden 50 66.0 4.14 0.0571 2 0.13
5. Comportamiento
diario
Comportamiento diario se trató como un índice compuesto observado. No
se calcularon coeficientes convencionales de consistencia interna porque
el dominio integra dos fuentes de información diferentes: podometría y
autorreporte.
5.1. Asociación entre
las puntuaciones CAPL-2
cor_db_pearson <- cor.test(
base_nacional_analitica$step_score_final,
base_nacional_analitica$self_report_pa_score_final,
method = "pearson"
)
cor_db_spearman <- cor.test(
base_nacional_analitica$step_score_final,
base_nacional_analitica$self_report_pa_score_final,
method = "spearman",
exact = FALSE
)
tabla_db_puntajes <- tibble(
coeficiente = c("Pearson", "Spearman"),
estimacion = c(
unname(cor_db_pearson$estimate),
unname(cor_db_spearman$estimate)
),
p = c(
cor_db_pearson$p.value,
cor_db_spearman$p.value
)
)
knitr::kable(
tabla_db_puntajes,
digits = 4,
caption = "Asociación entre los dos componentes puntuados de Comportamiento diario"
)
Asociación entre los dos componentes puntuados de
Comportamiento diario
| Pearson |
0.0465 |
0.1785 |
| Spearman |
0.0277 |
0.4234 |
5.2. Asociación en
las escalas originales
datos_db <- base_nacional_analitica %>%
transmute(
id_nacional,
region = factor(region),
step_average = as.numeric(step_average_final),
self_report_days = as.numeric(self_report_pa_num)
)
datos_db_completos <- datos_db %>%
filter(
!is.na(step_average),
!is.na(self_report_days)
)
r_db_original <- cor(
datos_db_completos$step_average,
datos_db_completos$self_report_days,
method = "pearson"
)
rho_db_original <- cor(
datos_db_completos$step_average,
datos_db_completos$self_report_days,
method = "spearman"
)
tabla_db_original <- tibble(
analisis = "Medidas originales",
n = nrow(datos_db_completos),
r_pearson = r_db_original,
rho_spearman = rho_db_original
)
knitr::kable(
tabla_db_original,
digits = 3,
caption = "Asociación entre pasos promedio diarios y días de actividad física autorreportados"
)
Asociación entre pasos promedio diarios y días de actividad
física autorreportados
| Medidas originales |
840 |
0.045 |
0.024 |
5.3. Ajuste por
región
modelo_step_region <- lm(
step_average ~ region,
data = datos_db_completos
)
modelo_self_region <- lm(
self_report_days ~ region,
data = datos_db_completos
)
resid_step <- residuals(modelo_step_region)
resid_self <- residuals(modelo_self_region)
tabla_db_ajustada <- tibble(
analisis = "Medidas originales ajustadas por región",
n = nrow(datos_db_completos),
r_pearson = cor(
resid_step,
resid_self,
method = "pearson"
),
rho_spearman = cor(
resid_step,
resid_self,
method = "spearman"
)
)
knitr::kable(
tabla_db_ajustada,
digits = 3,
caption = "Asociación entre componentes de Comportamiento diario después de considerar la región"
)
Asociación entre componentes de Comportamiento diario después
de considerar la región
| Medidas originales ajustadas por región |
840 |
0.043 |
0.031 |
5.4. Asociaciones por
región
correlaciones_db_region <- datos_db %>%
group_by(region) %>%
summarise(
n = sum(
!is.na(step_average) &
!is.na(self_report_days)
),
r_pearson = cor(
step_average,
self_report_days,
use = "complete.obs",
method = "pearson"
),
rho_spearman = cor(
step_average,
self_report_days,
use = "complete.obs",
method = "spearman"
),
.groups = "drop"
)
knitr::kable(
correlaciones_db_region,
digits = 3,
caption = "Asociación entre pasos y autorreporte según región"
)
Asociación entre pasos y autorreporte según región
| Caribe |
140 |
0.226 |
0.169 |
| Centro-Oriente |
140 |
0.114 |
0.126 |
| Centro sur-Amazonía |
139 |
-0.105 |
-0.117 |
| Eje cafetero-Antioquia |
141 |
0.073 |
0.082 |
| Llanos-Orinoquía |
140 |
-0.015 |
-0.013 |
| Pacífico |
140 |
-0.066 |
-0.071 |
6. Conocimiento y
comprensión
Los diez reactivos se analizaron como variables categóricas
dicotómicas.
6.1. Definición de
reactivos
items_ku <- c(
"pa_guideline_score_final",
"crf_means_score_final",
"ms_means_score_final",
"sports_skill_score_final",
"pa_is_score_item",
"pa_is_also_score_item",
"improve_score_item",
"increase_score_item",
"cooling_score_item",
"heart_rate_score_item"
)
datos_ku <- base_nacional_analitica %>%
select(all_of(items_ku))
6.2. Modelo
unidimensional
modelo_ku_1f <- '
KU =~
pa_guideline_score_final +
crf_means_score_final +
ms_means_score_final +
sports_skill_score_final +
pa_is_score_item +
pa_is_also_score_item +
improve_score_item +
increase_score_item +
cooling_score_item +
heart_rate_score_item
'
ajuste_ku_1f <- cfa(
model = modelo_ku_1f,
data = datos_ku,
ordered = items_ku,
estimator = "WLSMV",
parameterization = "theta",
std.lv = TRUE,
missing = "pairwise"
)
fit_ku_1f <- extraer_fit(
ajuste_ku_1f,
"KU unidimensional"
)
knitr::kable(
fit_ku_1f,
digits = 3,
caption = "Ajuste del modelo unidimensional de Conocimiento y comprensión"
)
Ajuste del modelo unidimensional de Conocimiento y
comprensión
| KU unidimensional |
125.8 |
35 |
0 |
0.95 |
0.936 |
0.055 |
0.045 |
0.066 |
0.068 |
cargas_ku_1f <- standardizedSolution(
ajuste_ku_1f
) %>%
as_tibble() %>%
filter(op == "=~") %>%
select(
factor = lhs,
indicador = rhs,
carga_estandarizada = est.std,
p = pvalue
)
knitr::kable(
cargas_ku_1f,
digits = 3,
caption = "Cargas factoriales del modelo unidimensional de Conocimiento y comprensión"
)
Cargas factoriales del modelo unidimensional de Conocimiento y
comprensión
| KU |
pa_guideline_score_final |
0.147 |
0.006 |
| KU |
crf_means_score_final |
0.474 |
0.000 |
| KU |
ms_means_score_final |
0.596 |
0.000 |
| KU |
sports_skill_score_final |
0.489 |
0.000 |
| KU |
pa_is_score_item |
0.640 |
0.000 |
| KU |
pa_is_also_score_item |
0.512 |
0.000 |
| KU |
improve_score_item |
0.716 |
0.000 |
| KU |
increase_score_item |
0.544 |
0.000 |
| KU |
cooling_score_item |
0.671 |
0.000 |
| KU |
heart_rate_score_item |
0.834 |
0.000 |
6.3. Consistencia
interna y análisis de reactivos
alpha_ku <- psych::alpha(
datos_ku,
check.keys = FALSE,
warnings = FALSE
)
tabla_alpha_ku <- tibble(
alfa_crudo = alpha_ku$total$raw_alpha,
alfa_estandarizado = alpha_ku$total$std.alpha
)
knitr::kable(
tabla_alpha_ku,
digits = 3,
caption = "Alfa de Cronbach del dominio de Conocimiento y comprensión"
)
Alfa de Cronbach del dominio de Conocimiento y
comprensión
| 0.71 |
0.707 |
item_total_ku <- alpha_ku$item.stats %>%
as.data.frame() %>%
tibble::rownames_to_column("item") %>%
select(
item,
n,
media = mean,
DE = sd,
correlacion_item_total = r.drop
)
knitr::kable(
item_total_ku,
digits = 3,
caption = "Correlaciones ítem-total corregidas"
)
Correlaciones ítem-total corregidas
| pa_guideline_score_final |
841 |
0.317 |
0.466 |
0.093 |
| crf_means_score_final |
842 |
0.624 |
0.485 |
0.320 |
| ms_means_score_final |
842 |
0.562 |
0.496 |
0.409 |
| sports_skill_score_final |
842 |
0.441 |
0.497 |
0.331 |
| pa_is_score_item |
843 |
0.718 |
0.450 |
0.411 |
| pa_is_also_score_item |
843 |
0.750 |
0.433 |
0.301 |
| improve_score_item |
841 |
0.501 |
0.500 |
0.479 |
| increase_score_item |
843 |
0.442 |
0.497 |
0.348 |
| cooling_score_item |
843 |
0.496 |
0.500 |
0.436 |
| heart_rate_score_item |
842 |
0.546 |
0.498 |
0.561 |
alpha_if_deleted_ku <- alpha_ku$alpha.drop %>%
as.data.frame() %>%
tibble::rownames_to_column("item") %>%
select(
item,
alfa_si_elimina = raw_alpha,
alfa_estandarizado_si_elimina = std.alpha
)
knitr::kable(
alpha_if_deleted_ku,
digits = 3,
caption = "Alfa si se elimina cada reactivo"
)
Alfa si se elimina cada reactivo
| pa_guideline_score_final |
0.730 |
0.729 |
| crf_means_score_final |
0.696 |
0.692 |
| ms_means_score_final |
0.680 |
0.677 |
| sports_skill_score_final |
0.694 |
0.691 |
| pa_is_score_item |
0.681 |
0.677 |
| pa_is_also_score_item |
0.698 |
0.696 |
| improve_score_item |
0.668 |
0.665 |
| increase_score_item |
0.691 |
0.688 |
| cooling_score_item |
0.676 |
0.673 |
| heart_rate_score_item |
0.653 |
0.650 |
cor_tetra_ku <- psych::tetrachoric(
datos_ku,
correct = 0
)$rho
omega_ku <- psych::omega(
cor_tetra_ku,
nfactors = 1,
n.obs = nrow(datos_ku),
plot = FALSE
)
tabla_omega_ku <- tibble(
omega_total = omega_ku$omega.tot,
omega_jerarquico = omega_ku$omega_h
)
knitr::kable(
tabla_omega_ku,
digits = 3,
caption = "Coeficientes omega de Conocimiento y comprensión"
)
Coeficientes omega de Conocimiento y comprensión
| 0.826 |
0.826 |
dificultad_ku <- tibble(
item = items_ku,
n = vapply(
items_ku,
function(v) {
sum(!is.na(base_nacional_analitica[[v]]))
},
numeric(1)
),
proporcion_correcta = vapply(
items_ku,
function(v) {
mean(
base_nacional_analitica[[v]],
na.rm = TRUE
)
},
numeric(1)
)
) %>%
mutate(
porcentaje_correcto = 100 * proporcion_correcta
)
knitr::kable(
dificultad_ku,
digits = 1,
caption = "Proporción de respuestas correctas por reactivo"
)
Proporción de respuestas correctas por reactivo
| pa_guideline_score_final |
841 |
0.3 |
31.7 |
| crf_means_score_final |
842 |
0.6 |
62.4 |
| ms_means_score_final |
842 |
0.6 |
56.2 |
| sports_skill_score_final |
842 |
0.4 |
44.1 |
| pa_is_score_item |
843 |
0.7 |
71.8 |
| pa_is_also_score_item |
843 |
0.7 |
75.0 |
| improve_score_item |
841 |
0.5 |
50.1 |
| increase_score_item |
843 |
0.4 |
44.2 |
| cooling_score_item |
843 |
0.5 |
49.6 |
| heart_rate_score_item |
842 |
0.5 |
54.6 |
7. Correlaciones entre
los cuatro dominios
vars_dominios <- c(
"pc_score_final",
"mc_score_final",
"db_score_final",
"ku_score_final"
)
datos_dominios <- as.matrix(
base_nacional_analitica[, vars_dominios]
)
resultado_spearman <- Hmisc::rcorr(
datos_dominios,
type = "spearman"
)
cat("Rho de Spearman:\n")
## Rho de Spearman:
print(round(resultado_spearman$r, 3))
## pc_score_final mc_score_final db_score_final ku_score_final
## pc_score_final 1.000 -0.163 0.604 -0.067
## mc_score_final -0.163 1.000 0.054 0.169
## db_score_final 0.604 0.054 1.000 0.043
## ku_score_final -0.067 0.169 0.043 1.000
cat("\nP-valores:\n")
##
## P-valores:
print(round(resultado_spearman$P, 4))
## pc_score_final mc_score_final db_score_final ku_score_final
## pc_score_final NA 0.0000 0.0000 0.0518
## mc_score_final 0.0000 NA 0.1161 0.0000
## db_score_final 0.0000 0.1161 NA 0.2177
## ku_score_final 0.0518 0.0000 0.2177 NA
cat("\nN por pareja:\n")
##
## N por pareja:
print(resultado_spearman$n)
## pc_score_final mc_score_final db_score_final ku_score_final
## pc_score_final 843 842 840 842
## mc_score_final 842 842 839 841
## db_score_final 840 839 840 839
## ku_score_final 842 841 839 842
8. Modelo
multidimensional híbrido
Competencia física, Motivación y confianza y Conocimiento y
comprensión se representan como factores latentes. Comportamiento diario
se incorpora como puntuación compuesta observada.
8.1. Preparación
datos_global_hibrido <- base_nacional_analitica %>%
transmute(
# Competencia física
pacer = as.numeric(pacer_20m_laps),
plank = as.numeric(plank_time),
camsa = as.numeric(camsa_score_final),
# Comportamiento diario
db = as.numeric(db_score_final),
# Motivación y confianza
adequacy = as.numeric(adequacy_score_final),
predilection = as.numeric(predilection_score_final),
intrinsic_motivation = as.numeric(intrinsic_motivation_score_final),
pa_competence = as.numeric(pa_competence_score_final),
# Conocimiento y comprensión
pa_guideline = as.numeric(pa_guideline_score_final),
crf = as.numeric(crf_means_score_final),
ms = as.numeric(ms_means_score_final),
sports_skill = as.numeric(sports_skill_score_final),
fill_blanks = as.numeric(fill_in_the_blanks_score_final)
)
ordenados_hibrido <- c(
"pa_guideline",
"crf",
"ms",
"sports_skill",
"fill_blanks"
)
8.2. Modelo
correlacionado
modelo_global_hibrido <- '
Physical_Competence =~
pacer +
plank +
camsa
Motivation_Confidence =~
adequacy +
predilection +
intrinsic_motivation +
pa_competence
Knowledge_Understanding =~
pa_guideline +
crf +
ms +
sports_skill +
fill_blanks
Physical_Competence ~~ Motivation_Confidence
Physical_Competence ~~ Knowledge_Understanding
Motivation_Confidence ~~ Knowledge_Understanding
Physical_Competence ~~ db
Motivation_Confidence ~~ db
Knowledge_Understanding ~~ db
'
ajuste_global_hibrido <- sem(
model = modelo_global_hibrido,
data = datos_global_hibrido,
estimator = "WLSMV",
ordered = ordenados_hibrido,
parameterization = "theta",
std.lv = TRUE,
missing = "pairwise"
)
fit_hibrido <- extraer_fit(
ajuste_global_hibrido,
"Modelo multidimensional híbrido"
)
knitr::kable(
fit_hibrido,
digits = 3,
caption = "Índices de ajuste del modelo multidimensional híbrido"
)
Índices de ajuste del modelo multidimensional híbrido
| Modelo multidimensional híbrido |
191.7 |
60 |
0 |
0.92 |
0.896 |
0.051 |
0.043 |
0.059 |
0.056 |
cargas_hibrido <- standardizedSolution(
ajuste_global_hibrido
) %>%
as_tibble() %>%
filter(op == "=~") %>%
select(
factor = lhs,
indicador = rhs,
carga_estandarizada = est.std,
p = pvalue
)
knitr::kable(
cargas_hibrido,
digits = 3,
caption = "Cargas factoriales del modelo multidimensional híbrido"
)
Cargas factoriales del modelo multidimensional
híbrido
| Physical_Competence |
pacer |
0.912 |
0.000 |
| Physical_Competence |
plank |
0.874 |
0.000 |
| Physical_Competence |
camsa |
0.824 |
0.000 |
| Motivation_Confidence |
adequacy |
0.371 |
0.000 |
| Motivation_Confidence |
predilection |
0.348 |
0.000 |
| Motivation_Confidence |
intrinsic_motivation |
0.657 |
0.000 |
| Motivation_Confidence |
pa_competence |
0.766 |
0.000 |
| Knowledge_Understanding |
pa_guideline |
0.170 |
0.005 |
| Knowledge_Understanding |
crf |
0.662 |
0.000 |
| Knowledge_Understanding |
ms |
0.704 |
0.000 |
| Knowledge_Understanding |
sports_skill |
0.566 |
0.000 |
| Knowledge_Understanding |
fill_blanks |
0.566 |
0.000 |
asociaciones_hibrido <- standardizedSolution(
ajuste_global_hibrido
) %>%
as_tibble() %>%
filter(
op == "~~",
lhs != rhs,
lhs %in% c(
"Physical_Competence",
"Motivation_Confidence",
"Knowledge_Understanding",
"db"
),
rhs %in% c(
"Physical_Competence",
"Motivation_Confidence",
"Knowledge_Understanding",
"db"
)
) %>%
select(
componente_1 = lhs,
componente_2 = rhs,
asociacion_estandarizada = est.std,
p = pvalue
)
knitr::kable(
asociaciones_hibrido,
digits = 3,
caption = "Asociaciones estandarizadas entre los componentes del modelo híbrido"
)
Asociaciones estandarizadas entre los componentes del modelo
híbrido
| Physical_Competence |
Motivation_Confidence |
-0.182 |
0.000 |
| Physical_Competence |
Knowledge_Understanding |
-0.058 |
0.229 |
| Motivation_Confidence |
Knowledge_Understanding |
0.319 |
0.000 |
| Physical_Competence |
db |
0.666 |
0.000 |
| Motivation_Confidence |
db |
0.083 |
0.047 |
| Knowledge_Understanding |
db |
0.073 |
0.106 |
sol_hibrida <- standardizedSolution(
ajuste_global_hibrido
) %>%
as_tibble()
cat(
"\nConvergencia:",
lavInspect(ajuste_global_hibrido, "converged"),
"\n"
)
##
## Convergencia: TRUE
cat(
"Cargas estandarizadas con |lambda| > 1:",
sum(
abs(cargas_hibrido$carga_estandarizada) > 1,
na.rm = TRUE
),
"\n"
)
## Cargas estandarizadas con |lambda| > 1: 0
cat(
"Varianzas residuales negativas:",
sum(
sol_hibrida$op == "~~" &
sol_hibrida$lhs == sol_hibrida$rhs &
sol_hibrida$est.std < 0,
na.rm = TRUE
),
"\n"
)
## Varianzas residuales negativas: 0
9. Modelo jerárquico
de segundo orden
modelo_hibrido_segundo_orden <- '
Physical_Competence =~
pacer +
plank +
camsa
Motivation_Confidence =~
adequacy +
predilection +
intrinsic_motivation +
pa_competence
Knowledge_Understanding =~
pa_guideline +
crf +
ms +
sports_skill +
fill_blanks
Physical_Literacy =~
Physical_Competence +
Motivation_Confidence +
Knowledge_Understanding +
db
'
ajuste_hibrido_segundo_orden <- sem(
model = modelo_hibrido_segundo_orden,
data = datos_global_hibrido,
estimator = "WLSMV",
ordered = ordenados_hibrido,
parameterization = "theta",
std.lv = TRUE,
missing = "pairwise"
)
fit_segundo <- extraer_fit(
ajuste_hibrido_segundo_orden,
"Modelo jerárquico de segundo orden"
)
knitr::kable(
bind_rows(fit_hibrido, fit_segundo),
digits = 3,
caption = "Modelo multidimensional híbrido frente al modelo jerárquico"
)
Modelo multidimensional híbrido frente al modelo
jerárquico
| Modelo multidimensional híbrido |
191.7 |
60 |
0 |
0.920 |
0.896 |
0.051 |
0.043 |
0.059 |
0.056 |
| Modelo jerárquico de segundo orden |
311.2 |
62 |
0 |
0.849 |
0.810 |
0.069 |
0.062 |
0.077 |
0.077 |
cargas_globales <- standardizedSolution(
ajuste_hibrido_segundo_orden
) %>%
as_tibble() %>%
filter(
op == "=~",
lhs == "Physical_Literacy"
) %>%
select(
factor = lhs,
componente = rhs,
carga_estandarizada = est.std,
p = pvalue
)
knitr::kable(
cargas_globales,
digits = 3,
caption = "Cargas de los componentes sobre el factor general de alfabetización física"
)
Cargas de los componentes sobre el factor general de
alfabetización física
| Physical_Literacy |
Physical_Competence |
1.000 |
0.000 |
| Physical_Literacy |
Motivation_Confidence |
0.139 |
0.004 |
| Physical_Literacy |
Knowledge_Understanding |
0.050 |
0.303 |
| Physical_Literacy |
db |
-0.638 |
0.000 |
10. Análisis de
sensibilidad de la estructura global
Estos análisis evalúan si la conclusión general depende de
indicadores particularmente débiles o de la representación del
Comportamiento diario.
ajustar_sensibilidad <- function(modelo, datos, ordenados, nombre) {
fit <- sem(
model = modelo,
data = datos,
estimator = "WLSMV",
ordered = ordenados,
parameterization = "theta",
std.lv = TRUE,
missing = "pairwise"
)
salida <- extraer_fit(fit, nombre) %>%
mutate(
converge = lavInspect(fit, "converged")
)
list(
fit = fit,
resumen = salida
)
}
10.1. Sensibilidad
sin recomendación diaria de actividad física (RGAF)
modelo_s1 <- '
Physical_Competence =~ pacer + plank + camsa
Motivation_Confidence =~
adequacy +
predilection +
intrinsic_motivation +
pa_competence
Knowledge_Understanding =~
crf +
ms +
sports_skill +
fill_blanks
Physical_Competence ~~ Motivation_Confidence
Physical_Competence ~~ Knowledge_Understanding
Physical_Competence ~~ db
Motivation_Confidence ~~ Knowledge_Understanding
Motivation_Confidence ~~ db
Knowledge_Understanding ~~ db
'
s1 <- ajustar_sensibilidad(
modelo_s1,
datos_global_hibrido,
c("crf", "ms", "sports_skill", "fill_blanks"),
"Sensibilidad: sin RGAF"
)
10.2. Sensibilidad
sin RGAF y sin Predilección
modelo_s2 <- '
Physical_Competence =~ pacer + plank + camsa
Motivation_Confidence =~
adequacy +
intrinsic_motivation +
pa_competence
Knowledge_Understanding =~
crf +
ms +
sports_skill +
fill_blanks
Physical_Competence ~~ Motivation_Confidence
Physical_Competence ~~ Knowledge_Understanding
Physical_Competence ~~ db
Motivation_Confidence ~~ Knowledge_Understanding
Motivation_Confidence ~~ db
Knowledge_Understanding ~~ db
'
s2 <- ajustar_sensibilidad(
modelo_s2,
datos_global_hibrido,
c("crf", "ms", "sports_skill", "fill_blanks"),
"Sensibilidad: sin RGAF y sin Predilección"
)
10.3. Sensibilidad
utilizando pasos objetivos en lugar del puntaje compuesto de
Comportamiento diario
datos_sens_pasos <- datos_global_hibrido %>%
mutate(
steps100 = as.numeric(
base_nacional_analitica$step_average_final
) / 100
)
modelo_pasos <- '
Physical_Competence =~ pacer + plank + camsa
Motivation_Confidence =~
adequacy +
predilection +
intrinsic_motivation +
pa_competence
Knowledge_Understanding =~
pa_guideline +
crf +
ms +
sports_skill +
fill_blanks
Physical_Competence ~~ Motivation_Confidence
Physical_Competence ~~ Knowledge_Understanding
Physical_Competence ~~ steps100
Motivation_Confidence ~~ Knowledge_Understanding
Motivation_Confidence ~~ steps100
Knowledge_Understanding ~~ steps100
'
s_pasos <- ajustar_sensibilidad(
modelo_pasos,
datos_sens_pasos,
ordenados_hibrido,
"Sensibilidad: pasos objetivos"
)
tabla_sensibilidad <- bind_rows(
fit_hibrido %>% mutate(converge = lavInspect(ajuste_global_hibrido, "converged")),
s1$resumen,
s2$resumen,
s_pasos$resumen
)
knitr::kable(
tabla_sensibilidad,
digits = 3,
caption = "Resumen de los análisis de sensibilidad de la estructura global"
)
Resumen de los análisis de sensibilidad de la estructura
global
| Modelo multidimensional híbrido |
191.7 |
60 |
0 |
0.920 |
0.896 |
0.051 |
0.043 |
0.059 |
0.056 |
TRUE |
| Sensibilidad: sin RGAF |
197.2 |
49 |
0 |
0.908 |
0.876 |
0.060 |
0.051 |
0.069 |
0.059 |
TRUE |
| Sensibilidad: sin RGAF y sin Predilección |
141.7 |
39 |
0 |
0.931 |
0.903 |
0.056 |
0.046 |
0.066 |
0.053 |
TRUE |
| Sensibilidad: pasos objetivos |
184.7 |
60 |
0 |
0.927 |
0.905 |
0.050 |
0.042 |
0.058 |
0.055 |
TRUE |
11. Robustez del
puntaje total oficial
Este análisis compara el puntaje oficial con dos esquemas
alternativos de combinación de los cuatro dominios.
set.seed(20260905)
base_pesos <- base_nacional_analitica %>%
select(
pc_score_final,
db_score_final,
mc_score_final,
ku_score_final
) %>%
filter(complete.cases(.))
cat(
"N completo en los cuatro dominios:",
nrow(base_pesos),
"\n"
)
## N completo en los cuatro dominios: 838
base_pesos$puntaje_oficial <-
base_pesos$pc_score_final +
base_pesos$db_score_final +
base_pesos$mc_score_final +
base_pesos$ku_score_final
base_pesos$puntaje_igual_rango <-
base_pesos$pc_score_final +
base_pesos$db_score_final +
base_pesos$mc_score_final +
(3 * base_pesos$ku_score_final)
z_dominios <- scale(
base_pesos[
c(
"pc_score_final",
"db_score_final",
"mc_score_final",
"ku_score_final"
)
]
)
base_pesos$puntaje_z <- rowSums(z_dominios)
base_pesos <- base_pesos %>%
mutate(
q_oficial = ntile(puntaje_oficial, 4),
q_z = ntile(puntaje_z, 4),
q_igual = ntile(puntaje_igual_rango, 4)
)
kappa_cuadratico <- function(a, b) {
a <- factor(a, levels = 1:4)
b <- factor(b, levels = 1:4)
tab <- table(a, b)
p_obs <- tab / sum(tab)
p_a <- rowSums(p_obs)
p_b <- colSums(p_obs)
p_esp <- outer(p_a, p_b)
k <- 4
w <- outer(
1:k,
1:k,
function(i, j) {
1 - ((i - j) / (k - 1))^2
}
)
po_w <- sum(w * p_obs)
pe_w <- sum(w * p_esp)
if ((1 - pe_w) == 0) {
return(NA_real_)
}
(po_w - pe_w) / (1 - pe_w)
}
rho_oficial_z <- cor(
base_pesos$puntaje_oficial,
base_pesos$puntaje_z,
method = "spearman"
)
rho_oficial_igual <- cor(
base_pesos$puntaje_oficial,
base_pesos$puntaje_igual_rango,
method = "spearman"
)
acuerdo_oficial_z <- mean(
base_pesos$q_oficial == base_pesos$q_z
)
acuerdo_oficial_igual <- mean(
base_pesos$q_oficial == base_pesos$q_igual
)
kappa_z_quad <- kappa_cuadratico(
base_pesos$q_oficial,
base_pesos$q_z
)
kappa_igual_quad <- kappa_cuadratico(
base_pesos$q_oficial,
base_pesos$q_igual
)
11.1. Bootstrap de
5.000 remuestras
B <- 5000
n <- nrow(base_pesos)
boot_resultados <- matrix(
NA_real_,
nrow = B,
ncol = 6
)
colnames(boot_resultados) <- c(
"rho_oficial_z",
"rho_oficial_igual",
"acuerdo_z",
"acuerdo_igual",
"kappa_z_quad",
"kappa_igual_quad"
)
for (b in seq_len(B)) {
idx <- sample(
seq_len(n),
size = n,
replace = TRUE
)
d <- base_pesos[idx, ]
boot_resultados[b, "rho_oficial_z"] <-
suppressWarnings(
cor(
d$puntaje_oficial,
d$puntaje_z,
method = "spearman"
)
)
boot_resultados[b, "rho_oficial_igual"] <-
suppressWarnings(
cor(
d$puntaje_oficial,
d$puntaje_igual_rango,
method = "spearman"
)
)
boot_resultados[b, "acuerdo_z"] <-
mean(d$q_oficial == d$q_z)
boot_resultados[b, "acuerdo_igual"] <-
mean(d$q_oficial == d$q_igual)
boot_resultados[b, "kappa_z_quad"] <-
kappa_cuadratico(
d$q_oficial,
d$q_z
)
boot_resultados[b, "kappa_igual_quad"] <-
kappa_cuadratico(
d$q_oficial,
d$q_igual
)
}
IC_boot <- apply(
boot_resultados,
2,
function(x) {
quantile(
x,
probs = c(0.025, 0.975),
na.rm = TRUE
)
}
)
tabla_robustez <- tibble(
comparacion = c(
"Oficial vs combinación estandarizada",
"Oficial vs igual rango de contribución"
),
rho_spearman = c(
rho_oficial_z,
rho_oficial_igual
),
rho_IC95_inf = c(
IC_boot["2.5%", "rho_oficial_z"],
IC_boot["2.5%", "rho_oficial_igual"]
),
rho_IC95_sup = c(
IC_boot["97.5%", "rho_oficial_z"],
IC_boot["97.5%", "rho_oficial_igual"]
),
acuerdo_cuartiles = 100 * c(
acuerdo_oficial_z,
acuerdo_oficial_igual
),
acuerdo_IC95_inf = 100 * c(
IC_boot["2.5%", "acuerdo_z"],
IC_boot["2.5%", "acuerdo_igual"]
),
acuerdo_IC95_sup = 100 * c(
IC_boot["97.5%", "acuerdo_z"],
IC_boot["97.5%", "acuerdo_igual"]
),
kappa_ponderado = c(
kappa_z_quad,
kappa_igual_quad
),
kappa_IC95_inf = c(
IC_boot["2.5%", "kappa_z_quad"],
IC_boot["2.5%", "kappa_igual_quad"]
),
kappa_IC95_sup = c(
IC_boot["97.5%", "kappa_z_quad"],
IC_boot["97.5%", "kappa_igual_quad"]
)
)
knitr::kable(
tabla_robustez,
digits = 3,
caption = "Robustez del puntaje total oficial frente a esquemas alternativos"
)
Robustez del puntaje total oficial frente a esquemas
alternativos
| Oficial vs combinación estandarizada |
0.982 |
0.978 |
0.984 |
84.25 |
81.74 |
86.64 |
0.937 |
0.925 |
0.947 |
| Oficial vs igual rango de contribución |
0.906 |
0.892 |
0.918 |
64.68 |
61.46 |
67.90 |
0.850 |
0.831 |
0.868 |
12. Control de
correspondencia con los resultados definitivos
Esta sección no sustituye el análisis. Su finalidad es facilitar la
auditoría del documento reproducible frente a los resultados reportados
en la versión definitiva de la tesis.
control_modelos <- bind_rows(
fit_mc_4f,
fit_mc_2orden,
fit_ku_1f,
fit_ku_2f,
fit_hibrido,
fit_segundo
) %>%
select(
modelo,
CFI,
TLI,
RMSEA,
SRMR
)
knitr::kable(
control_modelos,
digits = 3,
caption = "Resumen de los índices de ajuste obtenidos en los modelos definitivos"
)
Resumen de los índices de ajuste obtenidos en los modelos
definitivos
| Cuatro factores correlacionados |
0.990 |
0.986 |
0.031 |
0.034 |
| Modelo jerárquico de segundo orden |
0.989 |
0.986 |
0.031 |
0.037 |
| KU unidimensional |
0.950 |
0.936 |
0.055 |
0.068 |
| KU dos factores según formato |
0.970 |
0.960 |
0.044 |
0.058 |
| Modelo multidimensional híbrido |
0.920 |
0.896 |
0.051 |
0.056 |
| Modelo jerárquico de segundo orden |
0.849 |
0.810 |
0.069 |
0.077 |
cat("\nCargas de Competencia física:\n")
##
## Cargas de Competencia física:
print(
round(
cargas_pc$carga_estandarizada,
3
)
)
## [1] 0.925 0.860 0.800
cat("\nConsistencia de Motivación y confianza:\n")
##
## Consistencia de Motivación y confianza:
print(
tabla_fiabilidad_mc %>%
select(
componente,
alfa_ordinal,
omega_total
)
)
## # A tibble: 4 × 3
## componente alfa_ordinal omega_total
## <chr> <dbl> <dbl>
## 1 Predilección 0.701 0.711
## 2 Adecuación 0.723 0.727
## 3 Motivación intrínseca 0.793 0.795
## 4 Competencia percibida 0.711 0.713
cat("\nConsistencia de Conocimiento y comprensión:\n")
##
## Consistencia de Conocimiento y comprensión:
print(
tibble(
alfa = alpha_ku$total$raw_alpha,
omega_total = omega_ku$omega.tot
)
)
## # A tibble: 1 × 2
## alfa omega_total
## <dbl> <dbl>
## 1 0.710 0.826
cat("\nRobustez del puntaje total:\n")
##
## Robustez del puntaje total:
print(tabla_robustez)
## # A tibble: 2 × 10
## comparacion rho_spearman rho_IC95_inf rho_IC95_sup acuerdo_cuartiles
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Oficial vs combinaci… 0.982 0.978 0.984 84.2
## 2 Oficial vs igual ran… 0.906 0.892 0.918 64.7
## # ℹ 5 more variables: acuerdo_IC95_inf <dbl>, acuerdo_IC95_sup <dbl>,
## # kappa_ponderado <dbl>, kappa_IC95_inf <dbl>, kappa_IC95_sup <dbl>