1 Presentación

Este documento presenta el flujo reproducible utilizado para el análisis de consistencia interna y estructura interna complementaria del CAPL-2 versión Colombia en escolares de 8 a 12 años. El análisis incluye la caracterización de la base consolidada de seis regiones, la verificación de completitud por dominio, la descripción de puntajes, la estimación de consistencia interna, las correlaciones entre dominios, el análisis factorial confirmatorio y un modelo SEM parcial ajustado por edad y sexo.

No se incluyen comparaciones por sexo, edad o región, dado que corresponden a otro objetivo analítico.

2 Paquetes

paquetes <- c(
  "readxl", "dplyr", "tidyr", "purrr", "stringr", "janitor",
  "psych", "lavaan", "semTools", "knitr", "kableExtra",
  "ggplot2", "DiagrammeR", "glue"
)

instalar <- paquetes[!paquetes %in% rownames(installed.packages())]
if(length(instalar) > 0){
  install.packages(instalar)
}

invisible(lapply(paquetes, library, character.only = TRUE))

3 Parámetros de entrada

El archivo debe estar en la misma carpeta del R Markdown. El flujo busca automáticamente alguno de estos nombres:

validacion_CAPL2_calculado_6_regiones.xlsx
validacion_CAPL2_calculado_6_regiones(1).xlsx

La hoja principal debe llamarse resultados_capl.

opciones_archivo <- c(
  "validacion_CAPL2_calculado_6_regiones.xlsx",
  "validacion_CAPL2_calculado_6_regiones(1).xlsx"
)

archivo_datos <- opciones_archivo[file.exists(opciones_archivo)][1]

if(is.na(archivo_datos)){
  archivos_excel <- list.files(pattern = "validacion_CAPL2_calculado_6_regiones.*\\.xlsx$")
  if(length(archivos_excel) > 0){
    archivo_datos <- archivos_excel[1]
  }
}

if(is.na(archivo_datos) || !file.exists(archivo_datos)){
  stop(
    "No se encontró la base Excel. Coloque en esta carpeta el archivo validacion_CAPL2_calculado_6_regiones.xlsx o validacion_CAPL2_calculado_6_regiones(1).xlsx."
  )
}

hoja_datos <- "resultados_capl"
cat("Archivo seleccionado:", archivo_datos, "\n")

## Archivo seleccionado: validacion_CAPL2_calculado_6_regiones.xlsx

cat("Hoja seleccionada:", hoja_datos, "\n")

## Hoja seleccionada: resultados_capl

4 Carga de datos

hojas_disponibles <- readxl::excel_sheets(archivo_datos)
cat("Hojas disponibles:\n")

## Hojas disponibles:

print(hojas_disponibles)

## [1] "resultados_capl"          "status_capl"             
## [3] "estatus_por_dominio"      "status_por_region"       
## [5] "disponibilidad_dominios"  "resumen_podometro_region"
## [7] "dias_validos_region"      "na_scores_capl"

if(!hoja_datos %in% hojas_disponibles){
  stop(paste0("No existe la hoja '", hoja_datos, "' en el archivo seleccionado."))
}

datos <- readxl::read_excel(
  path = archivo_datos,
  sheet = hoja_datos
) %>%
  janitor::clean_names()

cat("Dimensiones de la base cargada:\n")

## Dimensiones de la base cargada:

print(dim(datos))

## [1] 843 106

cat("Primeras variables:\n")

## Primeras variables:

print(names(datos)[1:min(30, length(names(datos)))])

##  [1] "id"                 "age"                "gender"            
##  [4] "grade"              "birth_month"        "pacer_lap_distance"
##  [7] "pacer_laps"         "plank_time"         "camsa_skill_score1"
## [10] "camsa_time1"        "camsa_skill_score2" "camsa_time2"       
## [13] "steps1"             "time_on1"           "time_off1"         
## [16] "non_wear_time1"     "steps2"             "time_on2"          
## [19] "time_off2"          "non_wear_time2"     "steps3"            
## [22] "time_on3"           "time_off3"          "non_wear_time3"    
## [25] "steps4"             "time_on4"           "time_off4"         
## [28] "non_wear_time4"     "steps5"             "time_on5"

5 Preparación de variables

# Variable de sexo para modelos ajustados.
# Se codifica niña = 1, niño = 0.
datos <- datos %>%
  mutate(
    sexo_nina = case_when(
      stringr::str_to_lower(as.character(gender)) %in% c("girl", "female", "f", "niña", "nina", "mujer") ~ 1,
      stringr::str_to_lower(as.character(gender)) %in% c("boy", "male", "m", "niño", "nino", "hombre") ~ 0,
      TRUE ~ NA_real_
    ),
    gender = as.character(gender),
    region = as.character(region),
    grade = as.character(grade)
  )

# Variables centrales del análisis
vars_dominios <- c("pc_score", "db_score", "mc_score", "ku_score", "capl_score")
vars_indicadores <- c(
  "pacer_score", "plank_score", "camsa_score",
  "step_score", "self_report_pa_score",
  "predilection_score", "adequacy_score", "intrinsic_motivation_score", "pa_competence_score",
  "pa_guideline_score", "crf_means_score", "ms_means_score", "sports_skill_score", "fill_in_the_blanks_score"
)
vars_requeridas <- c("age", "gender", "sexo_nina", "grade", "region", vars_dominios, vars_indicadores)

faltantes_vars <- setdiff(vars_requeridas, names(datos))
if(length(faltantes_vars) > 0){
  stop(paste("Faltan variables requeridas en la base:", paste(faltantes_vars, collapse = ", ")))
}

6 Funciones auxiliares

media_ic95 <- function(x){
  x <- x[!is.na(x)]
  n <- length(x)
  if(n < 2){
    return(c(n = n, media = mean(x), de = NA, li = NA, ls = NA))
  }
  m <- mean(x)
  de <- sd(x)
  ee <- de / sqrt(n)
  li <- m - qt(0.975, df = n - 1) * ee
  ls <- m + qt(0.975, df = n - 1) * ee
  c(n = n, media = m, de = de, li = li, ls = ls)
}

ic_prop <- function(x, total){
  if(total == 0){
    return(c(li = NA_real_, ls = NA_real_))
  }
  pr <- prop.test(x, total)$conf.int
  c(li = pr[1] * 100, ls = pr[2] * 100)
}

