CAPL-2 versión Colombia: análisis reproducible de confiabilidad interevaluador
Código definitivo para RPubs y depósito en repositorio
Equipo de investigación
09/09/2026
1 Propósito
Este documento reproduce los análisis definitivos de confiabilidad interevaluador de los componentes de cuestionario del CAPL-2 versión Colombia.
El análisis se realizó en una muestra pareada de 322 escolares, con dos aplicaciones de los cuestionarios correspondientes a:
- Motivación y confianza.
- Conocimiento y comprensión.
El flujo reproduce:
- disponibilidad de pares;
- acuerdo exacto por reactivo;
- kappa ponderado cuadrático para los reactivos ordinales de Motivación y confianza;
- kappa simple de Cohen para los reactivos de Conocimiento y comprensión;
- coeficiente de correlación intraclase ICC(2,1), modelo de dos vías, efectos aleatorios, acuerdo absoluto y medición única;
- error estándar de medición (SEM);
- cambio mínimo detectable al 95 % (MDC95);
- análisis de Bland–Altman para los puntajes totales de ambos dominios;
- evaluación del sesgo proporcional.
Los archivos de entrada corresponden a los checkpoints definitivos auditados generados durante la construcción de la base de confiabilidad.
2 1. Entorno reproducible
paquetes <- c(
"dplyr",
"tidyr",
"tibble",
"purrr",
"irr",
"ggplot2",
"knitr"
)
faltantes <- paquetes[
!vapply(paquetes, requireNamespace, logical(1), quietly = TRUE)
]
if (length(faltantes) > 0) {
stop(
paste0(
"Instale antes de continuar: ",
paste(faltantes, collapse = ", ")
)
)
}
library(dplyr)
library(tidyr)
library(tibble)
library(purrr)
library(irr)
library(ggplot2)
library(knitr)
set.seed(20260906)3 2. Lectura de las bases definitivas
ruta_items <- params$base_items_rds
ruta_scores <- params$base_scores_rds
if (!file.exists(ruta_items)) {
stop(
paste0(
"No se encontró: ", ruta_items, "\n",
"Ubique el Rmd en la carpeta principal del proyecto, ",
"de modo que exista la subcarpeta 'Resultados_definitivos'."
)
)
}
if (!file.exists(ruta_scores)) {
stop(
paste0(
"No se encontró: ", ruta_scores, "\n",
"Ubique el Rmd en la carpeta principal del proyecto, ",
"de modo que exista la subcarpeta 'Resultados_definitivos'."
)
)
}
base_fiabilidad_pareada <- readRDS(ruta_items)
base_scores_fiabilidad <- readRDS(ruta_scores)
cat("Base de reactivos pareados:", dim(base_fiabilidad_pareada), "\n")## Base de reactivos pareados: 322 53cat("Base de puntajes pareados:", dim(base_scores_fiabilidad), "\n")## Base de puntajes pareados: 322 234 3. Auditoría inicial
if (nrow(base_fiabilidad_pareada) != 322) {
stop("La base de reactivos pareados no contiene 322 participantes.")
}
if (nrow(base_scores_fiabilidad) != 322) {
stop("La base de puntajes pareados no contiene 322 participantes.")
}
if ("id_nacional" %in% names(base_fiabilidad_pareada)) {
if (dplyr::n_distinct(base_fiabilidad_pareada$id_nacional) != 322) {
stop("Los identificadores de la base de reactivos no son únicos.")
}
}
if ("id_nacional" %in% names(base_scores_fiabilidad)) {
if (dplyr::n_distinct(base_scores_fiabilidad$id_nacional) != 322) {
stop("Los identificadores de la base de puntajes no son únicos.")
}
}
cat("Auditoría inicial superada: 322 registros pareados.\n")## Auditoría inicial superada: 322 registros pareados.5 4. Reactivos incluidos
vars_mc <- c(
"csappa1",
"csappa2",
"csappa3",
"csappa4",
"csappa5",
"csappa6",
"why_active1",
"why_active2",
"why_active3",
"feelings_about_pa1",
"feelings_about_pa2",
"feelings_about_pa3"
)
vars_ku <- c(
"pa_guideline",
"crf_means",
"ms_means",
"sports_skill",
"pa_is",
"pa_is_also",
"improve",
"increase",
"when_cooling_down",
"heart_rate"
)
vars_items <- c(vars_mc, vars_ku)
extraer_columna <- function(df, nombre) {
if (!nombre %in% names(df)) {
stop(paste("No existe la variable:", nombre))
}
suppressWarnings(as.numeric(as.character(df[[nombre]])))
}
variables_pareadas_requeridas <- c(
paste0(vars_items, "_m1"),
paste0(vars_items, "_m2")
)
faltan <- setdiff(
variables_pareadas_requeridas,
names(base_fiabilidad_pareada)
)
if (length(faltan) > 0) {
stop(
paste(
"Faltan variables pareadas:",
paste(faltan, collapse = ", ")
)
)
}6 5. Disponibilidad de pares por reactivo
disponibilidad_pares <- purrr::map_dfr(
vars_items,
function(v) {
x1 <- extraer_columna(
base_fiabilidad_pareada,
paste0(v, "_m1")
)
x2 <- extraer_columna(
base_fiabilidad_pareada,
paste0(v, "_m2")
)
completos <- !is.na(x1) & !is.na(x2)
tibble(
variable = v,
pares_completos = sum(completos),
pares_incompletos = sum(!completos),
porcentaje_completo = 100 * mean(completos)
)
}
)
knitr::kable(
disponibilidad_pares,
digits = 1,
caption = "Disponibilidad de pares completos por reactivo"
)| variable | pares_completos | pares_incompletos | porcentaje_completo |
|---|---|---|---|
| csappa1 | 322 | 0 | 100.0 |
| csappa2 | 322 | 0 | 100.0 |
| csappa3 | 322 | 0 | 100.0 |
| csappa4 | 322 | 0 | 100.0 |
| csappa5 | 322 | 0 | 100.0 |
| csappa6 | 322 | 0 | 100.0 |
| why_active1 | 322 | 0 | 100.0 |
| why_active2 | 322 | 0 | 100.0 |
| why_active3 | 322 | 0 | 100.0 |
| feelings_about_pa1 | 322 | 0 | 100.0 |
| feelings_about_pa2 | 322 | 0 | 100.0 |
| feelings_about_pa3 | 322 | 0 | 100.0 |
| pa_guideline | 322 | 0 | 100.0 |
| crf_means | 322 | 0 | 100.0 |
| ms_means | 322 | 0 | 100.0 |
| sports_skill | 322 | 0 | 100.0 |
| pa_is | 322 | 0 | 100.0 |
| pa_is_also | 322 | 0 | 100.0 |
| improve | 319 | 3 | 99.1 |
| increase | 322 | 0 | 100.0 |
| when_cooling_down | 322 | 0 | 100.0 |
| heart_rate | 321 | 1 | 99.7 |
7 6. Kappa ponderado cuadrático: Motivación y confianza
Los reactivos de Motivación y confianza presentan categorías ordinales. Se empleó kappa ponderado cuadrático y se estimaron intervalos de confianza del 95 % mediante 2.000 remuestras bootstrap.
kappa_cuadratico <- function(x, y, categorias) {
completos <- complete.cases(x, y)
x <- as.numeric(x[completos])
y <- as.numeric(y[completos])
k <- length(categorias)
tabla <- table(
factor(x, levels = categorias),
factor(y, levels = categorias)
)
n <- sum(tabla)
if (n == 0) {
return(NA_real_)
}
indices <- seq_len(k)
pesos <- outer(
indices,
indices,
FUN = function(i, j) {
1 - ((i - j) / (k - 1))^2
}
)
po <- sum(pesos * tabla) / n
marginal_x <- rowSums(tabla)
marginal_y <- colSums(tabla)
esperada <- outer(
marginal_x,
marginal_y
) / n
pe <- sum(pesos * esperada) / n
if (abs(1 - pe) < 1e-12) {
return(NA_real_)
}
(po - pe) / (1 - pe)
}
interpretar_kappa <- function(k) {
dplyr::case_when(
is.na(k) ~ "No estimable",
k < 0 ~ "Menor que azar",
k < 0.21 ~ "Ligera",
k < 0.41 ~ "Aceptable",
k < 0.61 ~ "Moderada",
k < 0.81 ~ "Sustancial",
TRUE ~ "Casi perfecta"
)
}
analizar_item_kappa <- function(
df,
variable,
categorias,
B = 2000
) {
x <- extraer_columna(
df,
paste0(variable, "_m1")
)
y <- extraer_columna(
df,
paste0(variable, "_m2")
)
completos <- complete.cases(x, y)
x <- x[completos]
y <- y[completos]
n <- length(x)
acuerdo_exacto <- mean(x == y) * 100
kappa <- kappa_cuadratico(
x,
y,
categorias
)
kappas_boot <- replicate(
B,
{
idx <- sample(
seq_len(n),
size = n,
replace = TRUE
)
kappa_cuadratico(
x[idx],
y[idx],
categorias
)
}
)
kappas_boot <- kappas_boot[
is.finite(kappas_boot)
]
ic <- quantile(
kappas_boot,
probs = c(0.025, 0.975),
na.rm = TRUE,
names = FALSE
)
tibble(
variable = variable,
n = n,
acuerdo_exacto = acuerdo_exacto,
kappa = kappa,
ic95_inf = ic[1],
ic95_sup = ic[2],
interpretacion = interpretar_kappa(kappa)
)
}set.seed(20260906)
resultados_kappa_mc <- purrr::map_dfr(
vars_mc,
function(v) {
if (grepl("^csappa", v)) {
categorias <- 1:4
} else {
categorias <- 1:5
}
analizar_item_kappa(
df = base_fiabilidad_pareada,
variable = v,
categorias = categorias,
B = 2000
)
}
) %>%
mutate(
subcomponente = case_when(
variable %in% c("csappa1", "csappa3", "csappa5") ~
"Predilección",
variable %in% c("csappa2", "csappa4", "csappa6") ~
"Adecuación",
variable %in% c(
"why_active1",
"why_active2",
"why_active3"
) ~
"Motivación intrínseca",
variable %in% c(
"feelings_about_pa1",
"feelings_about_pa2",
"feelings_about_pa3"
) ~
"Competencia percibida",
TRUE ~ NA_character_
)
) %>%
select(
subcomponente,
variable,
n,
acuerdo_exacto,
kappa,
ic95_inf,
ic95_sup,
interpretacion
)
knitr::kable(
resultados_kappa_mc,
digits = 3,
caption = "Confiabilidad interevaluador por reactivo de Motivación y confianza"
)| subcomponente | variable | n | acuerdo_exacto | kappa | ic95_inf | ic95_sup | interpretacion |
|---|---|---|---|---|---|---|---|
| Predilección | csappa1 | 322 | 82.30 | 0.908 | 0.884 | 0.930 | Casi perfecta |
| Adecuación | csappa2 | 322 | 84.47 | 0.924 | 0.901 | 0.944 | Casi perfecta |
| Predilección | csappa3 | 322 | 83.54 | 0.915 | 0.891 | 0.937 | Casi perfecta |
| Adecuación | csappa4 | 322 | 84.47 | 0.928 | 0.907 | 0.947 | Casi perfecta |
| Predilección | csappa5 | 322 | 81.99 | 0.901 | 0.875 | 0.926 | Casi perfecta |
| Adecuación | csappa6 | 322 | 85.40 | 0.934 | 0.912 | 0.952 | Casi perfecta |
| Motivación intrínseca | why_active1 | 322 | 86.65 | 0.913 | 0.870 | 0.947 | Casi perfecta |
| Motivación intrínseca | why_active2 | 322 | 85.40 | 0.945 | 0.923 | 0.963 | Casi perfecta |
| Motivación intrínseca | why_active3 | 322 | 84.16 | 0.925 | 0.890 | 0.954 | Casi perfecta |
| Competencia percibida | feelings_about_pa1 | 322 | 82.61 | 0.913 | 0.874 | 0.944 | Casi perfecta |
| Competencia percibida | feelings_about_pa2 | 322 | 80.12 | 0.895 | 0.850 | 0.930 | Casi perfecta |
| Competencia percibida | feelings_about_pa3 | 322 | 77.33 | 0.916 | 0.882 | 0.941 | Casi perfecta |
resumen_kappa_mc <- resultados_kappa_mc %>%
summarise(
n_items = n(),
n_min = min(n),
n_max = max(n),
acuerdo_min = min(acuerdo_exacto),
acuerdo_max = max(acuerdo_exacto),
kappa_min = min(kappa),
kappa_max = max(kappa)
)
knitr::kable(
resumen_kappa_mc,
digits = 3,
caption = "Resumen de acuerdo de los reactivos de Motivación y confianza"
)| n_items | n_min | n_max | acuerdo_min | acuerdo_max | kappa_min | kappa_max |
|---|---|---|---|---|---|---|
| 12 | 322 | 322 | 77.33 | 86.65 | 0.895 | 0.945 |
8 7. Kappa simple: Conocimiento y comprensión
Para los reactivos de Conocimiento y comprensión se empleó kappa simple de Cohen, con intervalos de confianza del 95 % mediante 2.000 remuestras bootstrap.
kappa_simple <- function(x, y, categorias) {
completos <- complete.cases(x, y)
x <- as.numeric(x[completos])
y <- as.numeric(y[completos])
tabla <- table(
factor(x, levels = categorias),
factor(y, levels = categorias)
)
n <- sum(tabla)
if (n == 0) {
return(NA_real_)
}
po <- sum(diag(tabla)) / n
px <- rowSums(tabla) / n
py <- colSums(tabla) / n
pe <- sum(px * py)
if (abs(1 - pe) < 1e-12) {
return(NA_real_)
}
(po - pe) / (1 - pe)
}
analizar_item_kappa_simple <- function(
df,
variable,
categorias,
B = 2000
) {
x <- extraer_columna(
df,
paste0(variable, "_m1")
)
y <- extraer_columna(
df,
paste0(variable, "_m2")
)
completos <- complete.cases(x, y)
x <- x[completos]
y <- y[completos]
n <- length(x)
acuerdo_exacto <- mean(x == y) * 100
kappa <- kappa_simple(
x,
y,
categorias
)
kappas_boot <- replicate(
B,
{
idx <- sample(
seq_len(n),
size = n,
replace = TRUE
)
kappa_simple(
x[idx],
y[idx],
categorias
)
}
)
kappas_boot <- kappas_boot[
is.finite(kappas_boot)
]
ic <- quantile(
kappas_boot,
probs = c(0.025, 0.975),
na.rm = TRUE,
names = FALSE
)
tibble(
variable = variable,
n = n,
acuerdo_exacto = acuerdo_exacto,
kappa = kappa,
ic95_inf = ic[1],
ic95_sup = ic[2],
interpretacion = interpretar_kappa(kappa)
)
}set.seed(20260906)
resultados_kappa_ku <- purrr::map_dfr(
vars_ku,
function(v) {
if (
v %in% c(
"pa_guideline",
"crf_means",
"ms_means",
"sports_skill"
)
) {
categorias <- 1:4
} else {
categorias <- 1:10
}
analizar_item_kappa_simple(
df = base_fiabilidad_pareada,
variable = v,
categorias = categorias,
B = 2000
)
}
) %>%
mutate(
item = case_when(
variable == "pa_guideline" ~
"Recomendación diaria de actividad física",
variable == "crf_means" ~
"Concepto de aptitud cardiorrespiratoria",
variable == "ms_means" ~
"Concepto de fuerza y resistencia muscular",
variable == "sports_skill" ~
"Concepto de habilidad deportiva",
variable == "pa_is" ~
"Definición de actividad física",
variable == "pa_is_also" ~
"Componentes de la actividad física",
variable == "improve" ~
"Estrategias para mejorar la condición física",
variable == "increase" ~
"Estrategias para aumentar la actividad física",
variable == "when_cooling_down" ~
"Función del enfriamiento",
variable == "heart_rate" ~
"Reconocimiento de la frecuencia cardiaca",
TRUE ~ variable
)
) %>%
select(
item,
variable,
n,
acuerdo_exacto,
kappa,
ic95_inf,
ic95_sup,
interpretacion
)
knitr::kable(
resultados_kappa_ku,
digits = 3,
caption = "Confiabilidad interevaluador por reactivo de Conocimiento y comprensión"
)| item | variable | n | acuerdo_exacto | kappa | ic95_inf | ic95_sup | interpretacion |
|---|---|---|---|---|---|---|---|
| Recomendación diaria de actividad física | pa_guideline | 322 | 61.18 | 0.462 | 0.388 | 0.537 | Moderada |
| Concepto de aptitud cardiorrespiratoria | crf_means | 322 | 66.46 | 0.539 | 0.468 | 0.606 | Moderada |
| Concepto de fuerza y resistencia muscular | ms_means | 322 | 66.46 | 0.535 | 0.464 | 0.605 | Moderada |
| Concepto de habilidad deportiva | sports_skill | 322 | 62.42 | 0.483 | 0.414 | 0.551 | Moderada |
| Definición de actividad física | pa_is | 322 | 74.53 | 0.653 | 0.581 | 0.719 | Sustancial |
| Componentes de la actividad física | pa_is_also | 322 | 71.74 | 0.602 | 0.532 | 0.670 | Moderada |
| Estrategias para mejorar la condición física | improve | 319 | 56.11 | 0.338 | 0.266 | 0.404 | Aceptable |
| Estrategias para aumentar la actividad física | increase | 322 | 59.94 | 0.408 | 0.333 | 0.481 | Aceptable |
| Función del enfriamiento | when_cooling_down | 322 | 59.63 | 0.410 | 0.339 | 0.480 | Moderada |
| Reconocimiento de la frecuencia cardiaca | heart_rate | 321 | 49.22 | 0.314 | 0.251 | 0.380 | Aceptable |
resumen_kappa_ku <- resultados_kappa_ku %>%
summarise(
n_items = n(),
n_min = min(n),
n_max = max(n),
acuerdo_min = min(acuerdo_exacto),
acuerdo_max = max(acuerdo_exacto),
kappa_min = min(kappa),
kappa_max = max(kappa)
)
knitr::kable(
resumen_kappa_ku,
digits = 3,
caption = "Resumen de acuerdo de los reactivos de Conocimiento y comprensión"
)| n_items | n_min | n_max | acuerdo_min | acuerdo_max | kappa_min | kappa_max |
|---|---|---|---|---|---|---|
| 10 | 319 | 322 | 49.22 | 74.53 | 0.314 | 0.653 |
9 8. Confiabilidad de los puntajes derivados: ICC, SEM y MDC95
Se estimó ICC(2,1) mediante un modelo de dos vías, efectos aleatorios, acuerdo absoluto y medición única.
scores_icc <- c(
# Motivación y confianza
"predilection_score",
"adequacy_score",
"intrinsic_motivation_score",
"pa_competence_score",
"mc_score",
# Conocimiento y comprensión
"pa_guideline_score",
"crf_means_score",
"ms_means_score",
"sports_skill_score",
"fill_in_the_blanks_score",
"ku_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
)
}
interpretar_icc <- function(x) {
dplyr::case_when(
is.na(x) ~ "No estimable",
x < 0.50 ~ "Pobre",
x < 0.75 ~ "Moderada",
x < 0.90 ~ "Buena",
TRUE ~ "Excelente"
)
}calcular_icc <- function(df, score) {
var_m1 <- paste0(score, "_m1")
var_m2 <- paste0(score, "_m2")
if (
!all(
c(var_m1, var_m2) %in% names(df)
)
) {
stop(
paste(
"Faltan variables para:",
score
)
)
}
x <- df[[var_m1]]
y <- df[[var_m2]]
datos <- data.frame(
M1 = x,
M2 = y
) %>%
tidyr::drop_na()
n <- nrow(datos)
if (n < 10) {
return(
tibble(
score = score,
n = n,
media_m1 = NA_real_,
de_m1 = NA_real_,
media_m2 = NA_real_,
de_m2 = NA_real_,
diferencia_media = NA_real_,
icc = NA_real_,
ic95_inf = NA_real_,
ic95_sup = NA_real_,
p = NA_real_
)
)
}
media_m1 <- mean(datos$M1)
media_m2 <- mean(datos$M2)
de_m1 <- sd(datos$M1)
de_m2 <- sd(datos$M2)
diferencia_media <- mean(
datos$M1 - datos$M2
)
modelo <- irr::icc(
datos,
model = "twoway",
type = "agreement",
unit = "single",
conf.level = 0.95
)
tibble(
score = score,
n = n,
media_m1 = media_m1,
de_m1 = de_m1,
media_m2 = media_m2,
de_m2 = de_m2,
diferencia_media = diferencia_media,
icc = as.numeric(modelo$value),
ic95_inf = as.numeric(modelo$lbound),
ic95_sup = as.numeric(modelo$ubound),
p = as.numeric(modelo$p.value)
)
}tabla_icc <- purrr::map_dfr(
scores_icc,
function(s) {
calcular_icc(
base_scores_fiabilidad,
s
)
}
) %>%
mutate(
sd_pooled =
sqrt(
(de_m1^2 + de_m2^2) / 2
),
sem =
ifelse(
!is.na(icc) & icc <= 1,
sd_pooled *
sqrt(
pmax(
0,
1 - icc
)
),
NA_real_
),
mdc95 =
1.96 *
sqrt(2) *
sem,
interpretacion =
interpretar_icc(icc),
puntaje =
etiquetar_score(score)
)
tabla_icc_final <- tabla_icc %>%
transmute(
Puntaje = puntaje,
n,
`Media M1` = media_m1,
`DE M1` = de_m1,
`Media M2` = media_m2,
`DE M2` = de_m2,
`Diferencia media M1-M2` = diferencia_media,
ICC = icc,
`IC95% inferior` = ic95_inf,
`IC95% superior` = ic95_sup,
SEM = sem,
MDC95 = mdc95,
Interpretación = interpretacion
)
knitr::kable(
tabla_icc_final,
digits = 3,
caption = "ICC(2,1), SEM y MDC95 de los puntajes derivados"
)| Puntaje | n | Media M1 | DE M1 | Media M2 | DE M2 | Diferencia media M1-M2 | ICC | IC95% inferior | IC95% superior | SEM | MDC95 | Interpretación |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Predilección | 322 | 5.149 | 1.788 | 4.953 | 1.670 | 0.196 | 0.901 | 0.872 | 0.924 | 0.543 | 1.506 | Excelente |
| Adecuación | 322 | 5.313 | 1.682 | 5.311 | 1.631 | 0.001 | 0.939 | 0.924 | 0.951 | 0.410 | 1.136 | Excelente |
| Motivación intrínseca | 322 | 5.618 | 1.524 | 5.565 | 1.518 | 0.053 | 0.947 | 0.934 | 0.957 | 0.351 | 0.974 | Excelente |
| Competencia percibida | 322 | 5.283 | 1.574 | 5.266 | 1.552 | 0.017 | 0.924 | 0.906 | 0.938 | 0.431 | 1.195 | Excelente |
| Motivación y confianza | 322 | 21.362 | 4.285 | 21.095 | 4.022 | 0.267 | 0.946 | 0.932 | 0.957 | 0.965 | 2.674 | Excelente |
| Guía de actividad física | 322 | 0.301 | 0.460 | 0.273 | 0.446 | 0.028 | 0.448 | 0.356 | 0.531 | 0.337 | 0.933 | Pobre |
| Aptitud cardiorrespiratoria | 322 | 0.419 | 0.494 | 0.342 | 0.475 | 0.078 | 0.549 | 0.467 | 0.622 | 0.325 | 0.902 | Moderada |
| Fuerza/resistencia muscular | 322 | 0.413 | 0.493 | 0.379 | 0.486 | 0.034 | 0.566 | 0.487 | 0.636 | 0.322 | 0.894 | Moderada |
| Habilidad deportiva | 322 | 0.332 | 0.472 | 0.289 | 0.454 | 0.043 | 0.509 | 0.423 | 0.585 | 0.324 | 0.899 | Moderada |
| Completar espacios | 318 | 2.827 | 1.515 | 4.340 | 1.584 | -1.513 | 0.303 | -0.014 | 0.530 | 1.294 | 3.588 | Pobre |
| Conocimiento y comprensión | 322 | 4.293 | 2.149 | 5.624 | 1.952 | -1.331 | 0.409 | 0.158 | 0.582 | 1.578 | 4.374 | Pobre |
10 9. Bland–Altman para los puntajes totales
La diferencia se definió como Aplicación 1 − Aplicación 2.
calcular_bland_altman <- function(df, score) {
var_m1 <- paste0(score, "_m1")
var_m2 <- paste0(score, "_m2")
x <- as.numeric(df[[var_m1]])
y <- as.numeric(df[[var_m2]])
completos <- complete.cases(x, y)
x <- x[completos]
y <- y[completos]
n <- length(x)
diferencia <- x - y
promedio <- (x + y) / 2
sesgo <- mean(diferencia)
de_diferencias <- sd(diferencia)
loa_inferior <- sesgo - 1.96 * de_diferencias
loa_superior <- sesgo + 1.96 * de_diferencias
error_sesgo <- de_diferencias / sqrt(n)
ic95_sesgo_inf <- sesgo - 1.96 * error_sesgo
ic95_sesgo_sup <- sesgo + 1.96 * error_sesgo
modelo_prop <- lm(
diferencia ~ promedio
)
pendiente <- coef(
summary(modelo_prop)
)["promedio", "Estimate"]
p_pendiente <- coef(
summary(modelo_prop)
)["promedio", "Pr(>|t|)"]
list(
resumen = tibble(
score = score,
n = n,
media_m1 = mean(x),
media_m2 = mean(y),
sesgo_m1_m2 = sesgo,
ic95_sesgo_inf = ic95_sesgo_inf,
ic95_sesgo_sup = ic95_sesgo_sup,
de_diferencias = de_diferencias,
loa_inferior = loa_inferior,
loa_superior = loa_superior,
pendiente_proporcional = pendiente,
p_sesgo_proporcional = p_pendiente
),
datos = tibble(
promedio = promedio,
diferencia = diferencia
)
)
}
ba_mc <- calcular_bland_altman(
base_scores_fiabilidad,
"mc_score"
)
ba_ku <- calcular_bland_altman(
base_scores_fiabilidad,
"ku_score"
)
tabla_bland_altman <- bind_rows(
ba_mc$resumen,
ba_ku$resumen
) %>%
mutate(
Puntaje = etiquetar_score(score)
) %>%
select(
Puntaje,
n,
media_m1,
media_m2,
sesgo_m1_m2,
ic95_sesgo_inf,
ic95_sesgo_sup,
loa_inferior,
loa_superior,
pendiente_proporcional,
p_sesgo_proporcional
)
knitr::kable(
tabla_bland_altman,
digits = 3,
caption = "Análisis de Bland–Altman de los puntajes totales"
)| Puntaje | n | media_m1 | media_m2 | sesgo_m1_m2 | ic95_sesgo_inf | ic95_sesgo_sup | loa_inferior | loa_superior | pendiente_proporcional | p_sesgo_proporcional |
|---|---|---|---|---|---|---|---|---|---|---|
| Motivación y confianza | 322 | 21.362 | 21.095 | 0.267 | 0.121 | 0.414 | -2.362 | 2.897 | 0.065 | 0.000 |
| Conocimiento y comprensión | 322 | 4.293 | 5.624 | -1.331 | -1.556 | -1.105 | -5.377 | 2.715 | 0.128 | 0.048 |
10.1 9.1. Motivación y confianza
res_mc <- ba_mc$resumen
ggplot(
ba_mc$datos,
aes(
x = promedio,
y = diferencia
)
) +
geom_point(
alpha = 0.55,
size = 2
) +
geom_hline(
yintercept = res_mc$sesgo_m1_m2,
linewidth = 0.8
) +
geom_hline(
yintercept = res_mc$loa_inferior,
linetype = "dashed",
linewidth = 0.7
) +
geom_hline(
yintercept = res_mc$loa_superior,
linetype = "dashed",
linewidth = 0.7
) +
geom_smooth(
method = "lm",
se = FALSE,
linetype = "dotted",
linewidth = 0.7
) +
labs(
title = "Bland–Altman: Motivación y confianza",
subtitle = paste0(
"Diferencia media = ",
round(res_mc$sesgo_m1_m2, 2),
" | Límites de acuerdo: ",
round(res_mc$loa_inferior, 2),
" a ",
round(res_mc$loa_superior, 2),
" | p sesgo proporcional = ",
format.pval(
res_mc$p_sesgo_proporcional,
digits = 3,
eps = 0.001
)
),
x = "Promedio de las dos aplicaciones",
y = "Aplicación 1 − Aplicación 2"
) +
theme_minimal()
10.2 9.2. Conocimiento y comprensión
res_ku <- ba_ku$resumen
ggplot(
ba_ku$datos,
aes(
x = promedio,
y = diferencia
)
) +
geom_point(
alpha = 0.55,
size = 2
) +
geom_hline(
yintercept = res_ku$sesgo_m1_m2,
linewidth = 0.8
) +
geom_hline(
yintercept = res_ku$loa_inferior,
linetype = "dashed",
linewidth = 0.7
) +
geom_hline(
yintercept = res_ku$loa_superior,
linetype = "dashed",
linewidth = 0.7
) +
geom_smooth(
method = "lm",
se = FALSE,
linetype = "dotted",
linewidth = 0.7
) +
labs(
title = "Bland–Altman: Conocimiento y comprensión",
subtitle = paste0(
"Diferencia media = ",
round(res_ku$sesgo_m1_m2, 2),
" | Límites de acuerdo: ",
round(res_ku$loa_inferior, 2),
" a ",
round(res_ku$loa_superior, 2),
" | p sesgo proporcional = ",
format.pval(
res_ku$p_sesgo_proporcional,
digits = 3,
eps = 0.001
)
),
x = "Promedio de las dos aplicaciones",
y = "Aplicación 1 − Aplicación 2"
) +
theme_minimal()
11 10. Resumen por dominio
icc_mc <- tabla_icc %>%
filter(score == "mc_score")
icc_ku <- tabla_icc %>%
filter(score == "ku_score")
tabla_resumen_fiabilidad <- tibble(
Dominio = c(
"Motivación y confianza",
"Conocimiento y comprensión"
),
`n puntaje total` = c(
icc_mc$n,
icc_ku$n
),
`Kappa mínimo de los ítems` = c(
min(resultados_kappa_mc$kappa),
min(resultados_kappa_ku$kappa)
),
`Kappa máximo de los ítems` = c(
max(resultados_kappa_mc$kappa),
max(resultados_kappa_ku$kappa)
),
`Acuerdo exacto mínimo (%)` = c(
min(resultados_kappa_mc$acuerdo_exacto),
min(resultados_kappa_ku$acuerdo_exacto)
),
`Acuerdo exacto máximo (%)` = c(
max(resultados_kappa_mc$acuerdo_exacto),
max(resultados_kappa_ku$acuerdo_exacto)
),
ICC = c(
icc_mc$icc,
icc_ku$icc
),
`IC95% inferior` = c(
icc_mc$ic95_inf,
icc_ku$ic95_inf
),
`IC95% superior` = c(
icc_mc$ic95_sup,
icc_ku$ic95_sup
),
SEM = c(
icc_mc$sem,
icc_ku$sem
),
MDC95 = c(
icc_mc$mdc95,
icc_ku$mdc95
),
`Diferencia media M1-M2` = c(
icc_mc$diferencia_media,
icc_ku$diferencia_media
),
Interpretación = c(
icc_mc$interpretacion,
icc_ku$interpretacion
)
)
knitr::kable(
tabla_resumen_fiabilidad,
digits = 3,
caption = "Resumen definitivo de confiabilidad interevaluador"
)| Dominio | n puntaje total | Kappa mínimo de los ítems | Kappa máximo de los ítems | Acuerdo exacto mínimo (%) | Acuerdo exacto máximo (%) | ICC | IC95% inferior | IC95% superior | SEM | MDC95 | Diferencia media M1-M2 | Interpretación |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Motivación y confianza | 322 | 0.895 | 0.945 | 77.33 | 86.65 | 0.946 | 0.932 | 0.957 | 0.965 | 2.674 | 0.267 | Excelente |
| Conocimiento y comprensión | 322 | 0.314 | 0.653 | 49.22 | 74.53 | 0.409 | 0.158 | 0.582 | 1.578 | 4.374 | -1.331 | Pobre |
12 11. Control de correspondencia con los resultados definitivos
Esta sección facilita la auditoría del documento antes de su publicación en RPubs o depósito en un repositorio.
Los valores de referencia utilizados para la comprobación corresponden a la versión definitiva de los resultados de la tesis.
control <- tibble(
indicador = c(
"ICC total Motivación y confianza",
"ICC total Conocimiento y comprensión",
"Diferencia media Bland–Altman MC",
"LoA inferior MC",
"LoA superior MC",
"Diferencia media Bland–Altman KU",
"LoA inferior KU",
"LoA superior KU"
),
esperado = c(
0.946,
0.409,
0.27,
-2.36,
2.90,
-1.33,
-5.38,
2.72
),
obtenido = c(
icc_mc$icc,
icc_ku$icc,
ba_mc$resumen$sesgo_m1_m2,
ba_mc$resumen$loa_inferior,
ba_mc$resumen$loa_superior,
ba_ku$resumen$sesgo_m1_m2,
ba_ku$resumen$loa_inferior,
ba_ku$resumen$loa_superior
)
) %>%
mutate(
diferencia = obtenido - esperado,
coincide_redondeo = case_when(
grepl("^ICC", indicador) ~
round(obtenido, 3) == round(esperado, 3),
TRUE ~
round(obtenido, 2) == round(esperado, 2)
)
)
knitr::kable(
control,
digits = 4,
caption = "Control de correspondencia con los resultados definitivos"
)| indicador | esperado | obtenido | diferencia | coincide_redondeo |
|---|---|---|---|---|
| ICC total Motivación y confianza | 0.946 | 0.9461 | 0.0001 | TRUE |
| ICC total Conocimiento y comprensión | 0.409 | 0.4091 | 0.0001 | TRUE |
| Diferencia media Bland–Altman MC | 0.270 | 0.2674 | -0.0026 | TRUE |
| LoA inferior MC | -2.360 | -2.3617 | -0.0017 | TRUE |
| LoA superior MC | 2.900 | 2.8965 | -0.0035 | TRUE |
| Diferencia media Bland–Altman KU | -1.330 | -1.3307 | -0.0007 | TRUE |
| LoA inferior KU | -5.380 | -5.3770 | 0.0030 | TRUE |
| LoA superior KU | 2.720 | 2.7155 | -0.0045 | TRUE |
if (!all(control$coincide_redondeo)) {
warning(
paste(
"Al menos un resultado no coincide con el valor definitivo.",
"Revise la base de entrada antes de publicar."
)
)
}13 12. 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] knitr_1.50 ggplot2_4.0.1 irr_0.84.1 lpSolve_5.6.23 purrr_1.1.0
## [6] tibble_3.3.0 tidyr_1.3.1 dplyr_1.2.0
##
## loaded via a namespace (and not attached):
## [1] Matrix_1.7-3 gtable_0.3.6 jsonlite_2.0.0 compiler_4.5.1
## [5] tidyselect_1.2.1 jquerylib_0.1.4 splines_4.5.1 scales_1.4.0
## [9] yaml_2.3.10 fastmap_1.2.0 lattice_0.22-7 R6_2.6.1
## [13] labeling_0.4.3 generics_0.1.4 bslib_0.9.0 pillar_1.11.0
## [17] RColorBrewer_1.1-3 rlang_1.2.0 cachem_1.1.0 xfun_0.55
## [21] sass_0.4.10 S7_0.2.1 cli_3.6.6 mgcv_1.9-3
## [25] withr_3.0.2 magrittr_2.0.3 digest_0.6.37 grid_4.5.1
## [29] rstudioapi_0.17.1 nlme_3.1-168 lifecycle_1.0.5 vctrs_0.7.1
## [33] evaluate_1.0.4 glue_1.8.0 farver_2.1.2 rmarkdown_2.29
## [37] tools_4.5.1 pkgconfig_2.0.3 htmltools_0.5.8.1