Propósito del
análisis
Este documento presenta el flujo reproducible utilizado para estimar
la consistencia interna del CAPL-2 versión Colombia y los análisis
complementarios reportados en la tesis: descripción de la muestra,
disponibilidad de datos, puntajes por dominio, categorías
interpretativas, consistencia interna, correlaciones entre dominios,
análisis factorial confirmatorio complementario y comparaciones por
sexo, edad y región.
Paquetes
paquetes <- c(
"readxl", "writexl", "dplyr", "tidyr", "stringr", "janitor",
"psych", "lavaan", "semTools", "ggplot2", "rstatix", "tibble", "knitr", "capl"
)
instalar <- paquetes[!paquetes %in% installed.packages()[, "Package"]]
if(length(instalar) > 0) install.packages(instalar)
invisible(lapply(paquetes, library, character.only = TRUE))
Carga, depuración y
cálculo de puntajes CAPL-2
# ==========================================================
# 1. Rutas de trabajo y archivos regionales
# ==========================================================
ruta_proyecto <- "C:/Users/Personal/Documents/análisis doctorado/Consistencia interna"
archivo_pacifico <- file.path(ruta_proyecto, "Región Pacifico.xlsx")
archivo_eje <- file.path(ruta_proyecto, "Región eje cafetero y Antioquia.xlsx")
archivo_amazonia <- file.path(ruta_proyecto, "Región Centro sur - Amazonía .xlsx")
archivo_caribe <- file.path(ruta_proyecto, "Región Caribe.xlsx")
archivos <- c(archivo_pacifico, archivo_eje, archivo_amazonia, archivo_caribe)
if(any(!file.exists(archivos))){
stop(paste("No se encontraron estos archivos:", paste(archivos[!file.exists(archivos)], collapse = ", ")))
}
# ==========================================================
# 2. Carga de bases regionales
# ==========================================================
pac <- readxl::read_excel(archivo_pacifico, sheet = "CAPL2_Plantilla_Final_Corregida")
eje <- readxl::read_excel(archivo_eje, sheet = "CAPL2 Plantilla Manizales")
amz <- readxl::read_excel(archivo_amazonia, sheet = "CAPL2_Plantilla_Final_Corregida")
car <- readxl::read_excel(archivo_caribe, sheet = "Montería")
# ==========================================================
# 3. Estandarización de nombres
# ==========================================================
estandarizar_nombres_capl <- function(df){
df <- df %>% janitor::clean_names()
if("id" %in% names(df)) df <- df %>% dplyr::rename(ID = id)
if("pacer_lap_distance_15_o_20_m" %in% names(df)) df <- df %>% dplyr::rename(pacer_lap_distance = pacer_lap_distance_15_o_20_m)
if("camsa_time_1" %in% names(df)) df <- df %>% dplyr::rename(camsa_time1 = camsa_time_1)
if("camsa_skill_score_2" %in% names(df)) df <- df %>% dplyr::rename(camsa_skill_score2 = camsa_skill_score_2)
if("camsa_time_2" %in% names(df)) df <- df %>% dplyr::rename(camsa_time2 = camsa_time_2)
if("why_activel" %in% names(df)) df <- df %>% dplyr::rename(why_active1 = why_activel)
if("feelings_about_pal" %in% names(df)) df <- df %>% dplyr::rename(feelings_about_pa1 = feelings_about_pal)
df
}
pac <- estandarizar_nombres_capl(pac) %>% dplyr::mutate(region = "Pacífico")
eje <- estandarizar_nombres_capl(eje) %>% dplyr::mutate(region = "Eje cafetero-Antioquia")
amz <- estandarizar_nombres_capl(amz) %>% dplyr::mutate(region = "Centro sur-Amazonía")
car <- estandarizar_nombres_capl(car) %>% dplyr::mutate(region = "Caribe")
# Convertir todo a texto antes de unir para evitar conflictos de tipo entre regiones.
pac <- pac %>% dplyr::mutate(dplyr::across(dplyr::everything(), as.character))
eje <- eje %>% dplyr::mutate(dplyr::across(dplyr::everything(), as.character))
amz <- amz %>% dplyr::mutate(dplyr::across(dplyr::everything(), as.character))
car <- car %>% dplyr::mutate(dplyr::across(dplyr::everything(), as.character))
base_capl_raw <- dplyr::bind_rows(pac, eje, amz, car) %>%
dplyr::mutate(
ID = as.character(ID),
id_estudio = dplyr::case_when(
region == "Pacífico" ~ paste0("PAC_", ID),
region == "Eje cafetero-Antioquia" ~ paste0("EJE_", ID),
region == "Centro sur-Amazonía" ~ paste0("AMZ_", ID),
region == "Caribe" ~ paste0("CAR_", ID),
TRUE ~ paste0("SINREGION_", ID)
)
)
# ==========================================================
# 4. Funciones de limpieza
# ==========================================================
limpiar_na <- function(x){
x <- as.character(x)
x <- stringr::str_trim(x)
x[x %in% c("", " ", "NA", "N/A", "na", "n/a", ".", "-", "--", "NULL", "null", "No aplica", "no aplica", "Sin dato", "sin dato")] <- NA
x
}
limpiar_numero <- function(x){
x <- limpiar_na(x)
x <- stringr::str_replace_all(x, ",", ".")
x <- stringr::str_replace_all(x, "\\s+", "")
suppressWarnings(as.numeric(x))
}
limpiar_pasos <- function(x){
x <- as.character(x)
x <- stringr::str_trim(x)
x[x %in% c("", " ", "NA", "N/A", "na", "n/a", "-", "--", "NULL", "null", "No aplica", "no aplica", "Sin dato", "sin dato", ".")] <- NA
x <- ifelse(!is.na(x) & stringr::str_detect(x, "^\\d{1,2}\\.\\d{3}$"), stringr::str_replace_all(x, "\\.", ""), x)
x <- ifelse(!is.na(x) & stringr::str_detect(x, "^\\d{1,2}\\.\\d{4,}$"), as.character(round(as.numeric(x) * 1000, 0)), x)
x <- ifelse(!is.na(x) & stringr::str_detect(x, "^\\d{1,2},\\d{3}$"), stringr::str_replace_all(x, ",", ""), x)
x <- stringr::str_replace_all(x, ",", "")
x <- stringr::str_replace_all(x, "\\s+", "")
suppressWarnings(as.numeric(x))
}
limpiar_hora_robusta <- function(x){
if(inherits(x, "POSIXct") | inherits(x, "POSIXt")) return(format(x, "%H:%M"))
x_original <- x
x <- as.character(x)
x <- stringr::str_trim(x)
x[x %in% c("", " ", "NA", "N/A", "na", "n/a", ".", "-", "--", "NULL", "null", "No aplica", "no aplica", "Sin dato", "sin dato")] <- NA
hora_extraida <- stringr::str_extract(x, "\\b\\d{1,2}:\\d{2}(:\\d{2})?\\b")
x <- ifelse(!is.na(hora_extraida), hora_extraida, x)
x <- ifelse(!is.na(x) & stringr::str_detect(x, "^\\d{1,2}:\\d{2}:\\d{2}$"), stringr::str_sub(x, 1, 5), x)
x <- ifelse(!is.na(x) & stringr::str_detect(x, "^\\d{1,2}\\.\\d{2}$"), stringr::str_replace_all(x, "\\.", ":"), x)
x <- ifelse(!is.na(x) & stringr::str_detect(x, "^\\d{1}:\\d{2}$"), paste0("0", x), x)
x <- ifelse(!is.na(x) & stringr::str_detect(x, "^\\d{3}$"), paste0("0", stringr::str_sub(x, 1, 1), ":", stringr::str_sub(x, 2, 3)), x)
x <- ifelse(!is.na(x) & stringr::str_detect(x, "^\\d{4}$"), paste0(stringr::str_sub(x, 1, 2), ":", stringr::str_sub(x, 3, 4)), x)
x_num <- suppressWarnings(as.numeric(as.character(x_original)))
es_decimal_excel <- !is.na(x_num) & x_num > 0 & x_num < 1
hora_decimal <- ifelse(es_decimal_excel, sprintf("%02d:%02d", floor(x_num * 24), round((x_num * 24 - floor(x_num * 24)) * 60)), NA)
x <- ifelse(es_decimal_excel, hora_decimal, x)
valido <- !is.na(x) & stringr::str_detect(x, "^\\d{2}:\\d{2}$")
hora <- suppressWarnings(as.numeric(stringr::str_sub(x, 1, 2)))
minuto <- suppressWarnings(as.numeric(stringr::str_sub(x, 4, 5)))
valido <- valido & hora >= 0 & hora <= 23 & minuto >= 0 & minuto <= 59
x[!is.na(x) & !valido] <- NA
x
}
# ==========================================================
# 5. Limpieza de variables CAPL-2
# ==========================================================
vars_steps <- paste0("steps", 1:7)
vars_horarios_capl <- c(paste0("time_on", 1:7), paste0("time_off", 1:7))
vars_nonwear <- paste0("non_wear_time", 1:7)
vars_numericas_capl <- c(
"ID", "age", "grade", "birth_month", "pacer_lap_distance", "pacer_laps", "plank_time",
"camsa_skill_score1", "camsa_time1", "camsa_skill_score2", "camsa_time2", vars_nonwear,
"self_report_pa", "csappa1", "csappa2", "csappa3", "csappa4", "csappa5", "csappa6",
"why_active1", "why_active2", "why_active3", "feelings_about_pa1", "feelings_about_pa2", "feelings_about_pa3",
"pa_guideline", "crf_means", "ms_means", "sports_skill", "pa_is", "pa_is_also", "improve", "increase",
"when_cooling_down", "heart_rate"
)
base_capl_limpia <- base_capl_raw %>%
dplyr::mutate(
dplyr::across(dplyr::any_of(vars_numericas_capl), limpiar_numero),
dplyr::across(dplyr::any_of(vars_steps), limpiar_pasos),
dplyr::across(dplyr::any_of(vars_horarios_capl), limpiar_hora_robusta),
gender = stringr::str_trim(gender)
)
# Ajuste específico del podómetro: no uso ausente se asume 0 cuando hay pasos y horarios.
for(i in 1:7){
steps_var <- paste0("steps", i)
on_var <- paste0("time_on", i)
off_var <- paste0("time_off", i)
non_var <- paste0("non_wear_time", i)
if(all(c(steps_var, on_var, off_var, non_var) %in% names(base_capl_limpia))){
base_capl_limpia[[non_var]] <- ifelse(
!is.na(base_capl_limpia[[steps_var]]) & !is.na(base_capl_limpia[[on_var]]) & !is.na(base_capl_limpia[[off_var]]) & is.na(base_capl_limpia[[non_var]]),
0,
base_capl_limpia[[non_var]]
)
}
if(steps_var %in% names(base_capl_limpia)){
base_capl_limpia[[steps_var]] <- ifelse(
!is.na(base_capl_limpia[[steps_var]]) & (base_capl_limpia[[steps_var]] < 1000 | base_capl_limpia[[steps_var]] > 30000),
NA,
base_capl_limpia[[steps_var]]
)
}
}
base_capl_limpia <- base_capl_limpia %>%
dplyr::mutate(
camsa_time1 = ifelse(camsa_time1 < 5 | camsa_time1 > 120, NA, camsa_time1),
camsa_time2 = ifelse(camsa_time2 < 5 | camsa_time2 > 120, NA, camsa_time2)
)
# ==========================================================
# 6. Cálculo CAPL-2 completo
# ==========================================================
resultados_capl <- capl::get_capl(raw_data = base_capl_limpia, sort = "asis")
status_capl <- resultados_capl %>%
dplyr::count(pc_status, db_status, mc_status, ku_status, capl_status) %>%
dplyr::arrange(desc(n))
resumen_podometro_region <- resultados_capl %>%
dplyr::group_by(region) %>%
dplyr::summarise(
n = dplyr::n(),
n_valid_days_4_mas = sum(valid_days >= 4, na.rm = TRUE),
pct_valid_days_4_mas = round(n_valid_days_4_mas / n * 100, 1),
n_db_complete = sum(db_status == "complete", na.rm = TRUE),
pct_db_complete = round(n_db_complete / n * 100, 1),
.groups = "drop"
)
Caracterización de la
muestra
media_ic95 <- function(x){
x <- x[!is.na(x)]
n <- length(x)
if(n < 2){
return(tibble::tibble(n = n, media = NA_real_, de = NA_real_, mediana = NA_real_, q1 = NA_real_, q3 = NA_real_, min = NA_real_, max = NA_real_, ic95_inf = NA_real_, ic95_sup = NA_real_))
}
media <- mean(x)
de <- sd(x)
se <- de / sqrt(n)
tcrit <- qt(0.975, df = n - 1)
tibble::tibble(
n = n, media = media, de = de, mediana = median(x),
q1 = as.numeric(quantile(x, 0.25, na.rm = TRUE)),
q3 = as.numeric(quantile(x, 0.75, na.rm = TRUE)),
min = min(x), max = max(x),
ic95_inf = media - tcrit * se,
ic95_sup = media + tcrit * se
)
}
tabla_caracterizacion <- dplyr::bind_rows(
resultados_capl %>% dplyr::count(region) %>% dplyr::mutate(Variable = "Región", Categoria = region, porcentaje = round(n / sum(n) * 100, 1)) %>% dplyr::select(Variable, Categoria, n, porcentaje),
resultados_capl %>% dplyr::count(gender) %>% dplyr::mutate(Variable = "Sexo", Categoria = dplyr::case_when(gender == "boy" ~ "Niños", gender == "girl" ~ "Niñas", TRUE ~ as.character(gender)), porcentaje = round(n / sum(n) * 100, 1)) %>% dplyr::select(Variable, Categoria, n, porcentaje),
resultados_capl %>% dplyr::count(age) %>% dplyr::mutate(Variable = "Edad", Categoria = paste0(age, " años"), porcentaje = round(n / sum(n) * 100, 1)) %>% dplyr::select(Variable, Categoria, n, porcentaje),
resultados_capl %>% dplyr::count(grade) %>% dplyr::mutate(Variable = "Grado escolar", Categoria = paste0("Grado ", grade), porcentaje = round(n / sum(n) * 100, 1)) %>% dplyr::select(Variable, Categoria, n, porcentaje)
)
knitr::kable(tabla_caracterizacion, caption = "Características de la muestra evaluada")
Características de la muestra evaluada
| Región |
Caribe |
160 |
24.9 |
| Región |
Centro sur-Amazonía |
162 |
25.2 |
| Región |
Eje cafetero-Antioquia |
160 |
24.9 |
| Región |
Pacífico |
160 |
24.9 |
| Sexo |
Niños |
322 |
50.2 |
| Sexo |
Niñas |
320 |
49.8 |
| Edad |
8 años |
128 |
19.9 |
| Edad |
9 años |
130 |
20.2 |
| Edad |
10 años |
128 |
19.9 |
| Edad |
11 años |
128 |
19.9 |
| Edad |
12 años |
128 |
19.9 |
| Grado escolar |
Grado 2 |
17 |
2.6 |
| Grado escolar |
Grado 3 |
139 |
21.7 |
| Grado escolar |
Grado 4 |
190 |
29.6 |
| Grado escolar |
Grado 5 |
132 |
20.6 |
| Grado escolar |
Grado 6 |
110 |
17.1 |
| Grado escolar |
Grado 7 |
53 |
8.3 |
| Grado escolar |
Grado 8 |
1 |
0.2 |
Disponibilidad de datos
por dominio
tabla_disponibilidad <- resultados_capl %>%
dplyr::summarise(
n_total = dplyr::n(),
competencia_fisica = sum(pc_status == "complete", na.rm = TRUE),
comportamiento_diario = sum(db_status == "complete", na.rm = TRUE),
motivacion_confianza = sum(mc_status == "complete", na.rm = TRUE),
conocimiento_comprension = sum(ku_status == "complete", na.rm = TRUE),
capl_total = sum(capl_status == "complete", na.rm = TRUE)
) %>%
tidyr::pivot_longer(cols = -n_total, names_to = "dominio", values_to = "n_valido") %>%
dplyr::mutate(
dominio = dplyr::case_when(
dominio == "competencia_fisica" ~ "Competencia física",
dominio == "comportamiento_diario" ~ "Comportamiento diario",
dominio == "motivacion_confianza" ~ "Motivación y confianza",
dominio == "conocimiento_comprension" ~ "Conocimiento y comprensión",
dominio == "capl_total" ~ "CAPL total",
TRUE ~ dominio
),
porcentaje_valido = round(n_valido / n_total * 100, 1),
n_incompleto = n_total - n_valido,
porcentaje_incompleto = round(n_incompleto / n_total * 100, 1)
) %>%
dplyr::select(Dominio = dominio, `n total` = n_total, `n válido` = n_valido, `% válido` = porcentaje_valido, `n incompleto` = n_incompleto, `% incompleto` = porcentaje_incompleto)
knitr::kable(tabla_disponibilidad, caption = "Disponibilidad de datos por dominio del CAPL-2")
Disponibilidad de datos por dominio del CAPL-2
| Competencia física |
642 |
639 |
99.5 |
3 |
0.5 |
| Comportamiento diario |
642 |
623 |
97.0 |
19 |
3.0 |
| Motivación y confianza |
642 |
640 |
99.7 |
2 |
0.3 |
| Conocimiento y comprensión |
642 |
639 |
99.5 |
3 |
0.5 |
| CAPL total |
642 |
621 |
96.7 |
21 |
3.3 |
Puntajes y categorías
interpretativas del CAPL-2
vars_dominios <- c("pc_score", "db_score", "mc_score", "ku_score", "capl_score")
nombres_dominios <- c(pc_score = "Competencia física", db_score = "Comportamiento diario", mc_score = "Motivación y confianza", ku_score = "Conocimiento y comprensión", capl_score = "CAPL total")
maximos_dominios <- c(pc_score = 30, db_score = 30, mc_score = 30, ku_score = 10, capl_score = 100)
status_dominios <- c(pc_score = "pc_status", db_score = "db_status", mc_score = "mc_status", ku_score = "ku_status", capl_score = "capl_status")
crear_descriptivo_dominio <- function(data, var){
status_var <- status_dominios[[var]]
x <- data %>% dplyr::filter(.data[[status_var]] == "complete") %>% dplyr::pull(.data[[var]])
media_ic95(x) %>% dplyr::mutate(dominio = nombres_dominios[[var]], maximo_teorico = maximos_dominios[[var]], porcentaje_maximo = media / maximo_teorico * 100)
}
tabla_dominios_capl <- dplyr::bind_rows(lapply(vars_dominios, function(v) crear_descriptivo_dominio(resultados_capl, v))) %>%
dplyr::mutate(
media = round(media, 2), de = round(de, 2), mediana = round(mediana, 2), q1 = round(q1, 2), q3 = round(q3, 2),
min = round(min, 2), max = round(max, 2), ic95_inf = round(ic95_inf, 2), ic95_sup = round(ic95_sup, 2), porcentaje_maximo = round(porcentaje_maximo, 1),
`Media (DE)` = paste0(media, " (", de, ")"),
`IC95%` = paste0(ic95_inf, "–", ic95_sup),
`Mediana [RIQ]` = paste0(mediana, " [", q1, ", ", q3, "]"),
Rango = paste0(min, "–", max)
) %>%
dplyr::transmute(Dominio = dominio, `Máximo teórico` = maximo_teorico, n, `Media (DE)`, `IC95%`, `Mediana [RIQ]`, Rango, `% del máximo` = porcentaje_maximo)
orden_categorias <- c("beginning", "progressing", "achieving", "excelling")
crear_tabla_categorias <- function(data, var_interpretacion, dominio){
data %>%
dplyr::filter(!is.na(.data[[var_interpretacion]])) %>%
dplyr::count(categoria = .data[[var_interpretacion]]) %>%
dplyr::mutate(dominio = dominio, categoria = factor(categoria, levels = orden_categorias), porcentaje = round(n / sum(n) * 100, 1)) %>%
dplyr::arrange(categoria)
}
tabla_categorias_larga <- dplyr::bind_rows(
crear_tabla_categorias(resultados_capl, "pc_interpretation", "Competencia física"),
crear_tabla_categorias(resultados_capl, "db_interpretation", "Comportamiento diario"),
crear_tabla_categorias(resultados_capl, "mc_interpretation", "Motivación y confianza"),
crear_tabla_categorias(resultados_capl, "ku_interpretation", "Conocimiento y comprensión"),
crear_tabla_categorias(resultados_capl, "capl_interpretation", "CAPL total")
)
tabla_categorias <- tabla_categorias_larga %>%
dplyr::mutate(valor = paste0(n, " (", porcentaje, ")"), categoria = stringr::str_to_title(as.character(categoria))) %>%
dplyr::select(dominio, categoria, valor) %>%
tidyr::pivot_wider(names_from = categoria, values_from = valor) %>%
dplyr::rename(`Dominio / puntaje` = dominio)
knitr::kable(tabla_dominios_capl, caption = "Puntajes del CAPL-2 por dominio y puntaje total")
Puntajes del CAPL-2 por dominio y puntaje total
| Competencia física |
30 |
639 |
11.92 (6.07) |
11.45–12.39 |
10.5 [7.5, 16] |
0–30 |
39.7 |
| Comportamiento diario |
30 |
623 |
13.65 (6.15) |
13.17–14.14 |
13 [9, 18] |
2–30 |
45.5 |
| Motivación y confianza |
30 |
640 |
23.06 (4.26) |
22.73–23.39 |
23.3 [19.6, 27] |
9.6–30 |
76.9 |
| Conocimiento y comprensión |
10 |
639 |
4.95 (2.44) |
4.76–5.14 |
5 [3, 7] |
0–10 |
49.5 |
| CAPL total |
100 |
621 |
53.7 (11.52) |
52.8–54.61 |
53.8 [45.7, 61.03] |
23.7–91.1 |
53.7 |
knitr::kable(tabla_categorias, caption = "Categorías interpretativas del CAPL-2 por dominio y puntaje total")
Categorías interpretativas del CAPL-2 por dominio y puntaje
total
| Competencia física |
436 (67.9) |
134 (20.9) |
41 (6.4) |
31 (4.8) |
| Comportamiento diario |
215 (34.5) |
340 (54.6) |
49 (7.9) |
19 (3) |
| Motivación y confianza |
38 (5.9) |
269 (42) |
110 (17.2) |
223 (34.8) |
| Conocimiento y comprensión |
346 (53.9) |
164 (25.5) |
42 (6.5) |
90 (14) |
| CAPL total |
247 (38.5) |
337 (52.5) |
30 (4.7) |
28 (4.4) |
Consistencia
interna
calcular_consistencia_final <- function(data, vars, escala){
datos <- data %>% dplyr::select(dplyr::all_of(vars)) %>% dplyr::mutate(dplyr::across(dplyr::everything(), as.numeric)) %>% tidyr::drop_na()
n_items <- length(vars)
n_casos <- nrow(datos)
if(n_items < 2 | n_casos < 10){
return(tibble::tibble(Escala = escala, `Número de ítems/indicadores` = n_items, n = n_casos, `α de Cronbach` = NA_real_, `α estandarizado` = NA_real_, `ω total` = NA_real_, `Correlación inter-ítem media` = NA_real_, `r ítem-total mínima` = NA_real_, `r ítem-total máxima` = NA_real_))
}
alfa <- suppressWarnings(suppressMessages(psych::alpha(datos, warnings = FALSE, check.keys = FALSE)))
omega_total <- tryCatch(suppressWarnings(suppressMessages(psych::omega(datos, nfactors = 1, plot = FALSE)$omega.tot)), error = function(e) NA_real_)
tibble::tibble(
Escala = escala,
`Número de ítems/indicadores` = n_items,
n = n_casos,
`α de Cronbach` = round(alfa$total$raw_alpha, 3),
`α estandarizado` = round(alfa$total$std.alpha, 3),
`ω total` = round(omega_total, 3),
`Correlación inter-ítem media` = round(alfa$total$average_r, 3),
`r ítem-total mínima` = round(min(alfa$item.stats$r.drop, na.rm = TRUE), 3),
`r ítem-total máxima` = round(max(alfa$item.stats$r.drop, na.rm = TRUE), 3)
)
}
scores_pc <- c("pacer_score", "plank_score", "camsa_score")
scores_db <- c("step_score", "self_report_pa_score")
scores_mc <- c("predilection_score", "adequacy_score", "intrinsic_motivation_score", "pa_competence_score")
scores_ku <- c("pa_guideline_score", "crf_means_score", "ms_means_score", "sports_skill_score", "fill_in_the_blanks_score")
scores_capl_dominios <- c("pc_score", "db_score", "mc_score", "ku_score")
tabla_consistencia_principal <- dplyr::bind_rows(
calcular_consistencia_final(resultados_capl, scores_pc, "Competencia física: PACER, plancha y CAMSA"),
calcular_consistencia_final(resultados_capl, scores_db, "Comportamiento diario: pasos y autorreporte"),
calcular_consistencia_final(resultados_capl, scores_mc, "Motivación y confianza: cuatro subcomponentes"),
calcular_consistencia_final(resultados_capl, scores_ku, "Conocimiento y comprensión: cinco indicadores"),
calcular_consistencia_final(resultados_capl, scores_capl_dominios, "CAPL-2 total: cuatro dominios")
)
knitr::kable(tabla_consistencia_principal, caption = "Consistencia interna y coherencia entre indicadores del CAPL-2")
Consistencia interna y coherencia entre indicadores del
CAPL-2
| Competencia física: PACER, plancha y CAMSA |
3 |
639 |
0.531 |
0.527 |
0.622 |
0.271 |
0.249 |
0.468 |
| Comportamiento diario: pasos y autorreporte |
2 |
623 |
0.056 |
0.111 |
0.111 |
0.059 |
0.059 |
0.059 |
| Motivación y confianza: cuatro subcomponentes |
4 |
642 |
0.591 |
0.609 |
0.651 |
0.280 |
0.202 |
0.524 |
| Conocimiento y comprensión: cinco indicadores |
5 |
639 |
0.349 |
0.443 |
0.463 |
0.137 |
0.117 |
0.346 |
| CAPL-2 total: cuatro dominios |
4 |
621 |
0.340 |
0.327 |
0.453 |
0.109 |
0.101 |
0.273 |
Análisis complementario
de motivación y confianza
items_mc_raw <- c("csappa1", "csappa2", "csappa3", "csappa4", "csappa5", "csappa6", "why_active1", "why_active2", "why_active3", "feelings_about_pa1", "feelings_about_pa2", "feelings_about_pa3")
datos_mc_raw <- base_capl_limpia %>%
dplyr::select(dplyr::all_of(items_mc_raw)) %>%
dplyr::mutate(dplyr::across(dplyr::everything(), as.numeric)) %>%
tidyr::drop_na()
alpha_mc_sin_recod <- suppressWarnings(suppressMessages(psych::alpha(datos_mc_raw, warnings = FALSE, check.keys = FALSE)))
alpha_mc_checkkeys <- suppressWarnings(suppressMessages(psych::alpha(datos_mc_raw, warnings = FALSE, check.keys = TRUE)))
tabla_sensibilidad_mc <- tibble::tibble(
Análisis = c("12 ítems crudos sin recodificación", "12 ítems crudos con recodificación automática"),
n = c(nrow(datos_mc_raw), nrow(datos_mc_raw)),
`α de Cronbach` = c(round(alpha_mc_sin_recod$total$raw_alpha, 3), round(alpha_mc_checkkeys$total$raw_alpha, 3)),
`α estandarizado` = c(round(alpha_mc_sin_recod$total$std.alpha, 3), round(alpha_mc_checkkeys$total$std.alpha, 3)),
`Correlación inter-ítem media` = c(round(alpha_mc_sin_recod$total$average_r, 3), round(alpha_mc_checkkeys$total$average_r, 3))
)
knitr::kable(tabla_sensibilidad_mc, caption = "Análisis complementario de direccionalidad en motivación y confianza")
Análisis complementario de direccionalidad en motivación y
confianza
| 12 ítems crudos sin recodificación |
642 |
0.592 |
0.559 |
0.095 |
| 12 ítems crudos con recodificación automática |
642 |
0.738 |
0.704 |
0.165 |
Correlaciones entre
dominios
vars_corr_dominios <- c("pc_score", "db_score", "mc_score", "ku_score", "capl_score")
corr_dominios <- psych::corr.test(
resultados_capl[, vars_corr_dominios],
use = "pairwise",
method = "spearman",
adjust = "none"
)
tabla_corr_dominios <- as.data.frame(as.table(corr_dominios$r)) %>%
dplyr::rename(Variable_1 = Var1, Variable_2 = Var2, rho = Freq) %>%
dplyr::mutate(
p = as.vector(corr_dominios$p),
n = as.vector(corr_dominios$n),
Variable_1 = dplyr::recode(as.character(Variable_1), pc_score = "Competencia física", db_score = "Comportamiento diario", mc_score = "Motivación y confianza", ku_score = "Conocimiento y comprensión", capl_score = "CAPL total"),
Variable_2 = dplyr::recode(as.character(Variable_2), pc_score = "Competencia física", db_score = "Comportamiento diario", mc_score = "Motivación y confianza", ku_score = "Conocimiento y comprensión", capl_score = "CAPL total"),
rho = round(rho, 3),
p = round(p, 4),
Interpretación = dplyr::case_when(abs(rho) < 0.30 ~ "Baja", abs(rho) >= 0.30 & abs(rho) < 0.60 ~ "Moderada", abs(rho) >= 0.60 & abs(rho) < 0.80 ~ "Alta", abs(rho) >= 0.80 ~ "Muy alta", TRUE ~ NA_character_)
) %>%
dplyr::filter(Variable_1 != Variable_2) %>%
dplyr::mutate(par = paste(pmin(Variable_1, Variable_2), pmax(Variable_1, Variable_2), sep = " - ")) %>%
dplyr::distinct(par, .keep_all = TRUE) %>%
dplyr::select(Variable_1, Variable_2, n, rho, p, Interpretación)
knitr::kable(tabla_corr_dominios, caption = "Correlaciones entre dominios y puntaje total del CAPL-2")
Correlaciones entre dominios y puntaje total del
CAPL-2
| Comportamiento diario |
Competencia física |
623 |
0.267 |
0.0000 |
Baja |
| Motivación y confianza |
Competencia física |
640 |
0.063 |
0.1131 |
Baja |
| Conocimiento y comprensión |
Competencia física |
642 |
-0.084 |
0.0341 |
Baja |
| CAPL total |
Competencia física |
642 |
0.666 |
0.0000 |
Alta |
| Motivación y confianza |
Comportamiento diario |
621 |
0.041 |
0.3049 |
Baja |
| Conocimiento y comprensión |
Comportamiento diario |
623 |
0.126 |
0.0016 |
Baja |
| CAPL total |
Comportamiento diario |
623 |
0.714 |
0.0000 |
Alta |
| Conocimiento y comprensión |
Motivación y confianza |
640 |
0.177 |
0.0000 |
Baja |
| CAPL total |
Motivación y confianza |
640 |
0.458 |
0.0000 |
Moderada |
| CAPL total |
Conocimiento y comprensión |
642 |
0.299 |
0.0000 |
Baja |
Modelos factoriales
evaluados
vars_cfa <- 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", "pc_score", "db_score", "mc_score", "ku_score")
datos_cfa <- resultados_capl %>%
dplyr::select(dplyr::all_of(vars_cfa)) %>%
dplyr::mutate(dplyr::across(dplyr::everything(), as.numeric))
ajustar_modelo_seguro <- function(modelo, data, nombre_modelo){
fit <- tryCatch(
lavaan::sem(model = modelo, data = data, estimator = "MLR", missing = "fiml", std.lv = TRUE),
error = function(e) e
)
if(inherits(fit, "error")){
return(list(nombre = nombre_modelo, fit = NULL, indices = NULL, cargas = NULL, r2 = NULL, convergio = FALSE, error = fit$message))
}
convergio <- tryCatch(lavaan::lavInspect(fit, "converged"), error = function(e) FALSE)
if(!isTRUE(convergio)){
return(list(nombre = nombre_modelo, fit = fit, indices = NULL, cargas = NULL, r2 = NULL, convergio = FALSE, error = "Modelo no convergente"))
}
indices <- tryCatch(lavaan::fitMeasures(fit, c("cfi.scaled", "tli.scaled", "rmsea.scaled", "srmr")), error = function(e) NULL)
cargas <- tryCatch(lavaan::parameterEstimates(fit, standardized = TRUE) %>% dplyr::filter(op == "=~"), error = function(e) NULL)
r2 <- tryCatch(lavaan::inspect(fit, "r2"), error = function(e) NULL)
list(nombre = nombre_modelo, fit = fit, indices = indices, cargas = cargas, r2 = r2, convergio = TRUE, error = NA_character_)
}
modelo_4d <- '
CompetenciaFisica =~ pacer_score + plank_score + camsa_score
ComportamientoDiario =~ step_score + self_report_pa_score
MotivacionConfianza =~ predilection_score + adequacy_score + intrinsic_motivation_score + pa_competence_score
ConocimientoComprension =~ pa_guideline_score + crf_means_score + ms_means_score + sports_skill_score + fill_in_the_blanks_score
'
modelo_pc <- 'CompetenciaFisica =~ pacer_score + plank_score + camsa_score'
modelo_db <- 'ComportamientoDiario =~ step_score + self_report_pa_score'
modelo_general <- 'AlfabetizacionFisica =~ pc_score + db_score + mc_score + ku_score'
modelo_cuestionarios <- '
MotivacionConfianza =~ predilection_score + adequacy_score + intrinsic_motivation_score + pa_competence_score
ConocimientoComprension =~ pa_guideline_score + crf_means_score + ms_means_score + sports_skill_score + fill_in_the_blanks_score
'
fit_4d <- ajustar_modelo_seguro(modelo_4d, datos_cfa, "CFA de cuatro dominios con 14 indicadores")
fit_pc <- ajustar_modelo_seguro(modelo_pc, datos_cfa, "CFA de competencia física")
fit_db <- ajustar_modelo_seguro(modelo_db, datos_cfa, "CFA de comportamiento diario")
fit_general <- ajustar_modelo_seguro(modelo_general, datos_cfa, "Factor general con cuatro dominios observados")
fit_cuestionarios <- ajustar_modelo_seguro(modelo_cuestionarios, datos_cfa, "Modelo refinado de componentes de cuestionario")
extraer_indices <- function(fit_obj){
if(is.null(fit_obj$indices)){
return(tibble::tibble(Modelo = fit_obj$nombre, CFI = NA_real_, TLI = NA_real_, RMSEA = NA_real_, SRMR = NA_real_))
}
tibble::tibble(
Modelo = fit_obj$nombre,
CFI = round(as.numeric(fit_obj$indices["cfi.scaled"]), 3),
TLI = round(as.numeric(fit_obj$indices["tli.scaled"]), 3),
RMSEA = round(as.numeric(fit_obj$indices["rmsea.scaled"]), 3),
SRMR = round(as.numeric(fit_obj$indices["srmr"]), 3)
)
}
indices_modelos <- dplyr::bind_rows(lapply(list(fit_4d, fit_pc, fit_db, fit_general, fit_cuestionarios), extraer_indices))
# Tabla final usada para la tesis: resume índices, hallazgos técnicos y decisión analítica.
tabla_modelos_factoriales <- tibble::tibble(
Modelo = c(
"CFA de cuatro dominios con 14 indicadores",
"CFA de competencia física",
"CFA de comportamiento diario",
"Factor general con cuatro dominios observados",
"Modelo refinado de componentes de cuestionario"
),
`Índices principales` = c(
"CFI = 0.659; TLI = 0.563; RMSEA = 0.095; SRMR = 0.090",
"Modelo saturado; gl = 0",
"Modelo con dos indicadores",
"CFI = 0.794; TLI = 0.380; RMSEA = 0.126; SRMR = 0.060",
"CFI = 0.906; TLI = 0.869; RMSEA = 0.057; SRMR = 0.051"
),
`Hallazgo técnico principal` = c(
"Solución inadmisible en comportamiento diario; carga estandarizada de pasos = 34.782; R² = NA",
"Carga estandarizada de plancha = 1.002 y varianza residual negativa = -0.028",
"Autorreporte de actividad física con carga baja = 0.082 y R² = 0.007",
"Solución inadmisible; carga estandarizada no interpretable en comportamiento diario = -29.308",
"Cargas más altas en motivación intrínseca = 0.738 y competencia percibida = 0.819; correlación entre factores = 0.347"
),
`Decisión analítica` = c(
"No retenido como modelo final",
"No retenido; interpretado como dominio compuesto por pruebas físicas heterogéneas",
"No retenido; interpretado mediante correlación entre pasos y autorreporte",
"No retenido como modelo final",
"Retenido como modelo complementario de estructura interna parcial"
)
)
knitr::kable(tabla_modelos_factoriales, caption = "Modelos factoriales evaluados y decisión analítica")
Modelos factoriales evaluados y decisión analítica
| CFA de cuatro dominios con 14 indicadores |
CFI = 0.659; TLI = 0.563; RMSEA = 0.095; SRMR =
0.090 |
Solución inadmisible en comportamiento diario; carga
estandarizada de pasos = 34.782; R² = NA |
No retenido como modelo final |
| CFA de competencia física |
Modelo saturado; gl = 0 |
Carga estandarizada de plancha = 1.002 y varianza
residual negativa = -0.028 |
No retenido; interpretado como dominio compuesto por
pruebas físicas heterogéneas |
| CFA de comportamiento diario |
Modelo con dos indicadores |
Autorreporte de actividad física con carga baja = 0.082
y R² = 0.007 |
No retenido; interpretado mediante correlación entre
pasos y autorreporte |
| Factor general con cuatro dominios observados |
CFI = 0.794; TLI = 0.380; RMSEA = 0.126; SRMR =
0.060 |
Solución inadmisible; carga estandarizada no
interpretable en comportamiento diario = -29.308 |
No retenido como modelo final |
| Modelo refinado de componentes de cuestionario |
CFI = 0.906; TLI = 0.869; RMSEA = 0.057; SRMR =
0.051 |
Cargas más altas en motivación intrínseca = 0.738 y
competencia percibida = 0.819; correlación entre factores = 0.347 |
Retenido como modelo complementario de estructura
interna parcial |
Comparaciones por
sexo, edad y región
base_grupos <- resultados_capl %>%
dplyr::mutate(
sexo = dplyr::case_when(gender == "boy" ~ "Niños", gender == "girl" ~ "Niñas", TRUE ~ NA_character_),
edad = paste0(age, " años")
) %>%
dplyr::select(sexo, edad, region, pc_score, db_score, mc_score, ku_score, capl_score) %>%
tidyr::pivot_longer(cols = c(pc_score, db_score, mc_score, ku_score, capl_score), names_to = "variable", values_to = "puntaje") %>%
dplyr::mutate(Dominio = dplyr::case_when(
variable == "pc_score" ~ "Competencia física",
variable == "db_score" ~ "Comportamiento diario",
variable == "mc_score" ~ "Motivación y confianza",
variable == "ku_score" ~ "Conocimiento y comprensión",
variable == "capl_score" ~ "CAPL total"
))
tabla_comparaciones_sexo <- base_grupos %>%
dplyr::filter(!is.na(sexo), !is.na(puntaje)) %>%
dplyr::group_by(Dominio) %>%
rstatix::wilcox_test(puntaje ~ sexo) %>%
rstatix::adjust_pvalue(method = "BH") %>%
dplyr::ungroup()
efecto_sexo <- base_grupos %>%
dplyr::filter(!is.na(sexo), !is.na(puntaje)) %>%
dplyr::group_by(Dominio) %>%
rstatix::wilcox_effsize(puntaje ~ sexo) %>%
dplyr::ungroup()
tabla_comparaciones_edad <- base_grupos %>%
dplyr::filter(!is.na(edad), !is.na(puntaje)) %>%
dplyr::group_by(Dominio) %>%
rstatix::kruskal_test(puntaje ~ edad) %>%
rstatix::adjust_pvalue(method = "BH") %>%
dplyr::ungroup()
efecto_edad <- base_grupos %>%
dplyr::filter(!is.na(edad), !is.na(puntaje)) %>%
dplyr::group_by(Dominio) %>%
rstatix::kruskal_effsize(puntaje ~ edad) %>%
dplyr::ungroup()
tabla_comparaciones_region <- base_grupos %>%
dplyr::filter(!is.na(region), !is.na(puntaje)) %>%
dplyr::group_by(Dominio) %>%
rstatix::kruskal_test(puntaje ~ region) %>%
rstatix::adjust_pvalue(method = "BH") %>%
dplyr::ungroup()
efecto_region <- base_grupos %>%
dplyr::filter(!is.na(region), !is.na(puntaje)) %>%
dplyr::group_by(Dominio) %>%
rstatix::kruskal_effsize(puntaje ~ region) %>%
dplyr::ungroup()
tabla_comparaciones_resumen <- tabla_comparaciones_sexo %>%
dplyr::select(Dominio, `Sexo p ajustado` = p.adj) %>%
dplyr::left_join(efecto_sexo %>% dplyr::select(Dominio, `Sexo r` = effsize), by = "Dominio") %>%
dplyr::left_join(tabla_comparaciones_edad %>% dplyr::select(Dominio, `Edad p ajustado` = p.adj), by = "Dominio") %>%
dplyr::left_join(efecto_edad %>% dplyr::select(Dominio, `Edad ε²` = effsize), by = "Dominio") %>%
dplyr::left_join(tabla_comparaciones_region %>% dplyr::select(Dominio, `Región p ajustado` = p.adj), by = "Dominio") %>%
dplyr::left_join(efecto_region %>% dplyr::select(Dominio, `Región ε²` = effsize), by = "Dominio") %>%
dplyr::mutate(
dplyr::across(dplyr::contains("p ajustado"), ~ ifelse(.x < 0.001, "< .001", sprintf("%.3f", .x))),
dplyr::across(c(`Sexo r`, `Edad ε²`, `Región ε²`), ~ sprintf("%.3f", pmax(.x, 0)))
)
knitr::kable(tabla_comparaciones_resumen, caption = "Comparaciones de los puntajes del CAPL-2 por sexo, edad y región")
Comparaciones de los puntajes del CAPL-2 por sexo, edad y
región
| CAPL total |
< .001 |
0.358 |
< .001 |
0.038 |
< .001 |
0.184 |
| Competencia física |
< .001 |
0.294 |
< .001 |
0.076 |
< .001 |
0.138 |
| Comportamiento diario |
< .001 |
0.357 |
0.041 |
0.012 |
< .001 |
0.137 |
| Conocimiento y comprensión |
0.732 |
0.014 |
0.665 |
0.000 |
< .001 |
0.336 |
| Motivación y confianza |
0.320 |
0.045 |
0.345 |
0.002 |
< .001 |
0.379 |
Figura: distribución
regional de puntajes
fig_region <- ggplot2::ggplot(
base_grupos %>% dplyr::filter(!is.na(region), !is.na(puntaje)),
ggplot2::aes(x = region, y = puntaje)
) +
ggplot2::geom_boxplot(outlier.alpha = 0.25, width = 0.65) +
ggplot2::facet_wrap(~ Dominio, scales = "free_y", ncol = 3) +
ggplot2::labs(
title = "Distribución de puntajes CAPL-2 por región",
subtitle = "Puntajes por dominio y puntaje total",
x = NULL,
y = "Puntaje",
caption = "Nota. Las cajas representan la mediana y el rango intercuartílico."
) +
ggplot2::theme_minimal(base_size = 12) +
ggplot2::theme(
axis.text.x = ggplot2::element_text(angle = 30, hjust = 1),
plot.title = ggplot2::element_text(face = "bold")
)
fig_region