fmt_p <- function(p){
  case_when(
    is.na(p) ~ NA_character_,
    p < .001 ~ "< .001",
    TRUE ~ sprintf("%.3f", p)
  )
}

interpretar_cor <- function(rho){
  abs_rho <- abs(rho)
  case_when(
    is.na(abs_rho) ~ NA_character_,
    abs_rho < 0.30 ~ "Baja",
    abs_rho < 0.60 ~ "Moderada",
    abs_rho < 0.80 ~ "Alta",
    TRUE ~ "Muy alta"
  )
}

alpha_omega_seguro <- function(data, variables, nombre){
  base <- data %>% dplyr::select(all_of(variables)) %>% tidyr::drop_na()
  n <- nrow(base)
  k <- length(variables)
  
  if(n < 5 || k < 2){
    return(tibble::tibble(
      dimension = nombre, indicadores = k, n = n,
      alpha = NA_real_, alpha_estandarizado = NA_real_, omega_total = NA_real_,
      r_inter_item = NA_real_, r_item_total_min = NA_real_, r_item_total_max = NA_real_
    ))
  }
  
  a <- tryCatch(psych::alpha(base, warnings = FALSE, check.keys = FALSE), error = function(e) NULL)
  om <- tryCatch(psych::omega(base, plot = FALSE, warnings = FALSE), error = function(e) NULL)
  
  alpha_raw <- if(!is.null(a)) unname(a$total$raw_alpha) else NA_real_
  alpha_std <- if(!is.null(a)) unname(a$total$std.alpha) else NA_real_
  r_avg <- if(!is.null(a)) unname(a$total$average_r) else NA_real_
  item_total <- if(!is.null(a) && "r.drop" %in% names(a$item.stats)) a$item.stats$r.drop else rep(NA_real_, k)
  omega_total <- if(!is.null(om) && !is.null(om$omega.tot)) unname(om$omega.tot) else NA_real_
  
  tibble::tibble(
    dimension = nombre,
    indicadores = k,
    n = n,
    alpha = alpha_raw,
    alpha_estandarizado = alpha_std,
    omega_total = omega_total,
    r_inter_item = r_avg,
    r_item_total_min = suppressWarnings(min(item_total, na.rm = TRUE)),
    r_item_total_max = suppressWarnings(max(item_total, na.rm = TRUE))
  )
}

fit_lavaan_seguro <- function(modelo, data, nombre){
  ajuste <- tryCatch(
    lavaan::cfa(modelo, data = data, estimator = "MLR", missing = "listwise", std.lv = TRUE),
    error = function(e) e
  )
  ajuste
}

extraer_ajuste <- function(fit, modelo){
  if(inherits(fit, "error")){
    return(tibble::tibble(
      modelo = modelo, n = NA_integer_, chisq = NA_real_, df = NA_real_, p = NA_real_,
      cfi = NA_real_, tli = NA_real_, rmsea = NA_real_, rmsea_li = NA_real_, rmsea_ls = NA_real_, srmr = NA_real_,
      convergencia = FALSE, observacion = fit$message
    ))
  }
  fm <- tryCatch(lavaan::fitMeasures(fit, c(
    "chisq.scaled", "df.scaled", "pvalue.scaled", "cfi.scaled", "tli.scaled",
    "rmsea.scaled", "rmsea.ci.lower.scaled", "rmsea.ci.upper.scaled", "srmr"
  )), error = function(e) rep(NA_real_, 9))
  
  tibble::tibble(
    modelo = modelo,
    n = tryCatch(lavaan::lavInspect(fit, "nobs"), error = function(e) NA_integer_),
    chisq = unname(fm["chisq.scaled"]),
    df = 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"]),
    convergencia = tryCatch(lavaan::inspect(fit, "converged"), error = function(e) NA),
    observacion = NA_character_
  )
}

7 Caracterización de la muestra

n_total <- nrow(datos)
cat("n total =", n_total, "\n")

## n total = 843

tabla_region <- datos %>%
  count(region, name = "n") %>%
  mutate(
    porcentaje = 100 * n / sum(n),
    ic = purrr::map(n, ~ic_prop(.x, sum(n))),
    ic95 = sprintf("%.1f–%.1f", purrr::map_dbl(ic, 1), purrr::map_dbl(ic, 2))
  ) %>%
  select(region, n, porcentaje, ic95)

tabla_sexo <- datos %>%
  count(gender, name = "n") %>%
  mutate(
    porcentaje = 100 * n / sum(n),
    ic = purrr::map(n, ~ic_prop(.x, sum(n))),
    ic95 = sprintf("%.1f–%.1f", purrr::map_dbl(ic, 1), purrr::map_dbl(ic, 2))
  ) %>%
  select(gender, n, porcentaje, ic95)

tabla_edad <- datos %>%
  count(age, name = "n") %>%
  mutate(
    porcentaje = 100 * n / sum(n),
    ic = purrr::map(n, ~ic_prop(.x, sum(n))),
    ic95 = sprintf("%.1f–%.1f", purrr::map_dbl(ic, 1), purrr::map_dbl(ic, 2))
  ) %>%
  select(age, n, porcentaje, ic95)

resumen_edad <- media_ic95(datos$age)

knitr::kable(tabla_region, digits = 1, caption = "Distribución de la muestra por región") %>%
  kableExtra::kable_styling(full_width = FALSE)

Distribución de la muestra por región
region	n	porcentaje	ic95
Caribe	140	16.6	14.2–19.3
Centro sur-Amazonía	141	16.7	14.3–19.5
Centro-Oriente	140	16.6	14.2–19.3
Eje cafetero-Antioquia	141	16.7	14.3–19.5
Llanos-Orinoquía	141	16.7	14.3–19.5
Pacífico	140	16.6	14.2–19.3

knitr::kable(tabla_sexo, digits = 1, caption = "Distribución de la muestra por sexo") %>%
  kableExtra::kable_styling(full_width = FALSE)

Distribución de la muestra por sexo
gender	n	porcentaje	ic95
boy	418	49.6	46.2–53.0
girl	425	50.4	47.0–53.8

