1 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.

2 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)

3 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

4 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

5 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
item n_total n_completo n_incompleto porcentaje_completo
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

6 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
Ítem n Media EV1 Media EV2 Diferencia media Acuerdo exacto (%) Tipo de κ κ IC95% κ Interpretación
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

7 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

8 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
Puntaje n Media EV1 Media EV2 Diferencia media ICC IC95% ICC SEM MDC95 p Interpretación
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

9 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
Puntaje n Sesgo IC95% sesgo Límite inferior IC95% límite inferior Límite superior IC95% límite superior
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")

10 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
Dominio Variable Máximo teórico n Media (DE) IC95% Mediana Rango observado % del máximo
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

11 10. 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] capl_1.42      knitr_1.50     purrr_1.1.0    tibble_3.3.0   ggplot2_4.0.1 
##  [6] irr_0.84.1     lpSolve_5.6.23 psych_2.5.6    janitor_2.2.1  stringr_1.5.1 
## [11] tidyr_1.3.1    dplyr_1.2.0    writexl_1.5.4  readxl_1.4.5  
## 
## loaded via a namespace (and not attached):
##  [1] utf8_1.2.6         sass_0.4.10        generics_0.1.4     stringi_1.8.7     
##  [5] lattice_0.22-7     lme4_1.1-37        digest_0.6.37      magrittr_2.0.3    
##  [9] evaluate_1.0.4     grid_4.5.1         timechange_0.3.0   RColorBrewer_1.1-3
## [13] fastmap_1.2.0      Matrix_1.7-3       cellranger_1.1.0   jsonlite_2.0.0    
## [17] scales_1.4.0       jquerylib_0.1.4    Rdpack_2.6.4       reformulas_0.4.4  
## [21] mnormt_2.1.1       cli_3.6.6          rlang_1.2.0        rbibutils_2.3     
## [25] splines_4.5.1      withr_3.0.2        cachem_1.1.0       yaml_2.3.10       
## [29] tools_4.5.1        parallel_4.5.1     nloptr_2.2.1       minqa_1.2.8       
## [33] boot_1.3-31        vctrs_0.7.1        R6_2.6.1           lifecycle_1.0.5   
## [37] lubridate_1.9.4    snakecase_0.11.1   MASS_7.3-65        pkgconfig_2.0.3   
## [41] pillar_1.11.0      bslib_0.9.0        gtable_0.3.6       Rcpp_1.1.0        
## [45] glue_1.8.0         xfun_0.55          tidyselect_1.2.1   rstudioapi_0.17.1 
## [49] farver_2.1.2       htmltools_0.5.8.1  nlme_3.1-168       labeling_0.4.3    
## [53] rmarkdown_2.29     compiler_4.5.1     S7_0.2.1