Nota de
transparencia
Este documento presenta el flujo reproducible utilizado para la fase
de fiabilidad interevaluador del CAPL-2 versión Colombia. El análisis
incluye la preparación de bases, construcción de la base pareada,
estimación de acuerdo por ítems, fiabilidad de puntajes derivados de
cuestionario, análisis de Bland-Altman y descripción complementaria del
CAPL-2 completo en la primera medición.
1. Paquetes
paquetes <- c(
"readxl", "writexl", "dplyr", "tidyr", "stringr", "janitor",
"psych", "irr", "ggplot2", "tibble", "purrr", "knitr"
)
instalar <- paquetes[!paquetes %in% installed.packages()[, "Package"]]
if(length(instalar) > 0) install.packages(instalar)
invisible(lapply(paquetes, library, character.only = TRUE))
if(!"capl" %in% installed.packages()[, "Package"]){
install.packages("devtools")
devtools::install_github(
repo = "barnzilla/capl",
upgrade = "never",
build_vignettes = TRUE,
force = TRUE
)
}
library(capl)
2. Carga robusta de
bases
# ==========================================================
# RUTA CORRECTA DEL PROYECTO DE FIABILIDAD
# ==========================================================
ruta_proyecto <- path.expand("~/análisis doctorado/Fiabilidad")
setwd(ruta_proyecto)
cat("Carpeta de trabajo:\n")
## Carpeta de trabajo:
print(getwd())
## [1] "C:/Users/Personal/Documents/análisis doctorado/Fiabilidad"
# ==========================================================
# FUNCIONES AUXILIARES
# ==========================================================
normalizar_texto <- function(x){
x <- stringr::str_to_lower(as.character(x))
x <- stringr::str_replace_all(x, "á", "a")
x <- stringr::str_replace_all(x, "é", "e")
x <- stringr::str_replace_all(x, "í", "i")
x <- stringr::str_replace_all(x, "ó", "o")
x <- stringr::str_replace_all(x, "ú", "u")
x <- stringr::str_replace_all(x, "ñ", "n")
x <- stringr::str_replace_all(x, "°", "")
x <- stringr::str_replace_all(x, "º", "")
x <- stringr::str_replace_all(x, "#", "")
x <- stringr::str_squish(x)
x
}
limpiar_na <- function(x){
x <- as.character(x)
x <- stringr::str_trim(x)
x[x %in% c("", " ", "NA", "N/A", "na", "n/a", "Na", "nA", "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, ",", ".")
suppressWarnings(as.numeric(x))
}
limpiar_hora <- function(x){
x <- limpiar_na(x)
x <- stringr::str_replace_all(x, "\\.", ":")
x <- stringr::str_trim(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{1,2}:\\d{1}$"), NA, x)
valido <- stringr::str_detect(x, "^\\d{2}:\\d{2}$")
x[!is.na(x) & !valido] <- NA
hora <- suppressWarnings(as.numeric(stringr::str_sub(x, 1, 2)))
minuto <- suppressWarnings(as.numeric(stringr::str_sub(x, 4, 5)))
x[!is.na(x) & (hora < 0 | hora > 23 | minuto < 0 | minuto > 59)] <- NA
x
}
renombrar_si_existe <- function(df, viejo, nuevo){
if(viejo %in% names(df) && !nuevo %in% names(df)){
names(df)[names(df) == viejo] <- nuevo
}
df
}
asegurar_variables <- function(df, vars){
for(v in vars){
if(!v %in% names(df)) df[[v]] <- NA_character_
}
df
}
corregir_nombres_capl <- function(df){
df <- janitor::clean_names(df)
df <- renombrar_si_existe(df, "why_activel", "why_active1")
df <- renombrar_si_existe(df, "why_active_l", "why_active1")
df <- renombrar_si_existe(df, "feelings_about_pal", "feelings_about_pa1")
df <- renombrar_si_existe(df, "feelings_about_pa_l", "feelings_about_pa1")
df <- renombrar_si_existe(df, "pacer_lap_distance_15_o_20_m", "pacer_lap_distance")
df <- renombrar_si_existe(df, "camsa_time_1", "camsa_time1")
df <- renombrar_si_existe(df, "camsa_time_2", "camsa_time2")
df <- renombrar_si_existe(df, "camsa_skill_score_2", "camsa_skill_score2")
df <- renombrar_si_existe(df, "id", "ID")
df
}
# ==========================================================
# INVENTARIO DE ARCHIVOS Y HOJAS
# ==========================================================
archivos_excel <- list.files(
path = ruta_proyecto,
pattern = "\\.xlsx$",
recursive = FALSE,
full.names = TRUE
)
if(length(archivos_excel) == 0){
stop("No se encontraron archivos Excel en la carpeta: ", ruta_proyecto)
}
inventario_hojas <- purrr::map_dfr(
archivos_excel,
function(archivo){
tibble::tibble(
archivo = archivo,
archivo_nombre = basename(archivo),
hoja = readxl::excel_sheets(archivo)
)
}
) %>%
dplyr::mutate(
archivo_norm = normalizar_texto(archivo_nombre),
hoja_norm = normalizar_texto(hoja),
texto_busqueda = paste(archivo_norm, hoja_norm)
)
cat("\nInventario de archivos y hojas detectadas:\n")
##
## Inventario de archivos y hojas detectadas:
print(inventario_hojas %>% dplyr::select(archivo_nombre, hoja), n = Inf)
## # A tibble: 12 × 2
## archivo_nombre hoja
## <chr> <chr>
## 1 Región Centro sur - Amazonía .xlsx "CAPL2_Plantilla_Final_Correg…
## 2 Región Centro sur - Amazonía .xlsx "CUESTIONARIO 2 "
## 3 Región eje cafetero y Antioquia.xlsx "CAPL2 Plantilla Manizales"
## 4 Región eje cafetero y Antioquia.xlsx "Aplicación Cuestionario N°2"
## 5 resultados_fiabilidad_CAPL2_cuestionarios.xlsx "calidad_rangos_items"
## 6 resultados_fiabilidad_CAPL2_cuestionarios.xlsx "datos_perdidos_items"
## 7 resultados_fiabilidad_CAPL2_cuestionarios.xlsx "pares_items"
## 8 resultados_fiabilidad_CAPL2_cuestionarios.xlsx "fiabilidad_items"
## 9 resultados_fiabilidad_CAPL2_cuestionarios.xlsx "datos_perdidos_scores"
## 10 resultados_fiabilidad_CAPL2_cuestionarios.xlsx "pares_scores"
## 11 resultados_fiabilidad_CAPL2_cuestionarios.xlsx "fiabilidad_scores"
## 12 resultados_fiabilidad_CAPL2_cuestionarios.xlsx "bland_altman"
# ==========================================================
# SELECCIÓN AUTOMÁTICA DE ARCHIVOS Y HOJAS
# ==========================================================
puntuar_candidato <- function(region, medicion){
inv <- inventario_hojas
region_pat <- if(region == "amz") "centro|amazon|amazonia" else "eje|cafetero|antioquia|manizales"
m1_pat <- "capl|plantilla|final|manizales"
m2_pat <- "cuestionario|aplicacion|aplicaci|segunda| 2|n2|no 2|numero 2|nb02"
inv %>%
dplyr::mutate(
score_region = as.integer(stringr::str_detect(texto_busqueda, region_pat)),
score_m1 = as.integer(stringr::str_detect(hoja_norm, m1_pat)) + as.integer(stringr::str_detect(archivo_norm, m1_pat)),
score_m2 = as.integer(stringr::str_detect(hoja_norm, m2_pat)) + as.integer(stringr::str_detect(archivo_norm, m2_pat)),
score = dplyr::case_when(
medicion == 1 ~ 10 * score_region + 4 * score_m1 - 3 * score_m2,
medicion == 2 ~ 10 * score_region + 5 * score_m2 - 2 * score_m1,
TRUE ~ 0
)
) %>%
dplyr::arrange(dplyr::desc(score), archivo_nombre, hoja)
}
seleccionar_hoja <- function(region, medicion){
cand <- puntuar_candidato(region, medicion)
cand <- cand %>% dplyr::filter(score > 0)
if(nrow(cand) == 0){
stop("No se pudo identificar la base de ", region, " medición ", medicion, ". Revise los nombres de archivos y hojas.")
}
cand[1, ]
}
sel_amz_m1 <- seleccionar_hoja("amz", 1)
sel_amz_m2 <- seleccionar_hoja("amz", 2)
sel_eje_m1 <- seleccionar_hoja("eje", 1)
sel_eje_m2 <- seleccionar_hoja("eje", 2)
# Evitar que M1 y M2 queden asignados a la misma hoja cuando existe otra opción para M2
resolver_duplicado_m2 <- function(sel_m1, sel_m2, region){
if(sel_m1$archivo == sel_m2$archivo && sel_m1$hoja == sel_m2$hoja){
cand <- puntuar_candidato(region, 2) %>%
dplyr::filter(!(archivo == sel_m1$archivo & hoja == sel_m1$hoja), score > 0)
if(nrow(cand) > 0) return(cand[1, ])
}
sel_m2
}
sel_amz_m2 <- resolver_duplicado_m2(sel_amz_m1, sel_amz_m2, "amz")
sel_eje_m2 <- resolver_duplicado_m2(sel_eje_m1, sel_eje_m2, "eje")
tabla_archivos_usados <- tibble::tibble(
base = c("amz_m1", "amz_m2", "eje_m1", "eje_m2"),
archivo = c(sel_amz_m1$archivo_nombre, sel_amz_m2$archivo_nombre, sel_eje_m1$archivo_nombre, sel_eje_m2$archivo_nombre),
hoja = c(sel_amz_m1$hoja, sel_amz_m2$hoja, sel_eje_m1$hoja, sel_eje_m2$hoja)
)
cat("\nArchivos y hojas usados en el análisis:\n")
##
## Archivos y hojas usados en el análisis:
print(tabla_archivos_usados, n = Inf)
## # A tibble: 4 × 3
## base archivo hoja
## <chr> <chr> <chr>
## 1 amz_m1 Región Centro sur - Amazonía .xlsx "CAPL2_Plantilla_Final_Corregida"
## 2 amz_m2 Región Centro sur - Amazonía .xlsx "CUESTIONARIO 2 "
## 3 eje_m1 Región eje cafetero y Antioquia.xlsx "CAPL2 Plantilla Manizales"
## 4 eje_m2 Región eje cafetero y Antioquia.xlsx "Aplicación Cuestionario N°2"
# ==========================================================
# CARGA DE BASES
# ==========================================================
amz_m1 <- readxl::read_excel(sel_amz_m1$archivo, sheet = sel_amz_m1$hoja, col_types = "text") %>% corregir_nombres_capl()
amz_m2 <- readxl::read_excel(sel_amz_m2$archivo, sheet = sel_amz_m2$hoja, col_types = "text") %>% corregir_nombres_capl()
eje_m1 <- readxl::read_excel(sel_eje_m1$archivo, sheet = sel_eje_m1$hoja, col_types = "text") %>% corregir_nombres_capl()
eje_m2 <- readxl::read_excel(sel_eje_m2$archivo, sheet = sel_eje_m2$hoja, col_types = "text") %>% corregir_nombres_capl()
amz_m1 <- amz_m1 %>% dplyr::mutate(region = "Centro sur-Amazonía", id_estudio = paste0("AMZ_", ID))
amz_m2 <- amz_m2 %>% dplyr::mutate(region = "Centro sur-Amazonía", id_estudio = paste0("AMZ_", ID))
eje_m1 <- eje_m1 %>% dplyr::mutate(region = "Eje cafetero-Antioquia", id_estudio = paste0("EJE_", ID))
eje_m2 <- eje_m2 %>% dplyr::mutate(region = "Eje cafetero-Antioquia", id_estudio = paste0("EJE_", ID))
cat("\nDimensiones de bases cargadas:\n")
##
## Dimensiones de bases cargadas:
print(tibble::tibble(
base = c("amz_m1", "amz_m2", "eje_m1", "eje_m2"),
filas = c(nrow(amz_m1), nrow(amz_m2), nrow(eje_m1), nrow(eje_m2)),
columnas = c(ncol(amz_m1), ncol(amz_m2), ncol(eje_m1), ncol(eje_m2))
))
## # A tibble: 4 × 3
## base filas columnas
## <chr> <int> <int>
## 1 amz_m1 162 65
## 2 amz_m2 162 27
## 3 eje_m1 160 65
## 4 eje_m2 160 29
3. Construcción de base
pareada
vars_fiabilidad <- c(
"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"
)
vars_contexto_m1 <- c("id_estudio", "ID", "region", "age", "gender", "grade", "birth_month")
vars_contexto_m2 <- c("id_estudio", "ID", "region", "age")
estandarizar_cuestionario <- function(df){
df <- asegurar_variables(df, c(vars_contexto_m1, vars_fiabilidad))
df %>% dplyr::mutate(dplyr::across(dplyr::all_of(vars_fiabilidad), as.character))
}
amz_m1_q <- estandarizar_cuestionario(amz_m1)
amz_m2_q <- estandarizar_cuestionario(amz_m2)
eje_m1_q <- estandarizar_cuestionario(eje_m1)
eje_m2_q <- estandarizar_cuestionario(eje_m2)
base_m1 <- dplyr::bind_rows(
amz_m1_q %>% dplyr::select(dplyr::all_of(vars_contexto_m1), dplyr::all_of(vars_fiabilidad)),
eje_m1_q %>% dplyr::select(dplyr::all_of(vars_contexto_m1), dplyr::all_of(vars_fiabilidad))
)
base_m2 <- dplyr::bind_rows(
amz_m2_q %>% dplyr::select(dplyr::all_of(vars_contexto_m2), dplyr::all_of(vars_fiabilidad)),
eje_m2_q %>% dplyr::select(dplyr::all_of(vars_contexto_m2), dplyr::all_of(vars_fiabilidad))
)
base_ev1 <- base_m1 %>%
dplyr::rename_with(~ paste0(.x, "_ev1"), .cols = dplyr::all_of(vars_fiabilidad))
base_ev2 <- base_m2 %>%
dplyr::rename(age_ev2 = age) %>%
dplyr::rename_with(~ paste0(.x, "_ev2"), .cols = dplyr::all_of(vars_fiabilidad))
base_fiabilidad <- base_ev1 %>%
dplyr::left_join(base_ev2, by = c("id_estudio", "ID", "region"))
vars_pareadas_items <- c(paste0(vars_fiabilidad, "_ev1"), paste0(vars_fiabilidad, "_ev2"))
base_fiabilidad <- base_fiabilidad %>%
dplyr::mutate(dplyr::across(dplyr::all_of(vars_pareadas_items), limpiar_numero))
cat("Dimensiones de la base pareada:\n")
## Dimensiones de la base pareada:
print(dim(base_fiabilidad))
## [1] 322 52
cat("\nParticipantes por región:\n")
##
## Participantes por región:
print(table(base_fiabilidad$region, useNA = "ifany"))
##
## Centro sur-Amazonía Eje cafetero-Antioquia
## 162 160
4. Disponibilidad de
pares completos
reporte_pares_items <- lapply(vars_fiabilidad, function(v){
var1 <- paste0(v, "_ev1")
var2 <- paste0(v, "_ev2")
datos <- base_fiabilidad %>% dplyr::select(dplyr::all_of(c(var1, var2)))
n_completo <- sum(stats::complete.cases(datos))
tibble::tibble(
item = v,
n_total = nrow(datos),
n_completo = n_completo,
n_incompleto = nrow(datos) - n_completo,
porcentaje_completo = round(n_completo / nrow(datos) * 100, 1)
)
}) %>%
dplyr::bind_rows() %>%
dplyr::arrange(porcentaje_completo)
knitr::kable(reporte_pares_items, caption = "Pares completos por ítem de cuestionario")
Pares completos por ítem de cuestionario
| improve |
322 |
320 |
2 |
99.4 |
| heart_rate |
322 |
321 |
1 |
99.7 |
| csappa1 |
322 |
322 |
0 |
100.0 |
| csappa2 |
322 |
322 |
0 |
100.0 |
| csappa3 |
322 |
322 |
0 |
100.0 |
| csappa4 |
322 |
322 |
0 |
100.0 |
| csappa5 |
322 |
322 |
0 |
100.0 |
| csappa6 |
322 |
322 |
0 |
100.0 |
| why_active1 |
322 |
322 |
0 |
100.0 |
| why_active2 |
322 |
322 |
0 |
100.0 |
| why_active3 |
322 |
322 |
0 |
100.0 |
| feelings_about_pa1 |
322 |
322 |
0 |
100.0 |
| feelings_about_pa2 |
322 |
322 |
0 |
100.0 |
| feelings_about_pa3 |
322 |
322 |
0 |
100.0 |
| pa_guideline |
322 |
322 |
0 |
100.0 |
| crf_means |
322 |
322 |
0 |
100.0 |
| ms_means |
322 |
322 |
0 |
100.0 |
| sports_skill |
322 |
322 |
0 |
100.0 |
| pa_is |
322 |
322 |
0 |
100.0 |
| pa_is_also |
322 |
322 |
0 |
100.0 |
| increase |
322 |
322 |
0 |
100.0 |
| when_cooling_down |
322 |
322 |
0 |
100.0 |
5. Fiabilidad por
ítems: kappa
items_ordinales <- c(
"csappa1", "csappa2", "csappa3", "csappa4", "csappa5", "csappa6",
"why_active1", "why_active2", "why_active3",
"feelings_about_pa1", "feelings_about_pa2", "feelings_about_pa3"
)
items_categoricos <- c(
"pa_guideline", "crf_means", "ms_means", "sports_skill",
"pa_is", "pa_is_also", "improve", "increase",
"when_cooling_down", "heart_rate"
)
comparacion_items <- lapply(vars_fiabilidad, function(item){
var1 <- paste0(item, "_ev1")
var2 <- paste0(item, "_ev2")
datos <- base_fiabilidad %>% dplyr::select(dplyr::all_of(c(var1, var2))) %>% tidyr::drop_na()
tibble::tibble(
item = item,
n = nrow(datos),
media_ev1 = mean(datos[[var1]], na.rm = TRUE),
media_ev2 = mean(datos[[var2]], na.rm = TRUE),
diferencia_media = mean(datos[[var1]] - datos[[var2]], na.rm = TRUE),
acuerdo_exacto = mean(datos[[var1]] == datos[[var2]], na.rm = TRUE) * 100
)
}) %>% dplyr::bind_rows()
interpretar_kappa <- function(kappa){
dplyr::case_when(
is.na(kappa) ~ "No estimable",
kappa < 0.00 ~ "Menor que azar",
kappa >= 0.00 & kappa <= 0.20 ~ "Ligera",
kappa > 0.20 & kappa <= 0.40 ~ "Aceptable",
kappa > 0.40 & kappa <= 0.60 ~ "Moderada",
kappa > 0.60 & kappa <= 0.80 ~ "Sustancial",
kappa > 0.80 ~ "Casi perfecta",
TRUE ~ NA_character_
)
}
set.seed(123)
calcular_kappa_boot <- function(df, item, tipo = "simple", B = 500){
var1 <- paste0(item, "_ev1")
var2 <- paste0(item, "_ev2")
datos <- df %>% dplyr::select(dplyr::all_of(c(var1, var2))) %>% tidyr::drop_na()
n <- nrow(datos)
acuerdo <- mean(datos[[var1]] == datos[[var2]]) * 100
weight_arg <- ifelse(tipo == "ponderado", "squared", "unweighted")
kap_obs <- tryCatch(irr::kappa2(datos, weight = weight_arg)$value, error = function(e) NA_real_)
boot_vals <- replicate(B, {
idx <- sample(seq_len(n), size = n, replace = TRUE)
datos_b <- datos[idx, ]
tryCatch(irr::kappa2(datos_b, weight = weight_arg)$value, error = function(e) NA_real_)
})
boot_vals <- boot_vals[!is.na(boot_vals)]
tibble::tibble(
item = item,
tipo_kappa = tipo,
n = n,
acuerdo_exacto = acuerdo,
kappa = kap_obs,
ic95_inf = ifelse(length(boot_vals) > 0, stats::quantile(boot_vals, 0.025, na.rm = TRUE), NA_real_),
ic95_sup = ifelse(length(boot_vals) > 0, stats::quantile(boot_vals, 0.975, na.rm = TRUE), NA_real_)
)
}
tabla_kappa_items_ic95 <- dplyr::bind_rows(
lapply(items_ordinales, function(x) calcular_kappa_boot(base_fiabilidad, x, tipo = "ponderado", B = 500)),
lapply(items_categoricos, function(x) calcular_kappa_boot(base_fiabilidad, x, tipo = "simple", B = 500))
) %>%
dplyr::mutate(interpretacion = interpretar_kappa(kappa))
tabla_items_apa_ic95 <- tabla_kappa_items_ic95 %>%
dplyr::left_join(comparacion_items, by = "item") %>%
dplyr::mutate(
item_label = dplyr::case_when(
item == "csappa1" ~ "CSAPPA 1",
item == "csappa2" ~ "CSAPPA 2",
item == "csappa3" ~ "CSAPPA 3",
item == "csappa4" ~ "CSAPPA 4",
item == "csappa5" ~ "CSAPPA 5",
item == "csappa6" ~ "CSAPPA 6",
item == "why_active1" ~ "Motivación intrínseca 1",
item == "why_active2" ~ "Motivación intrínseca 2",
item == "why_active3" ~ "Motivación intrínseca 3",
item == "feelings_about_pa1" ~ "Competencia percibida 1",
item == "feelings_about_pa2" ~ "Competencia percibida 2",
item == "feelings_about_pa3" ~ "Competencia percibida 3",
item == "pa_guideline" ~ "Guía de actividad física",
item == "crf_means" ~ "Aptitud cardiorrespiratoria",
item == "ms_means" ~ "Fuerza/resistencia muscular",
item == "sports_skill" ~ "Habilidad deportiva",
item == "pa_is" ~ "Actividad física es...",
item == "pa_is_also" ~ "Actividad física también es...",
item == "improve" ~ "Mejorar condición física",
item == "increase" ~ "Incrementar actividad física",
item == "when_cooling_down" ~ "Enfriamiento",
item == "heart_rate" ~ "Frecuencia cardiaca",
TRUE ~ item
),
tipo_kappa = dplyr::case_when(
tipo_kappa == "ponderado" ~ "Ponderado",
tipo_kappa == "simple" ~ "Simple",
TRUE ~ tipo_kappa
),
acuerdo_exacto = round(acuerdo_exacto.x, 1),
media_ev1 = round(media_ev1, 2),
media_ev2 = round(media_ev2, 2),
diferencia_media = round(diferencia_media, 2),
kappa = round(kappa, 3),
ic95_inf = round(ic95_inf, 3),
ic95_sup = round(ic95_sup, 3),
`IC95% κ` = paste0("[", ic95_inf, ", ", ic95_sup, "]")
) %>%
dplyr::transmute(
Ítem = item_label,
n = n.x,
`Media EV1` = media_ev1,
`Media EV2` = media_ev2,
`Diferencia media` = diferencia_media,
`Acuerdo exacto (%)` = acuerdo_exacto,
`Tipo de κ` = tipo_kappa,
κ = kappa,
`IC95% κ`,
Interpretación = interpretacion
) %>%
dplyr::arrange(κ)
knitr::kable(tabla_items_apa_ic95, caption = "Fiabilidad interevaluador por ítems")
Fiabilidad interevaluador por ítems
| Incrementar actividad física |
322 |
5.99 |
7.21 |
-1.22 |
36.3 |
Simple |
0.045 |
[-0.014, 0.105] |
Ligera |
| Enfriamiento |
322 |
4.66 |
3.06 |
1.60 |
36.0 |
Simple |
0.048 |
[-0.01, 0.114] |
Ligera |
| Mejorar condición física |
320 |
4.33 |
3.50 |
0.83 |
39.7 |
Simple |
0.079 |
[0.027, 0.142] |
Ligera |
| Frecuencia cardiaca |
321 |
5.55 |
4.67 |
0.88 |
33.3 |
Simple |
0.104 |
[0.042, 0.164] |
Ligera |
| Actividad física es… |
322 |
4.07 |
3.35 |
0.71 |
45.7 |
Simple |
0.224 |
[0.157, 0.285] |
Aceptable |
| Actividad física también es… |
322 |
5.15 |
5.20 |
-0.05 |
48.1 |
Simple |
0.225 |
[0.159, 0.291] |
Aceptable |
| Guía de actividad física |
322 |
2.15 |
2.85 |
-0.70 |
43.5 |
Simple |
0.226 |
[0.167, 0.29] |
Aceptable |
| Habilidad deportiva |
322 |
2.83 |
3.36 |
-0.53 |
46.6 |
Simple |
0.231 |
[0.168, 0.293] |
Aceptable |
| Fuerza/resistencia muscular |
322 |
2.12 |
1.80 |
0.33 |
49.4 |
Simple |
0.270 |
[0.197, 0.339] |
Aceptable |
| Aptitud cardiorrespiratoria |
322 |
2.26 |
1.97 |
0.30 |
50.9 |
Simple |
0.288 |
[0.214, 0.363] |
Aceptable |
| CSAPPA 5 |
322 |
2.47 |
2.98 |
-0.52 |
50.6 |
Ponderado |
0.433 |
[0.335, 0.509] |
Moderada |
| CSAPPA 1 |
322 |
2.42 |
2.89 |
-0.47 |
47.2 |
Ponderado |
0.474 |
[0.391, 0.55] |
Moderada |
| CSAPPA 3 |
322 |
2.46 |
2.98 |
-0.51 |
50.3 |
Ponderado |
0.505 |
[0.419, 0.583] |
Moderada |
| CSAPPA 4 |
322 |
2.03 |
2.16 |
-0.12 |
46.9 |
Ponderado |
0.596 |
[0.52, 0.669] |
Moderada |
| CSAPPA 2 |
322 |
1.95 |
2.04 |
-0.10 |
52.5 |
Ponderado |
0.615 |
[0.52, 0.694] |
Sustancial |
| Motivación intrínseca 1 |
322 |
3.96 |
4.04 |
-0.08 |
55.9 |
Ponderado |
0.640 |
[0.561, 0.711] |
Sustancial |
| CSAPPA 6 |
322 |
1.99 |
2.22 |
-0.23 |
50.9 |
Ponderado |
0.662 |
[0.589, 0.726] |
Sustancial |
| Motivación intrínseca 3 |
322 |
3.62 |
3.94 |
-0.32 |
54.0 |
Ponderado |
0.746 |
[0.679, 0.803] |
Sustancial |
| Motivación intrínseca 2 |
322 |
3.65 |
3.95 |
-0.30 |
52.2 |
Ponderado |
0.747 |
[0.686, 0.799] |
Sustancial |
| Competencia percibida 2 |
322 |
3.49 |
3.72 |
-0.22 |
49.7 |
Ponderado |
0.766 |
[0.713, 0.81] |
Sustancial |
| Competencia percibida 1 |
322 |
3.51 |
3.79 |
-0.28 |
46.9 |
Ponderado |
0.769 |
[0.716, 0.81] |
Sustancial |
| Competencia percibida 3 |
322 |
3.57 |
3.86 |
-0.29 |
49.4 |
Ponderado |
0.786 |
[0.742, 0.827] |
Sustancial |
6. Puntajes derivados
de cuestionario
crear_base_capl_cuestionario <- function(df, evaluador = 1){
sufijo <- paste0("_ev", evaluador)
df %>%
dplyr::transmute(
id_estudio = id_estudio,
region = region,
age = limpiar_numero(age),
gender = stringr::str_to_lower(as.character(gender)),
self_report_pa = NA_real_,
csappa1 = .data[[paste0("csappa1", sufijo)]],
csappa2 = .data[[paste0("csappa2", sufijo)]],
csappa3 = .data[[paste0("csappa3", sufijo)]],
csappa4 = .data[[paste0("csappa4", sufijo)]],
csappa5 = .data[[paste0("csappa5", sufijo)]],
csappa6 = .data[[paste0("csappa6", sufijo)]],
why_active1 = .data[[paste0("why_active1", sufijo)]],
why_active2 = .data[[paste0("why_active2", sufijo)]],
why_active3 = .data[[paste0("why_active3", sufijo)]],
feelings_about_pa1 = .data[[paste0("feelings_about_pa1", sufijo)]],
feelings_about_pa2 = .data[[paste0("feelings_about_pa2", sufijo)]],
feelings_about_pa3 = .data[[paste0("feelings_about_pa3", sufijo)]],
pa_guideline = .data[[paste0("pa_guideline", sufijo)]],
crf_means = .data[[paste0("crf_means", sufijo)]],
ms_means = .data[[paste0("ms_means", sufijo)]],
sports_skill = .data[[paste0("sports_skill", sufijo)]],
pa_is = .data[[paste0("pa_is", sufijo)]],
pa_is_also = .data[[paste0("pa_is_also", sufijo)]],
improve = .data[[paste0("improve", sufijo)]],
increase = .data[[paste0("increase", sufijo)]],
when_cooling_down = .data[[paste0("when_cooling_down", sufijo)]],
heart_rate = .data[[paste0("heart_rate", sufijo)]]
) %>%
dplyr::mutate(
gender = dplyr::case_when(
gender %in% c("boy", "b", "male", "m", "masculino", "niño", "nino", "hombre", "1") ~ "boy",
gender %in% c("girl", "g", "female", "f", "femenino", "niña", "nina", "mujer", "0") ~ "girl",
TRUE ~ gender
)
)
}
vars_fisicas_capl <- c(
"pacer_lap_distance", "pacer_laps", "plank_time",
"camsa_skill_score1", "camsa_time1", "camsa_skill_score2", "camsa_time2",
paste0("steps", 1:7), paste0("time_on", 1:7), paste0("time_off", 1:7), paste0("non_wear_time", 1:7)
)
agregar_fisicas_na <- function(df){
for(v in vars_fisicas_capl){
if(!v %in% names(df)) df[[v]] <- NA
}
df
}
capl_ev1 <- crear_base_capl_cuestionario(base_fiabilidad, evaluador = 1) %>% agregar_fisicas_na()
capl_ev2 <- crear_base_capl_cuestionario(base_fiabilidad, evaluador = 2) %>% agregar_fisicas_na()
resultados_capl_ev1 <- capl::get_capl(raw_data = capl_ev1, sort = "asis")
resultados_capl_ev2 <- capl::get_capl(raw_data = capl_ev2, sort = "asis")
vars_scores_cuestionario <- c(
"predilection_score", "adequacy_score", "intrinsic_motivation_score",
"pa_competence_score", "mc_score",
"pa_guideline_score", "crf_means_score", "ms_means_score",
"sports_skill_score", "fill_in_the_blanks_score", "ku_score"
)
scores_ev1 <- resultados_capl_ev1 %>%
dplyr::select(id_estudio, region, dplyr::all_of(vars_scores_cuestionario)) %>%
dplyr::rename_with(~ paste0(.x, "_ev1"), .cols = dplyr::all_of(vars_scores_cuestionario))
scores_ev2 <- resultados_capl_ev2 %>%
dplyr::select(id_estudio, region, dplyr::all_of(vars_scores_cuestionario)) %>%
dplyr::rename_with(~ paste0(.x, "_ev2"), .cols = dplyr::all_of(vars_scores_cuestionario))
base_scores_fiabilidad <- scores_ev1 %>%
dplyr::left_join(scores_ev2, by = c("id_estudio", "region"))
cat("Dimensiones de base de puntajes pareados:\n")
## Dimensiones de base de puntajes pareados:
print(dim(base_scores_fiabilidad))
## [1] 322 24
7. Fiabilidad por
puntajes: ICC, SEM y MDC95
interpretar_icc <- function(icc){
dplyr::case_when(
is.na(icc) ~ "No estimable",
icc < 0.50 ~ "Pobre",
icc >= 0.50 & icc < 0.75 ~ "Moderada",
icc >= 0.75 & icc < 0.90 ~ "Buena",
icc >= 0.90 ~ "Excelente",
TRUE ~ NA_character_
)
}
extraer_icc2 <- function(modelo_icc){
salida <- modelo_icc$results
if(is.null(salida) || nrow(salida) == 0) return(NULL)
salida <- tibble::as_tibble(salida)
icc2 <- salida %>% dplyr::filter(type == "ICC2" | type == "Single_random_raters")
if(nrow(icc2) == 0) return(NULL)
icc2[1, ]
}
calcular_icc_score <- function(df, score){
var1 <- paste0(score, "_ev1")
var2 <- paste0(score, "_ev2")
datos <- df %>% dplyr::select(dplyr::all_of(c(var1, var2))) %>% tidyr::drop_na()
n <- nrow(datos)
if(n < 10){
return(tibble::tibble(score = score, n = n, media_ev1 = NA_real_, media_ev2 = NA_real_, de_ev1 = NA_real_, de_ev2 = NA_real_, diferencia_media = NA_real_, icc = NA_real_, ic95_inf = NA_real_, ic95_sup = NA_real_, p = NA_real_, metodo_icc = "No estimado: menos de 10 pares"))
}
media_ev1 <- mean(datos[[var1]], na.rm = TRUE)
media_ev2 <- mean(datos[[var2]], na.rm = TRUE)
de_ev1 <- sd(datos[[var1]], na.rm = TRUE)
de_ev2 <- sd(datos[[var2]], na.rm = TRUE)
diferencia_media <- mean(datos[[var1]] - datos[[var2]], na.rm = TRUE)
if(is.na(de_ev1) || is.na(de_ev2) || de_ev1 == 0 || de_ev2 == 0){
return(tibble::tibble(score = score, n = n, media_ev1 = media_ev1, media_ev2 = media_ev2, de_ev1 = de_ev1, de_ev2 = de_ev2, diferencia_media = diferencia_media, icc = NA_real_, ic95_inf = NA_real_, ic95_sup = NA_real_, p = NA_real_, metodo_icc = "No estimable: varianza insuficiente"))
}
modelo_1 <- tryCatch(psych::ICC(datos), error = function(e) e)
if(!inherits(modelo_1, "error")){
icc2 <- extraer_icc2(modelo_1)
if(!is.null(icc2)){
return(tibble::tibble(score = score, n = n, media_ev1 = media_ev1, media_ev2 = media_ev2, de_ev1 = de_ev1, de_ev2 = de_ev2, diferencia_media = diferencia_media, icc = icc2$ICC, ic95_inf = icc2$`lower bound`, ic95_sup = icc2$`upper bound`, p = icc2$p, metodo_icc = "psych::ICC"))
}
}
modelo_2 <- tryCatch(psych::ICC(datos, lmer = FALSE), error = function(e) e)
if(!inherits(modelo_2, "error")){
icc2 <- extraer_icc2(modelo_2)
if(!is.null(icc2)){
return(tibble::tibble(score = score, n = n, media_ev1 = media_ev1, media_ev2 = media_ev2, de_ev1 = de_ev1, de_ev2 = de_ev2, diferencia_media = diferencia_media, icc = icc2$ICC, ic95_inf = icc2$`lower bound`, ic95_sup = icc2$`upper bound`, p = icc2$p, metodo_icc = "psych::ICC, lmer = FALSE"))
}
}
tibble::tibble(score = score, n = n, media_ev1 = media_ev1, media_ev2 = media_ev2, de_ev1 = de_ev1, de_ev2 = de_ev2, diferencia_media = diferencia_media, icc = NA_real_, ic95_inf = NA_real_, ic95_sup = NA_real_, p = NA_real_, metodo_icc = "No estimable por problema numérico")
}
calcular_sem_mdc_score <- function(df, score, tabla_icc){
var1 <- paste0(score, "_ev1")
var2 <- paste0(score, "_ev2")
datos <- df %>% dplyr::select(dplyr::all_of(c(var1, var2))) %>% tidyr::drop_na()
icc_valor <- tabla_icc %>% dplyr::filter(score == !!score) %>% dplyr::pull(icc)
if(length(icc_valor) == 0 || is.na(icc_valor)){
return(tibble::tibble(score = score, sem = NA_real_, mdc95 = NA_real_))
}
sd_pooled <- sd(c(datos[[var1]], datos[[var2]]), na.rm = TRUE)
sem <- sd_pooled * sqrt(1 - icc_valor)
mdc95 <- sem * 1.96 * sqrt(2)
tibble::tibble(score = score, sem = sem, mdc95 = mdc95)
}
tabla_icc_scores <- dplyr::bind_rows(lapply(vars_scores_cuestionario, function(x) calcular_icc_score(base_scores_fiabilidad, x))) %>%
dplyr::mutate(
dplyr::across(c(media_ev1, media_ev2, de_ev1, de_ev2, diferencia_media, icc, ic95_inf, ic95_sup, p), ~ round(.x, 3)),
interpretacion = interpretar_icc(icc)
)
tabla_sem_mdc <- dplyr::bind_rows(lapply(vars_scores_cuestionario, function(x) calcular_sem_mdc_score(base_scores_fiabilidad, x, tabla_icc_scores))) %>%
dplyr::mutate(sem = round(sem, 3), mdc95 = round(mdc95, 3))
tabla_scores_final <- tabla_icc_scores %>%
dplyr::left_join(tabla_sem_mdc, by = "score")
etiquetar_score <- function(x){
dplyr::case_when(
x == "predilection_score" ~ "Predilección",
x == "adequacy_score" ~ "Adecuación",
x == "intrinsic_motivation_score" ~ "Motivación intrínseca",
x == "pa_competence_score" ~ "Competencia percibida",
x == "mc_score" ~ "Motivación y confianza",
x == "pa_guideline_score" ~ "Guía de actividad física",
x == "crf_means_score" ~ "Aptitud cardiorrespiratoria",
x == "ms_means_score" ~ "Fuerza/resistencia muscular",
x == "sports_skill_score" ~ "Habilidad deportiva",
x == "fill_in_the_blanks_score" ~ "Completar espacios",
x == "ku_score" ~ "Conocimiento y comprensión",
TRUE ~ x
)
}
tabla_scores_apa_ic95 <- tabla_scores_final %>%
dplyr::mutate(
Puntaje = etiquetar_score(score),
`IC95% ICC` = paste0("[", round(ic95_inf, 3), ", ", round(ic95_sup, 3), "]"),
p = dplyr::case_when(is.na(p) ~ NA_character_, p < .001 ~ "< .001", TRUE ~ sprintf("%.3f", p))
) %>%
dplyr::transmute(
Puntaje,
n,
`Media EV1` = round(media_ev1, 2),
`Media EV2` = round(media_ev2, 2),
`Diferencia media` = round(diferencia_media, 2),
ICC = round(icc, 3),
`IC95% ICC`,
SEM = round(sem, 2),
MDC95 = round(mdc95, 2),
p,
Interpretación = interpretacion
)
knitr::kable(tabla_scores_apa_ic95, caption = "Fiabilidad interevaluador por puntajes derivados")
Fiabilidad interevaluador por puntajes derivados
| Predilección |
322 |
5.15 |
6.03 |
-0.88 |
0.420 |
[0.216, 0.568] |
1.25 |
3.45 |
< .001 |
Pobre |
| Adecuación |
322 |
5.31 |
5.25 |
0.06 |
0.603 |
[0.528, 0.668] |
1.07 |
2.96 |
< .001 |
Moderada |
| Motivación intrínseca |
322 |
5.62 |
5.97 |
-0.35 |
0.755 |
[0.667, 0.817] |
0.72 |
2.00 |
< .001 |
Buena |
| Competencia percibida |
322 |
5.28 |
5.68 |
-0.40 |
0.746 |
[0.639, 0.817] |
0.74 |
2.07 |
< .001 |
Moderada |
| Motivación y confianza |
322 |
21.68 |
23.00 |
-1.32 |
0.756 |
[0.619, 0.835] |
2.17 |
6.01 |
< .001 |
Buena |
| Guía de actividad física |
322 |
0.30 |
0.60 |
-0.30 |
0.329 |
[0.136, 0.481] |
0.41 |
1.13 |
< .001 |
Pobre |
| Aptitud cardiorrespiratoria |
322 |
0.42 |
0.47 |
-0.05 |
0.373 |
[0.276, 0.463] |
0.39 |
1.09 |
< .001 |
Pobre |
| Fuerza/resistencia muscular |
322 |
0.41 |
0.47 |
-0.06 |
0.330 |
[0.229, 0.423] |
0.41 |
1.13 |
< .001 |
Pobre |
| Habilidad deportiva |
322 |
0.33 |
0.63 |
-0.30 |
0.368 |
[0.154, 0.528] |
0.40 |
1.10 |
< .001 |
Pobre |
| Completar espacios |
319 |
2.82 |
4.58 |
-1.76 |
0.078 |
[-0.035, 0.191] |
1.57 |
4.36 |
0.006 |
Pobre |
| Conocimiento y comprensión |
322 |
4.29 |
6.77 |
-2.48 |
0.206 |
[-0.046, 0.418] |
2.18 |
6.05 |
< .001 |
Pobre |
8. Bland-Altman
calcular_bland_altman_ic95 <- function(df, score){
var1 <- paste0(score, "_ev1")
var2 <- paste0(score, "_ev2")
datos <- df %>%
dplyr::select(dplyr::all_of(c(var1, var2))) %>%
tidyr::drop_na() %>%
dplyr::mutate(media = (.data[[var1]] + .data[[var2]]) / 2, diferencia = .data[[var1]] - .data[[var2]])
n <- nrow(datos)
sesgo <- mean(datos$diferencia)
sd_dif <- sd(datos$diferencia)
se_sesgo <- sd_dif / sqrt(n)
loa_inf <- sesgo - 1.96 * sd_dif
loa_sup <- sesgo + 1.96 * sd_dif
se_loa <- sqrt((sd_dif^2 / n) + ((1.96^2 * sd_dif^2) / (2 * (n - 1))))
tibble::tibble(
score = score,
n = n,
sesgo = sesgo,
sesgo_ic95_inf = sesgo - 1.96 * se_sesgo,
sesgo_ic95_sup = sesgo + 1.96 * se_sesgo,
loa_inf = loa_inf,
loa_inf_ic95_inf = loa_inf - 1.96 * se_loa,
loa_inf_ic95_sup = loa_inf + 1.96 * se_loa,
loa_sup = loa_sup,
loa_sup_ic95_inf = loa_sup - 1.96 * se_loa,
loa_sup_ic95_sup = loa_sup + 1.96 * se_loa
)
}
tabla_bland_altman_ic95 <- dplyr::bind_rows(
calcular_bland_altman_ic95(base_scores_fiabilidad, "mc_score"),
calcular_bland_altman_ic95(base_scores_fiabilidad, "ku_score")
) %>%
dplyr::mutate(
Puntaje = etiquetar_score(score),
dplyr::across(where(is.numeric), ~ round(.x, 2)),
`IC95% sesgo` = paste0("[", sesgo_ic95_inf, ", ", sesgo_ic95_sup, "]"),
`IC95% límite inferior` = paste0("[", loa_inf_ic95_inf, ", ", loa_inf_ic95_sup, "]"),
`IC95% límite superior` = paste0("[", loa_sup_ic95_inf, ", ", loa_sup_ic95_sup, "]")
) %>%
dplyr::transmute(
Puntaje,
n,
Sesgo = sesgo,
`IC95% sesgo`,
`Límite inferior` = loa_inf,
`IC95% límite inferior`,
`Límite superior` = loa_sup,
`IC95% límite superior`
)
knitr::kable(tabla_bland_altman_ic95, caption = "Análisis de Bland-Altman")
Análisis de Bland-Altman
| Motivación y confianza |
322 |
-1.32 |
[-1.63, -1.01] |
-6.84 |
[-7.37, -6.31] |
4.20 |
[3.67, 4.72] |
| Conocimiento y comprensión |
322 |
-2.48 |
[-2.74, -2.21] |
-7.21 |
[-7.66, -6.76] |
2.25 |
[1.8, 2.71] |
crear_figura_ba <- function(df, score, titulo){
var1 <- paste0(score, "_ev1")
var2 <- paste0(score, "_ev2")
datos <- df %>%
dplyr::select(dplyr::all_of(c(var1, var2))) %>%
tidyr::drop_na() %>%
dplyr::mutate(media = (.data[[var1]] + .data[[var2]]) / 2, diferencia = .data[[var1]] - .data[[var2]])
sesgo <- mean(datos$diferencia)
sd_dif <- sd(datos$diferencia)
loa_inf <- sesgo - 1.96 * sd_dif
loa_sup <- sesgo + 1.96 * sd_dif
ggplot2::ggplot(datos, ggplot2::aes(x = media, y = diferencia)) +
ggplot2::geom_point(alpha = 0.55, size = 1.7) +
ggplot2::geom_hline(yintercept = sesgo, linewidth = 0.6) +
ggplot2::geom_hline(yintercept = loa_inf, linetype = "dashed", linewidth = 0.5) +
ggplot2::geom_hline(yintercept = loa_sup, linetype = "dashed", linewidth = 0.5) +
ggplot2::labs(title = titulo, x = "Media entre evaluadores", y = "Diferencia (EV1 − EV2)") +
ggplot2::theme_classic(base_size = 11)
}
crear_figura_ba(base_scores_fiabilidad, "mc_score", "Bland-Altman: Motivación y confianza")

crear_figura_ba(base_scores_fiabilidad, "ku_score", "Bland-Altman: Conocimiento y comprensión")

9. CAPL-2 completo en
evaluación 1
preparar_capl_completo <- function(df){
df <- df %>% dplyr::mutate(dplyr::across(dplyr::everything(), as.character))
df <- corregir_nombres_capl(df)
df <- asegurar_variables(df, c(
"age", "gender", "pacer_lap_distance", "pacer_laps", "plank_time",
"camsa_skill_score1", "camsa_time1", "camsa_skill_score2", "camsa_time2",
paste0("steps", 1:7), paste0("time_on", 1:7), paste0("time_off", 1:7), paste0("non_wear_time", 1:7),
"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"
))
vars_numericas_capl <- c(
"age", "pacer_lap_distance", "pacer_laps", "plank_time",
"camsa_skill_score1", "camsa_time1", "camsa_skill_score2", "camsa_time2",
paste0("steps", 1:7), paste0("non_wear_time", 1:7),
"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"
)
vars_horarios_capl <- c(paste0("time_on", 1:7), paste0("time_off", 1:7))
df <- df %>%
dplyr::mutate(
dplyr::across(dplyr::any_of(vars_numericas_capl), limpiar_numero),
dplyr::across(dplyr::any_of(vars_horarios_capl), limpiar_hora),
gender = stringr::str_to_lower(as.character(gender)),
gender = dplyr::case_when(
gender %in% c("boy", "b", "male", "m", "masculino", "niño", "nino", "hombre", "1") ~ "boy",
gender %in% c("girl", "g", "female", "f", "femenino", "niña", "nina", "mujer", "0") ~ "girl",
TRUE ~ gender
)
)
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)
df[[non_var]] <- ifelse(!is.na(df[[steps_var]]) & !is.na(df[[on_var]]) & !is.na(df[[off_var]]) & is.na(df[[non_var]]), 0, df[[non_var]])
df[[steps_var]] <- ifelse(df[[steps_var]] < 1000 | df[[steps_var]] > 30000, NA, df[[steps_var]])
}
df <- df %>%
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)
)
df
}
base_capl_completa_m1 <- dplyr::bind_rows(
amz_m1 %>% dplyr::mutate(region = "Centro sur-Amazonía"),
eje_m1 %>% dplyr::mutate(region = "Eje cafetero-Antioquia")
) %>% preparar_capl_completo()
resultados_capl_completo_m1 <- capl::get_capl(raw_data = base_capl_completa_m1, sort = "asis")
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_, ic95_inf = NA_real_, ic95_sup = NA_real_))
}
media <- mean(x)
de <- sd(x)
se <- de / sqrt(n)
tcrit <- stats::qt(0.975, df = n - 1)
tibble::tibble(n = n, media = media, de = de, ic95_inf = media - tcrit * se, ic95_sup = media + tcrit * se)
}
crear_fila_descriptiva <- function(data, dominio, variable, status_var, max_teorico){
x <- data %>% dplyr::filter(.data[[status_var]] == "complete") %>% dplyr::pull(.data[[variable]])
media_ic95(x) %>%
dplyr::mutate(Dominio = dominio, Variable = variable, max_teorico = max_teorico, mediana = stats::median(x, na.rm = TRUE), min = min(x, na.rm = TRUE), max = max(x, na.rm = TRUE), porcentaje_maximo = media / max_teorico * 100)
}
tabla_descriptiva_capl_ic95 <- dplyr::bind_rows(
crear_fila_descriptiva(resultados_capl_completo_m1, "Competencia física", "pc_score", "pc_status", 30),
crear_fila_descriptiva(resultados_capl_completo_m1, "Comportamiento diario", "db_score", "db_status", 30),
crear_fila_descriptiva(resultados_capl_completo_m1, "Motivación y confianza", "mc_score", "mc_status", 30),
crear_fila_descriptiva(resultados_capl_completo_m1, "Conocimiento y comprensión", "ku_score", "ku_status", 10),
crear_fila_descriptiva(resultados_capl_completo_m1, "CAPL total", "capl_score", "capl_status", 100)
) %>%
dplyr::mutate(
dplyr::across(c(media, de, ic95_inf, ic95_sup, mediana, min, max, porcentaje_maximo), ~ round(.x, 2)),
`Media (DE)` = paste0(media, " (", de, ")"),
`IC95%` = paste0("[", ic95_inf, ", ", ic95_sup, "]"),
`Rango observado` = paste0(min, "–", max)
) %>%
dplyr::select(Dominio, Variable, `Máximo teórico` = max_teorico, n, `Media (DE)`, `IC95%`, Mediana = mediana, `Rango observado`, `% del máximo` = porcentaje_maximo)
knitr::kable(tabla_descriptiva_capl_ic95, caption = "Descripción de dominios del CAPL-2 completo en evaluación 1")
Descripción de dominios del CAPL-2 completo en evaluación
1
| Competencia física |
pc_score |
30 |
320 |
13.59 (6.31) |
[12.9, 14.29] |
13.25 |
1.5–30 |
45.31 |
| Comportamiento diario |
db_score |
30 |
291 |
14.37 (6.76) |
[13.59, 15.15] |
14.00 |
2–30 |
47.92 |
| Motivación y confianza |
mc_score |
30 |
322 |
21.68 (4.32) |
[21.2, 22.15] |
20.70 |
12.8–30 |
72.26 |
| Conocimiento y comprensión |
ku_score |
10 |
319 |
4.28 (2.13) |
[4.04, 4.51] |
4.00 |
0–10 |
42.79 |
| CAPL total |
capl_score |
100 |
291 |
54.84 (13.56) |
[53.28, 56.41] |
54.30 |
25.2–91.1 |
54.84 |