knitr::kable(tabla_edad, digits = 1, caption = "Distribución de la muestra por edad") %>%
  kableExtra::kable_styling(full_width = FALSE)

Distribución de la muestra por edad
age	n	porcentaje	ic95
8	168	19.9	17.3–22.8
9	170	20.2	17.5–23.1
10	171	20.3	17.7–23.2
11	170	20.2	17.5–23.1
12	164	19.5	16.9–22.3

cat("Edad media =", round(resumen_edad["media"], 2),
    "; DE =", round(resumen_edad["de"], 2),
    "; IC95% =", round(resumen_edad["li"], 2), "–", round(resumen_edad["ls"], 2), "\n")

## Edad media = 9.99 ; DE = 1.41 ; IC95% = 9.9 – 10.09

8 Disponibilidad de datos por dominio

tabla_disponibilidad <- tibble::tibble(
  dominio = c("Competencia física", "Comportamiento diario", "Motivación y confianza", "Conocimiento y comprensión", "CAPL total"),
  variable = c("pc_score", "db_score", "mc_score", "ku_score", "capl_score")
) %>%
  mutate(
    n_total = nrow(datos),
    n_valido = purrr::map_int(variable, ~sum(!is.na(datos[[.x]]))),
    porcentaje_valido = 100 * n_valido / n_total
  ) %>%
  select(dominio, n_total, n_valido, porcentaje_valido)

knitr::kable(tabla_disponibilidad, digits = 1, caption = "Disponibilidad de datos por dominio del CAPL-2") %>%
  kableExtra::kable_styling(full_width = FALSE)

Disponibilidad de datos por dominio del CAPL-2
dominio	n_total	n_valido	porcentaje_valido
Competencia física	843	843	100.0
Comportamiento diario	843	819	97.2
Motivación y confianza	843	840	99.6
Conocimiento y comprensión	843	843	100.0
CAPL total	843	843	100.0

9 Puntajes por dominio y puntaje total

maximos <- tibble::tibble(
  dominio = c("Competencia física", "Comportamiento diario", "Motivación y confianza", "Conocimiento y comprensión", "CAPL total"),
  variable = c("pc_score", "db_score", "mc_score", "ku_score", "capl_score"),
  maximo_teorico = c(30, 30, 30, 10, 100)
)

tabla_puntajes <- maximos %>%
  mutate(
    n = purrr::map_int(variable, ~sum(!is.na(datos[[.x]]))),
    media = purrr::map_dbl(variable, ~mean(datos[[.x]], na.rm = TRUE)),
    de = purrr::map_dbl(variable, ~sd(datos[[.x]], na.rm = TRUE)),
    mediana = purrr::map_dbl(variable, ~median(datos[[.x]], na.rm = TRUE)),
    q1 = purrr::map_dbl(variable, ~quantile(datos[[.x]], 0.25, na.rm = TRUE)),
    q3 = purrr::map_dbl(variable, ~quantile(datos[[.x]], 0.75, na.rm = TRUE)),
    minimo = purrr::map_dbl(variable, ~min(datos[[.x]], na.rm = TRUE)),
    maximo = purrr::map_dbl(variable, ~max(datos[[.x]], na.rm = TRUE)),
    porcentaje_maximo = 100 * media / maximo_teorico,
    ic = purrr::map(variable, ~media_ic95(datos[[.x]])),
    ic95 = sprintf("%.2f–%.2f", purrr::map_dbl(ic, "li"), purrr::map_dbl(ic, "ls")),
    media_de = sprintf("%.2f (%.2f)", media, de),
    mediana_riq = sprintf("%.2f [%.2f, %.2f]", mediana, q1, q3),
    rango = sprintf("%.2f–%.2f", minimo, maximo)
  ) %>%
  select(dominio, maximo_teorico, n, media_de, ic95, mediana_riq, rango, porcentaje_maximo)

knitr::kable(tabla_puntajes, digits = 2, caption = "Puntajes del CAPL-2 por dominio y puntaje total") %>%
  kableExtra::kable_styling(full_width = FALSE)

Puntajes del CAPL-2 por dominio y puntaje total
dominio	maximo_teorico	n	media_de	ic95	mediana_riq	rango	porcentaje_maximo
Competencia física	30	843	12.08 (5.68)	11.69–12.46	12.00 [7.50, 16.50]	0.00–30.00	40.25
Comportamiento diario	30	819	14.68 (6.64)	14.23–15.14	14.00 [9.00, 20.00]	2.00–30.00	48.95
Motivación y confianza	30	840	23.20 (4.16)	22.92–23.48	23.40 [20.08, 26.80]	9.60–30.00	77.34
Conocimiento y comprensión	10	843	5.40 (2.55)	5.23–5.57	5.00 [3.00, 7.00]	0.00–10.00	53.98
CAPL total	100	843	55.37 (11.80)	54.57–56.17	55.40 [47.15, 63.20]	23.57–91.10	55.37

10 Categorías interpretativas

vars_cat <- c(
  pc_interpretation = "Competencia física",
  db_interpretation = "Comportamiento diario",
  mc_interpretation = "Motivación y confianza",
  ku_interpretation = "Conocimiento y comprensión",
  capl_interpretation = "CAPL total"
)

niveles_cat <- c("beginning", "progressing", "achieving", "excelling")

tabla_categorias <- purrr::imap_dfr(vars_cat, function(nombre, var){
  x <- datos[[var]]
  den <- sum(!is.na(x))
  tibble::tibble(
    dominio = nombre,
    categoria = factor(stringr::str_to_lower(as.character(x)), levels = niveles_cat)
  ) %>%
    count(dominio, categoria, .drop = FALSE) %>%
    mutate(
      porcentaje = ifelse(den > 0, 100 * n / den, NA_real_),
      valor = sprintf("%d (%.1f)", n, porcentaje)
    )
}) %>%
  select(dominio, categoria, valor) %>%
  tidyr::pivot_wider(names_from = categoria, values_from = valor)

knitr::kable(tabla_categorias, caption = "Categorías interpretativas del CAPL-2 por dominio y puntaje total") %>%
  kableExtra::kable_styling(full_width = FALSE)

Categorías interpretativas del CAPL-2 por dominio y puntaje total
dominio	beginning	progressing	achieving	excelling	NA
Competencia física	559 (66.3)	197 (66.3)	57 (66.3)	30 (66.3)	NA
Comportamiento diario	246 (30.0)	431 (30.0)	97 (30.0)	45 (30.0)	24 (30.0)
Motivación y confianza	47 (5.6)	343 (5.6)	162 (5.6)	288 (5.6)	3 (5.6)
Conocimiento y comprensión	387 (45.9)	208 (45.9)	88 (45.9)	160 (45.9)	NA
CAPL total	276 (32.7)	443 (32.7)	79 (32.7)	45 (32.7)	NA

11 Consistencia interna

lista_escalas <- list(
  "Competencia física" = c("pacer_score", "plank_score", "camsa_score"),
  "Comportamiento diario" = c("step_score", "self_report_pa_score"),
  "Motivación y confianza" = c("predilection_score", "adequacy_score", "intrinsic_motivation_score", "pa_competence_score"),
  "Conocimiento y comprensión" = c("pa_guideline_score", "crf_means_score", "ms_means_score", "sports_skill_score", "fill_in_the_blanks_score"),
  "CAPL-2 total" = c("pc_score", "db_score", "mc_score", "ku_score")
)

tabla_consistencia <- purrr::imap_dfr(lista_escalas, ~alpha_omega_seguro(datos, .x, .y)) %>%
  mutate(across(where(is.numeric), ~round(.x, 3)))

knitr::kable(tabla_consistencia, caption = "Consistencia interna y coherencia entre indicadores del CAPL-2") %>%
  kableExtra::kable_styling(full_width = FALSE)

Consistencia interna y coherencia entre indicadores del CAPL-2
dimension	indicadores	n	alpha	alpha_estandarizado	omega_total	r_inter_item	r_item_total_min	r_item_total_max
Competencia física	3	829	0.426	0.444	0.488	0.210	0.204	0.347
Comportamiento diario	2	819	0.093	0.189	NA	0.104	0.104	0.104
Motivación y confianza	4	836	0.576	0.598	0.055	0.271	0.207	0.515
Conocimiento y comprensión	5	839	0.425	0.543	0.576	0.192	0.096	0.411
CAPL-2 total	4	816	0.362	0.358	0.528	0.122	0.108	0.312

12 Análisis complementario: 12 ítems crudos de motivación y confianza

items_mc_12 <- c(
  "csappa1", "csappa2", "csappa3", "csappa4", "csappa5", "csappa6",
  "why_active1", "why_active2", "why_active3",
  "feelings_about_pa1", "feelings_about_pa2", "feelings_about_pa3"
)

items_mc_12 <- intersect(items_mc_12, names(datos))
base_mc_12 <- datos %>% select(all_of(items_mc_12)) %>% drop_na()

alpha_mc_original <- tryCatch(psych::alpha(base_mc_12, warnings = FALSE, check.keys = FALSE), error = function(e) NULL)
alpha_mc_recodificado <- tryCatch(psych::alpha(base_mc_12, warnings = FALSE, check.keys = TRUE), error = function(e) NULL)

tabla_mc_12 <- tibble::tibble(
  analisis = c("Ítems en dirección original", "Ítems con recodificación automática"),
  n = nrow(base_mc_12),
  items = length(items_mc_12),
  alpha = c(
    if(!is.null(alpha_mc_original)) alpha_mc_original$total$raw_alpha else NA_real_,
    if(!is.null(alpha_mc_recodificado)) alpha_mc_recodificado$total$raw_alpha else NA_real_
  ),
  alpha_estandarizado = c(
    if(!is.null(alpha_mc_original)) alpha_mc_original$total$std.alpha else NA_real_,
    if(!is.null(alpha_mc_recodificado)) alpha_mc_recodificado$total$std.alpha else NA_real_
  ),
  r_inter_item = c(
    if(!is.null(alpha_mc_original)) alpha_mc_original$total$average_r else NA_real_,
    if(!is.null(alpha_mc_recodificado)) alpha_mc_recodificado$total$average_r else NA_real_
  )
) %>%
  mutate(across(where(is.numeric), ~round(.x, 3)))

knitr::kable(tabla_mc_12, caption = "Consistencia interna complementaria de los 12 ítems crudos de motivación y confianza") %>%
  kableExtra::kable_styling(full_width = FALSE)

Consistencia interna complementaria de los 12 ítems crudos de motivación y confianza
analisis	n	items	alpha	alpha_estandarizado	r_inter_item
Ítems en dirección original	842	12	0.582	0.565	0.098
Ítems con recodificación automática	842	12	0.734	0.712	0.171

13 Correlaciones entre dominios y puntaje total

pares_cor <- tibble::tribble(
  ~var1, ~var2, ~relacion,
  "db_score", "pc_score", "Comportamiento diario – Competencia física",
  "mc_score", "pc_score", "Motivación y confianza – Competencia física",
  "ku_score", "pc_score", "Conocimiento y comprensión – Competencia física",
  "mc_score", "db_score", "Motivación y confianza – Comportamiento diario",
  "ku_score", "db_score", "Conocimiento y comprensión – Comportamiento diario",
  "ku_score", "mc_score", "Conocimiento y comprensión – Motivación y confianza",
  "capl_score", "pc_score", "CAPL total – Competencia física",
  "capl_score", "db_score", "CAPL total – Comportamiento diario",
  "capl_score", "mc_score", "CAPL total – Motivación y confianza",
  "capl_score", "ku_score", "CAPL total – Conocimiento y comprensión"
)

tabla_cor <- pares_cor %>%
  mutate(
    res = purrr::map2(var1, var2, function(x, y){
      base <- datos %>% select(all_of(c(x, y))) %>% drop_na()
      ct <- suppressWarnings(cor.test(base[[x]], base[[y]], method = "spearman", exact = FALSE))
      tibble::tibble(n = nrow(base), rho = unname(ct$estimate), p = ct$p.value)
    })
  ) %>%
  tidyr::unnest(res) %>%
  mutate(
    interpretacion = interpretar_cor(rho),
    p = fmt_p(p),
    rho = round(rho, 3)
  ) %>%
  select(relacion, n, rho, p, interpretacion)

knitr::kable(tabla_cor, caption = "Correlaciones entre dominios y puntaje total del CAPL-2") %>%
  kableExtra::kable_styling(full_width = FALSE)

Correlaciones entre dominios y puntaje total del CAPL-2
relacion	n	rho	p	interpretacion
Comportamiento diario – Competencia física	819	0.276	< .001	Baja
Motivación y confianza – Competencia física	840	0.052	0.133	Baja
Conocimiento y comprensión – Competencia física	843	-0.037	0.278	Baja
Motivación y confianza – Comportamiento diario	816	0.061	0.081	Baja
Conocimiento y comprensión – Comportamiento diario	819	0.228	< .001	Baja
Conocimiento y comprensión – Motivación y confianza	840	0.152	< .001	Baja
CAPL total – Competencia física	843	0.639	< .001	Alta
CAPL total – Comportamiento diario	819	0.769	< .001	Alta
CAPL total – Motivación y confianza	840	0.435	< .001	Moderada
CAPL total – Conocimiento y comprensión	843	0.373	< .001	Moderada

mat_cor <- datos %>%
  select(pc_score, db_score, mc_score, ku_score, capl_score) %>%
  cor(use = "pairwise.complete.obs", method = "spearman")

mat_cor_df <- as.data.frame(as.table(mat_cor)) %>%
  mutate(
    Var1 = factor(Var1, levels = colnames(mat_cor)),
    Var2 = factor(Var2, levels = colnames(mat_cor))
  )

ggplot(mat_cor_df, aes(x = Var1, y = Var2, fill = Freq)) +
  geom_tile(color = "white") +
  geom_text(aes(label = sprintf("%.2f", Freq)), size = 4) +
  scale_fill_gradient2(limits = c(-1, 1)) +
  labs(x = NULL, y = NULL, fill = "rho") +
  theme_minimal(base_size = 13) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Matriz de correlaciones entre dominios y puntaje total del CAPL-2

14 Análisis factorial confirmatorio

modelo_cfa_4d <- '
  competencia_fisica =~ pacer_score + plank_score + camsa_score
  comportamiento_diario =~ step_score + self_report_pa_score
  motivacion_confianza =~ predilection_score + adequacy_score + intrinsic_motivation_score + pa_competence_score
  conocimiento_comprension =~ pa_guideline_score + crf_means_score + ms_means_score + sports_skill_score + fill_in_the_blanks_score
'

modelo_cfa_pc <- '
  competencia_fisica =~ pacer_score + plank_score + camsa_score
'

modelo_cfa_db <- '
  comportamiento_diario =~ step_score + self_report_pa_score
'

modelo_factor_general <- '
  alfabetizacion_fisica =~ pc_score + db_score + mc_score + ku_score
'

modelo_cuestionario_refinado <- '
  motivacion_confianza =~ predilection_score + adequacy_score + intrinsic_motivation_score + pa_competence_score
  conocimiento_comprension =~ pa_guideline_score + crf_means_score + ms_means_score + sports_skill_score + fill_in_the_blanks_score
'

fit_cfa_4d <- fit_lavaan_seguro(modelo_cfa_4d, datos, "CFA cuatro dominios")
fit_cfa_pc <- fit_lavaan_seguro(modelo_cfa_pc, datos, "CFA competencia física")
fit_cfa_db <- fit_lavaan_seguro(modelo_cfa_db, datos, "CFA comportamiento diario")
fit_factor_general <- fit_lavaan_seguro(modelo_factor_general, datos, "Factor general")
fit_cuestionario_refinado <- fit_lavaan_seguro(modelo_cuestionario_refinado, datos, "Modelo refinado de cuestionario")

tabla_cfa <- bind_rows(
  extraer_ajuste(fit_cfa_4d, "CFA cuatro dominios con 14 indicadores"),
  extraer_ajuste(fit_cfa_pc, "CFA competencia física"),
  extraer_ajuste(fit_cfa_db, "CFA comportamiento diario"),
  extraer_ajuste(fit_factor_general, "Factor general con cuatro dominios"),
  extraer_ajuste(fit_cuestionario_refinado, "Modelo refinado de componentes de cuestionario")
) %>%
  mutate(
    across(c(chisq, df, cfi, tli, rmsea, rmsea_li, rmsea_ls, srmr), ~round(.x, 3)),
    p = fmt_p(p)
  )

knitr::kable(tabla_cfa, caption = "Modelos factoriales evaluados") %>%
  kableExtra::kable_styling(full_width = FALSE)

Modelos factoriales evaluados
modelo	n	chisq	df	p	cfi	tli	rmsea	rmsea_li	rmsea_ls	srmr	convergencia	observacion
CFA cuatro dominios con 14 indicadores	795	909.570	71	< .001	0.437	0.279	0.122	0.113	0.131	0.095	TRUE	NA
CFA competencia física	829	0.000	0	NA	1.000	1.000	NA	NA	NA	0.000	TRUE	NA
CFA comportamiento diario	819	NA	-1	NA	NA	NA	NA	NA	NA	0.000	TRUE	NA
Factor general con cuatro dominios	816	NA	NA	NA	NA	NA	NA	NA	NA	NA	FALSE	NA
Modelo refinado de componentes de cuestionario	832	90.886	26	< .001	0.923	0.893	0.055	0.043	0.067	0.052	TRUE	NA

14.1 Cargas factoriales del modelo refinado de cuestionario

if(!inherits(fit_cuestionario_refinado, "error")){
  cargas_refinado <- lavaan::standardizedSolution(fit_cuestionario_refinado) %>%
    filter(op == "=~") %>%
    select(lhs, rhs, est.std, se, z, pvalue) %>%
    mutate(
      est.std = round(est.std, 3),
      se = round(se, 3),
      z = round(z, 3),
      pvalue = fmt_p(pvalue)
    )
  
  knitr::kable(cargas_refinado, caption = "Cargas factoriales estandarizadas del modelo refinado de cuestionario") %>%
    kableExtra::kable_styling(full_width = FALSE)
}

Cargas factoriales estandarizadas del modelo refinado de cuestionario
lhs	rhs	est.std	se	z	pvalue
motivacion_confianza	predilection_score	0.268	0.040	6.764	< .001
motivacion_confianza	adequacy_score	0.355	0.038	9.239	< .001
motivacion_confianza	intrinsic_motivation_score	0.734	0.037	19.770	< .001
motivacion_confianza	pa_competence_score	0.802	0.037	21.795	< .001
conocimiento_comprension	pa_guideline_score	0.129	0.045	2.851	0.004
conocimiento_comprension	crf_means_score	0.475	0.042	11.335	< .001
conocimiento_comprension	ms_means_score	0.587	0.040	14.776	< .001
conocimiento_comprension	sports_skill_score	0.469	0.042	11.197	< .001
conocimiento_comprension	fill_in_the_blanks_score	0.574	0.040	14.508	< .001

15 Modelo de ecuaciones estructurales parcial ajustado por edad y sexo

modelo_sem_latente <- '
  # Medición
  motivacion_confianza =~ predilection_score + adequacy_score + intrinsic_motivation_score + pa_competence_score
  conocimiento_comprension =~ pa_guideline_score + crf_means_score + ms_means_score + sports_skill_score + fill_in_the_blanks_score

  # Rutas estructurales principales y covariables
  motivacion_confianza ~ a1*conocimiento_comprension + age + sexo_nina
  db_score ~ b1*motivacion_confianza + a2*conocimiento_comprension + age + sexo_nina
  pc_score ~ c1*db_score + c2*motivacion_confianza + c3*conocimiento_comprension + age + sexo_nina

  # Efectos indirectos
  ind_ku_db_pc := a2*c1
  ind_ku_mc_pc := a1*c2
  ind_ku_mc_db_pc := a1*b1*c1
'

fit_sem_latente <- tryCatch(
  lavaan::sem(
    model = modelo_sem_latente,
    data = datos,
    estimator = "MLR",
    missing = "listwise",
    std.lv = TRUE
  ),
  error = function(e) e
)

tabla_sem_ajuste <- extraer_ajuste(fit_sem_latente, "SEM parcial con factores latentes de cuestionario") %>%
  mutate(
    across(c(chisq, df, cfi, tli, rmsea, rmsea_li, rmsea_ls, srmr), ~round(.x, 3)),
    p = fmt_p(p)
  )

knitr::kable(tabla_sem_ajuste, caption = "Ajuste global del modelo SEM parcial") %>%
  kableExtra::kable_styling(full_width = FALSE)

Ajuste global del modelo SEM parcial
modelo	n	chisq	df	p	cfi	tli	rmsea	rmsea_li	rmsea_ls	srmr	convergencia	observacion
SEM parcial con factores latentes de cuestionario	808	201.91	56	< .001	0.872	0.824	0.057	0.048	0.065	0.053	TRUE	NA

15.1 Coeficientes del SEM

if(!inherits(fit_sem_latente, "error")){
  coef_sem <- lavaan::parameterEstimates(fit_sem_latente, standardized = TRUE) %>%
    as_tibble() %>%
    filter(op %in% c("=~", "~", ":=")) %>%
    select(lhs, op, rhs, est, se, z, pvalue, std.all) %>%
    mutate(
      across(c(est, se, z, std.all), ~round(.x, 3)),
      pvalue = fmt_p(pvalue)
    )
  
  knitr::kable(coef_sem, caption = "Coeficientes del modelo SEM parcial") %>%
    kableExtra::kable_styling(full_width = FALSE)
}

Coeficientes del modelo SEM parcial
lhs	op	rhs	est	se	z	pvalue	std.all
motivacion_confianza	=~	predilection_score	0.418	0.070	5.987	< .001	0.248
motivacion_confianza	=~	adequacy_score	0.587	0.065	8.973	< .001	0.367
motivacion_confianza	=~	intrinsic_motivation_score	1.004	0.069	14.649	< .001	0.718
motivacion_confianza	=~	pa_competence_score	1.074	0.062	17.196	< .001	0.802
conocimiento_comprension	=~	pa_guideline_score	0.053	0.021	2.516	0.012	0.114
conocimiento_comprension	=~	crf_means_score	0.223	0.020	10.937	< .001	0.459
conocimiento_comprension	=~	ms_means_score	0.293	0.019	15.182	< .001	0.589
conocimiento_comprension	=~	sports_skill_score	0.232	0.021	11.045	< .001	0.467
conocimiento_comprension	=~	fill_in_the_blanks_score	1.077	0.078	13.828	< .001	0.594
motivacion_confianza	~	conocimiento_comprension	0.274	0.063	4.340	< .001	0.262
motivacion_confianza	~	age	-0.048	0.031	-1.560	0.119	-0.065
motivacion_confianza	~	sexo_nina	-0.225	0.084	-2.690	0.007	-0.108
db_score	~	motivacion_confianza	-0.253	0.276	-0.916	0.359	-0.040
db_score	~	conocimiento_comprension	1.809	0.295	6.131	< .001	0.273
db_score	~	age	0.467	0.156	2.988	0.003	0.099
db_score	~	sexo_nina	-3.477	0.436	-7.970	< .001	-0.263
pc_score	~	db_score	0.211	0.033	6.449	< .001	0.246
pc_score	~	motivacion_confianza	0.636	0.216	2.943	0.003	0.117
pc_score	~	conocimiento_comprension	-0.670	0.277	-2.419	0.016	-0.118
pc_score	~	age	0.714	0.132	5.399	< .001	0.177
pc_score	~	sexo_nina	-2.238	0.384	-5.827	< .001	-0.197
ind_ku_db_pc	:=	a2*c1	0.381	0.087	4.360	< .001	0.067
ind_ku_mc_pc	:=	a1*c2	0.174	0.073	2.392	0.017	0.031
ind_ku_mc_db_pc	:=	a1b1c1	-0.015	0.017	-0.858	0.391	-0.003

16 Figura SEM en dos paneles

if(!inherits(fit_sem_latente, "error")){
  pe <- lavaan::parameterEstimates(fit_sem_latente, standardized = TRUE) %>% as_tibble()
  
  obtener_lambda <- function(latente, indicador, digits = 2){
    x <- pe %>% filter(lhs == latente, op == "=~", rhs == indicador) %>% slice(1)
    if(nrow(x) == 0) return("")
    formatC(x$std.all, digits = digits, format = "f")
  }
  
  obtener_beta <- function(dependiente, predictor, digits = 2){
    x <- pe %>% filter(lhs == dependiente, op == "~", rhs == predictor) %>% slice(1)
    if(nrow(x) == 0) return("")
    paste0("β = ", formatC(x$std.all, digits = digits, format = "f"))
  }
  
  lam_ku1 <- obtener_lambda("conocimiento_comprension", "pa_guideline_score")
  lam_ku2 <- obtener_lambda("conocimiento_comprension", "crf_means_score")
  lam_ku3 <- obtener_lambda("conocimiento_comprension", "ms_means_score")
  lam_ku4 <- obtener_lambda("conocimiento_comprension", "sports_skill_score")
  lam_ku5 <- obtener_lambda("conocimiento_comprension", "fill_in_the_blanks_score")
  lam_mc1 <- obtener_lambda("motivacion_confianza", "predilection_score")
  lam_mc2 <- obtener_lambda("motivacion_confianza", "adequacy_score")
  lam_mc3 <- obtener_lambda("motivacion_confianza", "intrinsic_motivation_score")
  lam_mc4 <- obtener_lambda("motivacion_confianza", "pa_competence_score")
  
  b_ku_mc <- obtener_beta("motivacion_confianza", "conocimiento_comprension")
  b_ku_db <- obtener_beta("db_score", "conocimiento_comprension")
  b_mc_db <- obtener_beta("db_score", "motivacion_confianza")
  b_ku_pc <- obtener_beta("pc_score", "conocimiento_comprension")
  b_mc_pc <- obtener_beta("pc_score", "motivacion_confianza")
  b_db_pc <- obtener_beta("pc_score", "db_score")
  b_age_pc <- obtener_beta("pc_score", "age")
  b_sex_db <- obtener_beta("db_score", "sexo_nina")
  b_sex_pc <- obtener_beta("pc_score", "sexo_nina")
  
  indices_modelo <- lavaan::fitMeasures(
    fit_sem_latente,
    c("cfi.scaled", "tli.scaled", "rmsea.scaled", "rmsea.ci.lower.scaled", "rmsea.ci.upper.scaled", "srmr")
  )
  n_modelo <- lavaan::lavInspect(fit_sem_latente, "nobs")
  texto_indices <- paste0(
    "n = ", n_modelo,
    " | CFI = ", sprintf("%.3f", indices_modelo["cfi.scaled"]),
    " | TLI = ", sprintf("%.3f", indices_modelo["tli.scaled"]),
    " | RMSEA = ", sprintf("%.3f", indices_modelo["rmsea.scaled"]),
    " | SRMR = ", sprintf("%.3f", indices_modelo["srmr"])
  )
  
  fig_sem_paneles_cov <- DiagrammeR::grViz(glue::glue("
  digraph modelo_sem_paneles_cov {{
  graph [layout = dot, rankdir = TB, bgcolor = white, compound = true,
         nodesep = 0.70, ranksep = 0.95, fontname = Helvetica,
         labelloc = t, label = 'Modelo SEM parcial del CAPL-2', fontsize = 26]
  node [fontname = Helvetica, fontsize = 18, color = black]
  edge [fontname = Helvetica, fontsize = 16, color = black, arrowsize = 0.8]

  subgraph cluster_A {{
    label = 'Panel A. Modelo de medición'; fontsize = 22; fontname = Helvetica;
    color = '#B0B0B0'; style = 'rounded'; margin = 18;

    A_KU [label = 'Conocimiento\\ny comprensión', shape = ellipse, style = filled, fillcolor = '#EAF2FF', width = 2.6, height = 1.2]
    A_MC [label = 'Motivación\\ny confianza', shape = ellipse, style = filled, fillcolor = '#EAF2FF', width = 2.6, height = 1.2]

    A_ku1 [label = 'Recomendación\\ndiaria de AF', shape = box, style = 'rounded,filled', fillcolor = white]
    A_ku2 [label = 'Aptitud\\ncardiorrespiratoria', shape = box, style = 'rounded,filled', fillcolor = white]
    A_ku3 [label = 'Fuerza/resistencia\\nmuscular', shape = box, style = 'rounded,filled', fillcolor = white]
    A_ku4 [label = 'Habilidad\\ndeportiva', shape = box, style = 'rounded,filled', fillcolor = white]
    A_ku5 [label = 'Completar\\nespacios', shape = box, style = 'rounded,filled', fillcolor = white]

    A_mc1 [label = 'Predilección', shape = box, style = 'rounded,filled', fillcolor = white]
    A_mc2 [label = 'Adecuación', shape = box, style = 'rounded,filled', fillcolor = white]
    A_mc3 [label = 'Motivación\\nintrínseca', shape = box, style = 'rounded,filled', fillcolor = white]
    A_mc4 [label = 'Competencia\\npercibida', shape = box, style = 'rounded,filled', fillcolor = white]

    {{ rank = same; A_ku1; A_ku2; A_ku3; A_ku4; A_ku5 }}
    {{ rank = same; A_KU; A_MC }}
    {{ rank = same; A_mc1; A_mc2; A_mc3; A_mc4 }}

    A_KU -> A_ku1 [label = '{lam_ku1}']
    A_KU -> A_ku2 [label = '{lam_ku2}']
    A_KU -> A_ku3 [label = '{lam_ku3}']
    A_KU -> A_ku4 [label = '{lam_ku4}']
    A_KU -> A_ku5 [label = '{lam_ku5}']

    A_MC -> A_mc1 [label = '{lam_mc1}']
    A_MC -> A_mc2 [label = '{lam_mc2}']
    A_MC -> A_mc3 [label = '{lam_mc3}']
    A_MC -> A_mc4 [label = '{lam_mc4}']
  }}

  espacio [label = '', shape = point, width = 0.01, height = 0.01, style = invis]

  subgraph cluster_B {{
    label = 'Panel B. Modelo estructural ajustado por edad y sexo'; fontsize = 22; fontname = Helvetica;
    color = '#B0B0B0'; style = 'rounded'; margin = 22;

    B_KU [label = 'Conocimiento\\ny comprensión', shape = ellipse, style = filled, fillcolor = '#EAF2FF', width = 2.8, height = 1.2]
    B_MC [label = 'Motivación\\ny confianza', shape = ellipse, style = filled, fillcolor = '#EAF2FF', width = 2.8, height = 1.2]
    B_DB [label = 'Comportamiento\\ndiario', shape = box, style = 'rounded,filled', fillcolor = white, width = 2.4, height = 0.9]
    B_PC [label = 'Competencia\\nfísica', shape = box, style = 'rounded,filled', fillcolor = white, width = 2.4, height = 0.9]
    B_AGE [label = 'Edad', shape = box, style = 'rounded,filled', fillcolor = '#F7F7F7', width = 1.7, height = 0.7]
    B_SEX [label = 'Sexo\\nniña = 1', shape = box, style = 'rounded,filled', fillcolor = '#F7F7F7', width = 1.7, height = 0.7]

    {{ rank = same; B_AGE; B_SEX }}
    {{ rank = same; B_KU }}
    {{ rank = same; B_MC; B_DB }}
    {{ rank = same; B_PC }}

    B_KU -> B_MC [label = '{b_ku_mc}', penwidth = 1.5]
    B_KU -> B_DB [label = '{b_ku_db}', penwidth = 1.5]
    B_KU -> B_PC [label = '{b_ku_pc}', penwidth = 1.5]
    B_MC -> B_DB [label = '{b_mc_db}', penwidth = 1.5]
    B_MC -> B_PC [label = '{b_mc_pc}', penwidth = 1.5]
    B_DB -> B_PC [label = '{b_db_pc}', penwidth = 1.5]

    B_AGE -> B_PC [label = '{b_age_pc}', penwidth = 1.2, style = dashed]
    B_SEX -> B_DB [label = '{b_sex_db}', penwidth = 1.2, style = dashed]
    B_SEX -> B_PC [label = '{b_sex_pc}', penwidth = 1.2, style = dashed]
  }}

  A_KU -> espacio [style = invis, weight = 10]
  espacio -> B_KU [style = invis, weight = 10]

  nota [label = 'Nota. Óvalos = factores latentes; rectángulos = variables observadas.\\nLíneas continuas = rutas principales; líneas discontinuas = covariables.\\nCoeficientes estandarizados. {texto_indices}',
        shape = box, style = 'rounded,filled', fillcolor = white, fontsize = 16]
  B_PC -> nota [style = invis, weight = 10]
  }}
  "))
  
  fig_sem_paneles_cov
}

17 Interpretación sintética

Los coeficientes de consistencia interna deben interpretarse considerando la naturaleza heterogénea de los dominios del CAPL-2. En los dominios derivados de cuestionarios, especialmente motivación y confianza, los coeficientes aportan evidencia sobre la relación entre subcomponentes. En competencia física, comportamiento diario y puntaje total, los coeficientes se interpretan de forma exploratoria, dado que estos puntajes integran mediciones distintas.

Las correlaciones entre dominios permiten valorar si los componentes del CAPL-2 se comportan como dimensiones complementarias. El CFA permite examinar si la estructura teórica de cuatro dominios se ajusta a los datos. El SEM parcial permite explorar relaciones estructurales entre componentes sin asumir que el CAPL-2 es una escala unidimensional homogénea.

18 Información de sesión

sessionInfo()

## R version 4.5.1 (2025-06-13 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 26200)
## 
## Matrix products: default
##   LAPACK version 3.12.1
## 
## locale:
## [1] LC_COLLATE=Spanish_Colombia.utf8  LC_CTYPE=Spanish_Colombia.utf8   
## [3] LC_MONETARY=Spanish_Colombia.utf8 LC_NUMERIC=C                     
## [5] LC_TIME=Spanish_Colombia.utf8    
## 
## time zone: America/Bogota
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] glue_1.8.0        DiagrammeR_1.0.11 ggplot2_4.0.1     kableExtra_1.4.0 
##  [5] knitr_1.50        semTools_0.5-8    lavaan_0.6-21     psych_2.5.6      
##  [9] janitor_2.2.1     stringr_1.5.1     purrr_1.1.0       tidyr_1.3.1      
## [13] dplyr_1.2.0       readxl_1.4.5     
## 
## loaded via a namespace (and not attached):
##  [1] gtable_0.3.6         xfun_0.55            bslib_0.9.0         
##  [4] visNetwork_2.1.4     htmlwidgets_1.6.4    lattice_0.22-7      
##  [7] quadprog_1.5-8       vctrs_0.7.1          tools_4.5.1         
## [10] generics_0.1.4       stats4_4.5.1         parallel_4.5.1      
## [13] sandwich_3.1-1       tibble_3.3.0         pkgconfig_2.0.3     
## [16] Matrix_1.7-3         RColorBrewer_1.1-3   S7_0.2.1            
## [19] lifecycle_1.0.5      GPArotation_2025.3-1 compiler_4.5.1      
## [22] farver_2.1.2         textshaping_1.0.1    mnormt_2.1.1        
## [25] codetools_0.2-20     snakecase_0.11.1     htmltools_0.5.8.1   
## [28] sass_0.4.10          yaml_2.3.10          pillar_1.11.0       
## [31] jquerylib_0.1.4      MASS_7.3-65          cachem_1.1.0        
## [34] multcomp_1.4-29      nlme_3.1-168         tidyselect_1.2.1    
## [37] digest_0.6.37        mvtnorm_1.3-3        stringi_1.8.7       
## [40] labeling_0.4.3       splines_4.5.1        fastmap_1.2.0       
## [43] grid_4.5.1           cli_3.6.6            magrittr_2.0.3      
## [46] survival_3.8-3       pbivnorm_0.6.0       TH.data_1.1-5       
## [49] withr_3.0.2          scales_1.4.0         lubridate_1.9.4     
## [52] estimability_1.5.1   timechange_0.3.0     rmarkdown_2.29      
## [55] emmeans_1.11.2       cellranger_1.1.0     zoo_1.8-14          
## [58] coda_0.19-4.1        evaluate_1.0.4       viridisLite_0.4.2   
## [61] rlang_1.2.0          xtable_1.8-4         xml2_1.3.8          
## [64] svglite_2.2.2        rstudioapi_0.17.1    jsonlite_2.0.0      
## [67] R6_2.6.1             systemfonts_1.3.1

Flujo reproducible: consistencia interna y estructura interna del CAPL-2 versión Colombia

Brayan Esneider Patiño Palma

26/06/2026