R Markdown

This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.

When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:

# carga de paquetes 
paquetes <- c(
  "readxl",
  "dplyr",
  "tidyr",
  "ggplot2",
  "knitr",
  "broom",
  "farver",
  "purrr",
  "scales"
)

faltantes <- paquetes[
  !paquetes %in% rownames(installed.packages())
]

if (length(faltantes) > 0) {
  install.packages(faltantes, dependencies = TRUE)
}

#carga de datos y estructura real de los datos

library(readxl)
library(dplyr)
## 
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(readxl)
Tabla_para_datos <- read_excel("D:/usuario nuevo/Downloads/Tabla para datos.xlsx")
View(Tabla_para_datos)
# Estandarizar nombres
datos <- Tabla_para_datos %>%
  rename(
    muestra = Muestra,
    metodo = Método,
    L = `L*`,
    a = `a*`,
    b = `b*`
  ) %>%
  mutate(
    muestra = as.character(muestra),
    metodo = trimws(as.character(metodo))
  )

# Revisar estructura
str(datos)
## tibble [120 × 5] (S3: tbl_df/tbl/data.frame)
##  $ muestra: chr [1:120] "1" "1" "2" "2" ...
##  $ metodo : chr [1:120] "Espectrofotómetro" "Photoshop" "Espectrofotómetro" "Photoshop" ...
##  $ L      : num [1:120] 76.2 77.1 72.3 74.3 75.3 76.8 74.8 76.7 72.8 72.8 ...
##  $ a      : num [1:120] 3.1 2.8 3.9 3.5 1.5 2.9 4 6.3 3.4 5.4 ...
##  $ b      : num [1:120] 17.3 24.1 18.2 22.1 17.6 25.4 20.2 26.3 18.3 25 ...
head(datos)
dim(datos)
## [1] 120   5
summary(datos)
##    muestra             metodo                L               a        
##  Length:120         Length:120         Min.   :69.90   Min.   :0.600  
##  Class :character   Class :character   1st Qu.:74.05   1st Qu.:2.300  
##  Mode  :character   Mode  :character   Median :76.80   Median :3.100  
##                                        Mean   :76.58   Mean   :3.154  
##                                        3rd Qu.:79.20   3rd Qu.:3.800  
##                                        Max.   :87.60   Max.   :7.100  
##        b        
##  Min.   :11.50  
##  1st Qu.:17.30  
##  Median :19.50  
##  Mean   :19.98  
##  3rd Qu.:22.12  
##  Max.   :30.20

#Control de calidad de la base

library(readxl)
library(dplyr)
library(tidyr)
library(ggplot2)
library(knitr)
library(broom)
library(farver)
library(purrr)
library(scales)
## 
## Adjuntando el paquete: 'scales'
## The following object is masked from 'package:purrr':
## 
##     discard
options(
  scipen = 999,
  digits = 4
)

set.seed(2026)
# Valores ausentes
colSums(is.na(datos))
## muestra  metodo       L       a       b 
##       0       0       0       0       0
# Filas duplicadas exactas
sum(duplicated(datos))
## [1] 0
# Número de muestras y observaciones
nrow(datos)
## [1] 120
n_distinct(datos$muestra)
## [1] 60
table(datos$metodo)
## 
## Espectrofotómetro         Photoshop 
##                60                60
# Comprobar combinaciones duplicadas
datos %>%
  count(muestra, metodo) %>%
  filter(n != 1)
# Verificar métodos por muestra
control_pares <- datos %>%
  group_by(muestra) %>%
  summarise(
    n_metodos = n_distinct(metodo),
    n_registros = n(),
    .groups = "drop"
  )

control_pares %>%
  filter(n_metodos != 2 | n_registros != 2)
# Detener el análisis si los datos no tienen
# exactamente dos registros por muestra
stopifnot(
  all(control_pares$n_metodos == 2),
  all(control_pares$n_registros == 2),
  all(complete.cases(datos[, c("L", "a", "b")]))
)

##Si las dos últimas consultas de comprobación devuelven tablas vacías, no se han detectado problemas en esos controles.

#Transformar la base a formato pareado

# Comprobar los nombres de los métodos
unique(datos$metodo)
## [1] "Espectrofotómetro" "Photoshop"
# Base ancha: una fila por muestra
datos_pares <- datos %>%
  pivot_wider(
    id_cols = muestra,
    names_from = metodo,
    values_from = c(L, a, b),
    names_glue = "{.value}_{metodo}"
  )

# Revisar nombres de columnas
names(datos_pares)
## [1] "muestra"             "L_Espectrofotómetro" "L_Photoshop"        
## [4] "a_Espectrofotómetro" "a_Photoshop"         "b_Espectrofotómetro"
## [7] "b_Photoshop"
# Verificar el número de pares
stopifnot(nrow(datos_pares) == 60)

head(datos_pares)

#Crear variables estandarizadas y diferencias pareadas

datos_pares <- datos_pares %>%
  rename(
    L_espectro = `L_Espectrofotómetro`,
    L_foto = L_Photoshop,
    a_espectro = `a_Espectrofotómetro`,
    a_foto = a_Photoshop,
    b_espectro = `b_Espectrofotómetro`,
    b_foto = b_Photoshop
  ) %>%
  mutate(
    dL = L_foto - L_espectro,
    da = a_foto - a_espectro,
    db = b_foto - b_espectro,
    media_L = (L_foto + L_espectro) / 2,
    media_a = (a_foto + a_espectro) / 2,
    media_b = (b_foto + b_espectro) / 2
  )

head(datos_pares)

#Interpretación de las diferencias: #- dL > 0: Photoshop mide mayor luminosidad. #- da > 0: Photoshop obtiene un valor de a* mayor. #- db > 0: Photoshop obtiene un valor de b* mayor. #Estas diferencias se definen siempre como Photoshop menos espectrofotómetro, para mantener una dirección coherente en todos los resultados.

#Estadística descriptiva #Resumen de L, a y b* por método

descriptivos <- datos %>%
  pivot_longer(
    cols = c(L, a, b),
    names_to = "coordenada",
    values_to = "valor"
  ) %>%
  group_by(metodo, coordenada) %>%
  summarise(
    n = sum(!is.na(valor)),
    media = mean(valor, na.rm = TRUE),
    DE = sd(valor, na.rm = TRUE),
    mediana = median(valor, na.rm = TRUE),
    Q1 = quantile(valor, 0.25, na.rm = TRUE),
    Q3 = quantile(valor, 0.75, na.rm = TRUE),
    minimo = min(valor, na.rm = TRUE),
    maximo = max(valor, na.rm = TRUE),
    .groups = "drop"
  )

kable(
  descriptivos,
  digits = 3,
  caption = "Estadística descriptiva por método y coordenada"
)
Estadística descriptiva por método y coordenada
metodo coordenada n media DE mediana Q1 Q3 minimo maximo
Espectrofotómetro L 60 74.885 2.707 74.80 72.67 77.075 69.9 80.5
Espectrofotómetro a 60 2.997 0.814 3.00 2.30 3.525 1.4 4.9
Espectrofotómetro b 60 17.843 2.560 17.50 16.27 19.300 11.5 25.1
Photoshop L 60 78.283 3.265 78.85 76.20 80.000 70.4 87.6
Photoshop a 60 3.312 1.424 3.30 2.20 4.225 0.6 7.1
Photoshop b 60 22.120 3.298 21.95 19.77 24.300 14.7 30.2

#Intervalos de confianza del 95% para las medias

ic_medias <- datos %>%
  pivot_longer(
    cols = c(L, a, b),
    names_to = "coordenada",
    values_to = "valor"
  ) %>%
  group_by(metodo, coordenada) %>%
  summarise(
    n = sum(!is.na(valor)),
    media = mean(valor, na.rm = TRUE),
    DE = sd(valor, na.rm = TRUE),
    error_estandar = DE / sqrt(n),
    t_critico = qt(0.975, df = n - 1),
    IC95_inf = media - t_critico * error_estandar,
    IC95_sup = media + t_critico * error_estandar,
    .groups = "drop"
  )

kable(
  ic_medias,
  digits = 3,
  caption = "Medias e intervalos de confianza del 95%"
)
Medias e intervalos de confianza del 95%
metodo coordenada n media DE error_estandar t_critico IC95_inf IC95_sup
Espectrofotómetro L 60 74.885 2.707 0.350 2.001 74.186 75.584
Espectrofotómetro a 60 2.997 0.814 0.105 2.001 2.786 3.207
Espectrofotómetro b 60 17.843 2.560 0.331 2.001 17.182 18.505
Photoshop L 60 78.283 3.265 0.421 2.001 77.440 79.127
Photoshop a 60 3.312 1.424 0.184 2.001 2.944 3.680
Photoshop b 60 22.120 3.298 0.426 2.001 21.268 22.972

#Los intervalos de confianza describen la incertidumbre de las medias de cada método. No deben interpretarse como intervalos de concordancia entre métodos.

#Gráfico descriptivo de las coordenadas

datos_largos <- datos %>%
  pivot_longer(
    cols = c(L, a, b),
    names_to = "coordenada",
    values_to = "valor"
  )

ggplot(
  datos_largos,
  aes(x = metodo, y = valor, fill = metodo)
) +
  geom_boxplot(
    alpha = 0.65,
    width = 0.6,
    outlier.shape = NA
  ) +
  geom_jitter(
    width = 0.12,
    alpha = 0.45,
    size = 1.6
  ) +
  facet_wrap(
    ~ coordenada,
    scales = "free_y"
  ) +
  labs(
    title = "Distribución de las coordenadas CIE L*a*b*",
    x = "Método de medición",
    y = "Valor de la coordenada",
    fill = "Método"
  ) +
  theme_bw(base_size = 12) +
  theme(
    legend.position = "none",
    axis.text.x = element_text(
      angle = 15,
      hjust = 1
    )
  )

#Evaluación de la distribución y comparación pareada

#Estadística de las diferencias y normalidad

#La normalidad relevante para la prueba t pareada es la de las diferencias entre los métodos, no la de cada conjunto por separado.

diferencias_largas <- datos_pares %>%
  select(muestra, dL, da, db) %>%
  pivot_longer(
    cols = c(dL, da, db),
    names_to = "coordenada",
    values_to = "diferencia"
  )

# Estadística de las diferencias
resumen_diferencias <- diferencias_largas %>%
  group_by(coordenada) %>%
  summarise(
    n = n(),
    media = mean(diferencia),
    DE = sd(diferencia),
    mediana = median(diferencia),
    Q1 = quantile(diferencia, 0.25),
    Q3 = quantile(diferencia, 0.75),
    minimo = min(diferencia),
    maximo = max(diferencia),
    .groups = "drop"
  )

kable(
  resumen_diferencias,
  digits = 3,
  caption = "Distribución de las diferencias Photoshop menos espectrofotómetro"
)
Distribución de las diferencias Photoshop menos espectrofotómetro
coordenada n media DE mediana Q1 Q3 minimo maximo
dL 60 3.398 2.997 3.65 1.275 5.325 -3.6 9.9
da 60 0.315 1.154 0.30 -0.325 1.025 -2.4 3.2
db 60 4.277 2.258 4.00 3.100 5.025 -1.5 10.4 
# Shapiro-Wilk
normalidad <- diferencias_largas %>%
  group_by(coordenada) %>%
  summarise(
    W = unname(shapiro.test(diferencia)$statistic),
    p = shapiro.test(diferencia)$p.value,
    .groups = "drop"
  )

kable(normalidad, digits = 4)
coordenada W p
dL 0.9910 0.9372
da 0.9903 0.9145
db 0.9489 0.0139

#Un valor de p pequeño en Shapiro-Wilk indica evidencia contra la normalidad. No obstante, la decisión también debe considerar los gráficos Q-Q, los valores extremos y la robustez de las pruebas.

#Histogramas y gráficos Q-Q

# Histogramas
ggplot(
  diferencias_largas,
  aes(x = diferencia)
) +
  geom_histogram(
    bins = 15,
    color = "white"
  ) +
  facet_wrap(
    ~ coordenada,
    scales = "free"
  ) +
  labs(
    title = "Distribución de las diferencias pareadas",
    x = "Photoshop - espectrofotómetro",
    y = "Frecuencia"
  ) +
  theme_bw(base_size = 12)

# Gráficos Q-Q
ggplot(
  diferencias_largas,
  aes(sample = diferencia)
) +
  stat_qq() +
  stat_qq_line() +
  facet_wrap(
    ~ coordenada,
    scales = "free"
  ) +
  labs(
    title = "Gráficos Q-Q de las diferencias",
    x = "Cuantiles teóricos",
    y = "Cuantiles observados"
  ) +
  theme_bw(base_size = 12)

#Pruebas de comparación de los métodos

comparar_metodos <- function(x, y, nombre) {

  diferencia <- x - y

  prueba_t <- t.test(
    x, y,
    paired = TRUE,
    conf.level = 0.95
  )

  prueba_w <- wilcox.test(
    x, y,
    paired = TRUE,
    exact = FALSE,
    conf.int = TRUE,
    conf.level = 0.95
  )

  tibble(
    coordenada = nombre,
    diferencia_media = mean(diferencia),
    IC95_inf_media = prueba_t$conf.int[1],
    IC95_sup_media = prueba_t$conf.int[2],
    p_t_pareada = prueba_t$p.value,
    mediana_diferencia = median(diferencia),
    p_wilcoxon = prueba_w$p.value
  )
}

resultados_pareados <- bind_rows(
  comparar_metodos(
    datos_pares$L_foto,
    datos_pares$L_espectro,
    "L*"
  ),
  comparar_metodos(
    datos_pares$a_foto,
    datos_pares$a_espectro,
    "a*"
  ),
  comparar_metodos(
    datos_pares$b_foto,
    datos_pares$b_espectro,
    "b*"
  )
) %>%
  mutate(
    p_t_ajustado = p.adjust(
      p_t_pareada,
      method = "holm"
    ),
    p_wilcoxon_ajustado = p.adjust(
      p_wilcoxon,
      method = "holm"
    )
  )

kable(
  resultados_pareados,
  digits = 4,
  caption = "Comparación pareada de las coordenadas colorimétricas"
)
Comparación pareada de las coordenadas colorimétricas
coordenada diferencia_media IC95_inf_media IC95_sup_media p_t_pareada mediana_diferencia p_wilcoxon p_t_ajustado p_wilcoxon_ajustado
L* 3.398 2.624 4.173 0.0000 3.65 0.0000 0.0000 0.0000
a* 0.315 0.017 0.613 0.0387 0.30 0.0372 0.0387 0.0372
b* 4.277 3.693 4.860 0.0000 4.00 0.0000 0.0000 0.0000

#Interpretación: una diferencia media distinta de cero puede indicar sesgo sistemático. Sin embargo, una prueba no significativa no demuestra que ambos métodos sean equivalentes ni intercambiables.

Correlación y regresión lineal

Correlación de Pearson y Spearman (La correlación mide asociación, no concordancia)

correlaciones <- bind_rows(
  tibble(
    coordenada = "L*",
    pearson = cor.test(
      datos_pares$L_espectro,
      datos_pares$L_foto,
      method = "pearson"
    )$estimate,
    p_pearson = cor.test(
      datos_pares$L_espectro,
      datos_pares$L_foto,
      method = "pearson"
    )$p.value,
    spearman = cor.test(
      datos_pares$L_espectro,
      datos_pares$L_foto,
      method = "spearman",
      exact = FALSE
    )$estimate,
    p_spearman = cor.test(
      datos_pares$L_espectro,
      datos_pares$L_foto,
      method = "spearman",
      exact = FALSE
    )$p.value
  ),
  tibble(
    coordenada = "a*",
    pearson = cor.test(
      datos_pares$a_espectro,
      datos_pares$a_foto
    )$estimate,
    p_pearson = cor.test(
      datos_pares$a_espectro,
      datos_pares$a_foto
    )$p.value,
    spearman = cor.test(
      datos_pares$a_espectro,
      datos_pares$a_foto,
      method = "spearman",
      exact = FALSE
    )$estimate,
    p_spearman = cor.test(
      datos_pares$a_espectro,
      datos_pares$a_foto,
      method = "spearman",
      exact = FALSE
    )$p.value
  ),
  tibble(
    coordenada = "b*",
    pearson = cor.test(
      datos_pares$b_espectro,
      datos_pares$b_foto
    )$estimate,
    p_pearson = cor.test(
      datos_pares$b_espectro,
      datos_pares$b_foto
    )$p.value,
    spearman = cor.test(
      datos_pares$b_espectro,
      datos_pares$b_foto,
      method = "spearman",
      exact = FALSE
    )$estimate,
    p_spearman = cor.test(
      datos_pares$b_espectro,
      datos_pares$b_foto,
      method = "spearman",
      exact = FALSE
    )$p.value
  )
)

kable(
  correlaciones,
  digits = 4,
  caption = "Asociación entre las mediciones de ambos métodos"
)
Asociación entre las mediciones de ambos métodos
coordenada pearson p_pearson spearman p_spearman
L* 0.5095 0 0.4855 0.0001
a* 0.5869 0 0.5932 0.0000
b* 0.7303 0 0.7664 0.0000

#Gráficos de correlación y regresión

graficar_regresion <- function(x, y, etiqueta) {

  df <- tibble(
    espectrofotometro = x,
    photoshop = y
  )

  ggplot(
    df,
    aes(x = espectrofotometro, y = photoshop)
  ) +
    geom_point(size = 2, alpha = 0.75) +
    geom_smooth(
      method = "lm",
      formula = y ~ x,
      se = TRUE
    ) +
    geom_abline(
      intercept = 0,
      slope = 1,
      linetype = "dashed"
    ) +
    labs(
      title = paste("Regresión para", etiqueta),
      x = "Espectrofotómetro",
      y = "Photoshop"
    ) +
    theme_bw(base_size = 12)
}

graficar_regresion(
  datos_pares$L_espectro,
  datos_pares$L_foto,
  "L*"
)

graficar_regresion(
  datos_pares$a_espectro,
  datos_pares$a_foto,
  "a*"
)

graficar_regresion(
  datos_pares$b_espectro,
  datos_pares$b_foto,
  "b*"
)

#La línea discontinua representa la igualdad perfecta entre los métodos. La regresión ordinaria no sustituye un análisis de concordancia y puede ser insuficiente si ambos métodos tienen error de medición.

#Análisis de concordancia de Bland–Altman

#Para cada coordenada se calcularán: #- Sesgo medio: diferencia promedio entre Photoshop y el espectrofotómetro. #- Límites de concordancia del 95%: sesgo ± 1,96 desviaciones estándar de las diferencias. #- Intervalos de confianza de los límites de concordancia, obtenidos mediante bootstrap. #- Gráfico de diferencias frente a medias. #Los límites de concordancia deben compararse con márgenes aceptables definidos clínicamente; no basta con que sean estrechos en términos estadísticos.

#Función para calcular Bland–Altman

bland_altman <- function(ref, nuevo, nombre,
                         B = 2000) {

  media_individual <- (ref + nuevo) / 2
  diferencia <- nuevo - ref
  n <- length(diferencia)

  sesgo <- mean(diferencia)
  de_dif <- sd(diferencia)

  loa_inf <- sesgo - 1.96 * de_dif
  loa_sup <- sesgo + 1.96 * de_dif

  # Bootstrap por pares de diferencias
  boot_res <- replicate(B, {
    idx <- sample.int(n, n, replace = TRUE)
    d <- diferencia[idx]

    b <- mean(d)
    s <- sd(d)

    c(
      sesgo = b,
      loa_inf = b - 1.96 * s,
      loa_sup = b + 1.96 * s
    )
  })

  boot_ic <- t(apply(
    boot_res,
    1,
    quantile,
    probs = c(0.025, 0.975),
    na.rm = TRUE
  ))

  tabla <- tibble(
    coordenada = nombre,
    n = n,
    sesgo = sesgo,
    DE_diferencias = de_dif,
    limite_inferior = loa_inf,
    limite_superior = loa_sup,
    IC95_sesgo_inf = boot_ic[1, 1],
    IC95_sesgo_sup = boot_ic[1, 2],
    IC95_LI_inf = boot_ic[2, 1],
    IC95_LI_sup = boot_ic[2, 2],
    IC95_LS_inf = boot_ic[3, 1],
    IC95_LS_sup = boot_ic[3, 2]
  )

  grafico <- tibble(
    media = media_individual,
    diferencia = diferencia
  ) %>%
    ggplot(aes(x = media, y = diferencia)) +
    geom_point(alpha = 0.75, size = 2) +
    geom_hline(
      yintercept = sesgo,
      linewidth = 0.8
    ) +
    geom_hline(
      yintercept = c(loa_inf, loa_sup),
      linetype = "dashed"
    ) +
    labs(
      title = paste("Bland–Altman:", nombre),
      subtitle = "Diferencia = Photoshop - espectrofotómetro",
      x = "Media de ambos métodos",
      y = "Diferencia entre métodos"
    ) +
    theme_bw(base_size = 12)

  list(
    tabla = tabla,
    grafico = grafico
  )
}

#Ejecutar Bland–Altman para L, a y b*

ba_L <- bland_altman(
  datos_pares$L_espectro,
  datos_pares$L_foto,
  "L*"
)

ba_a <- bland_altman(
  datos_pares$a_espectro,
  datos_pares$a_foto,
  "a*"
)

ba_b <- bland_altman(
  datos_pares$b_espectro,
  datos_pares$b_foto,
  "b*"
)

tabla_ba <- bind_rows(
  ba_L$tabla,
  ba_a$tabla,
  ba_b$tabla
)

kable(
  tabla_ba,
  digits = 3,
  caption = "Sesgo, límites de concordancia e intervalos de confianza bootstrap"
)
Sesgo, límites de concordancia e intervalos de confianza bootstrap
coordenada n sesgo DE_diferencias limite_inferior limite_superior IC95_sesgo_inf IC95_sesgo_sup IC95_LI_inf IC95_LI_sup IC95_LS_inf IC95_LS_sup
L* 60 3.398 2.997 -2.475 9.272 2.667 4.117 -3.498 -1.209 7.977 10.412
a* 60 0.315 1.154 -1.946 2.576 0.022 0.603 -2.413 -1.391 2.040 3.062
b* 60 4.277 2.258 -0.149 8.702 3.710 4.855 -1.068 0.897 7.370 9.835 
ba_L$grafico

ba_a$grafico

ba_b$grafico

#Cálculo de la diferencia de color CIEDE2000 (ΔE00) #Para cada muestra se calculará la diferencia entre las coordenadas L, a y b* obtenidas mediante ambos métodos, utilizando el algoritmo CIEDE2000. No se calculará ΔE00 comparando medias grupales, sino cada par de mediciones del mismo diente. #Calcular ΔE00

# Matrices de coordenadas Lab
lab_espectro <- as.matrix(
  datos_pares[, c(
    "L_espectro",
    "a_espectro",
    "b_espectro"
  )]
)

lab_foto <- as.matrix(
  datos_pares[, c(
    "L_foto",
    "a_foto",
    "b_foto"
  )]
)

# Distancias CIEDE2000 entre cada par correspondiente.
# La diagonal de la matriz contiene las distancias
# entre el diente i del método A y el diente i del método B.
matriz_deltaE00 <- farver::compare_colour(
  from = lab_espectro,
  to = lab_foto,
  from_space = "lab",
  method = "cie2000"
)

datos_pares$DeltaE00 <- diag(matriz_deltaE00)

# Verificar que se obtuvo un valor por diente
stopifnot(
  length(datos_pares$DeltaE00) == 60,
  all(is.finite(datos_pares$DeltaE00)),
  all(datos_pares$DeltaE00 >= 0)
)

head(
  datos_pares %>%
    select(muestra, DeltaE00)
)

#Estadística descriptiva de ΔE00

deltaE_resumen <- datos_pares %>%
  summarise(
    n = n(),
    media = mean(DeltaE00),
    DE = sd(DeltaE00),
    mediana = median(DeltaE00),
    Q1 = quantile(DeltaE00, 0.25),
    Q3 = quantile(DeltaE00, 0.75),
    minimo = min(DeltaE00),
    maximo = max(DeltaE00),
    IC95_inf_media = t.test(
      DeltaE00
    )$conf.int[1],
    IC95_sup_media = t.test(
      DeltaE00
    )$conf.int[2]
  )

kable(
  deltaE_resumen,
  digits = 3,
  caption = "Resumen descriptivo de ΔE00 entre los métodos"
)
Resumen descriptivo de ΔE00 entre los métodos
n media DE mediana Q1 Q3 minimo maximo IC95_inf_media IC95_sup_media
60 4.001 1.364 3.827 3.156 4.933 1.386 7.523 3.649 4.353

#Visualización de ΔE00

ggplot(
  datos_pares,
  aes(x = DeltaE00)
) +
  geom_histogram(
    bins = 15,
    color = "white"
  ) +
  geom_rug(alpha = 0.4) +
  labs(
    title = "Distribución de la diferencia de color CIEDE2000",
    subtitle = "Una observación por cada uno de los 60 dientes",
    x = expression(Delta*E[00]),
    y = "Frecuencia"
  ) +
  theme_bw(base_size = 12)

# Diagrama de caja
ggplot(
  datos_pares,
  aes(y = DeltaE00)
) +
  geom_boxplot(width = 0.25) +
  geom_jitter(
    aes(x = 1),
    width = 0.08,
    alpha = 0.65
  ) +
  labs(
    title = "Variabilidad de ΔE00 entre métodos",
    x = NULL,
    y = expression(Delta*E[00])
  ) +
  theme_bw(base_size = 12) +
  theme(
    axis.text.x = element_blank(),
    axis.ticks.x = element_blank()
  )

#Clasificación clínica según Paravina et al. (2015)

# Umbrales CIEDE2000 según Paravina et al. (2015)
# DOI: 10.1111/jerd.12149

PT <- 0.8  # Perceptibility threshold
AT <- 1.8  # Acceptability threshold

# Clasificación de las diferencias de color
datos_pares <- datos_pares %>%
  mutate(
    categoria_clinica = case_when(
      DeltaE00 <= PT ~
        "Hasta el umbral de perceptibilidad",
      DeltaE00 <= AT ~
        "Por encima de PT y hasta AT",
      DeltaE00 > AT ~
        "Por encima del umbral de aceptabilidad",
      TRUE ~ NA_character_
    )
  )

# Tabla de frecuencias y porcentajes
tabla_clinica <- datos_pares %>%
  count(categoria_clinica, name = "n") %>%
  mutate(
    porcentaje = 100 * n / sum(n)
  )

knitr::kable(
  tabla_clinica,
  digits = 2,
  col.names = c(
    "Categoría clínica",
    "Número de dientes",
    "Porcentaje (%)"
  ),
  caption = paste(
    "Clasificación de ΔE00 según los umbrales",
    "de Paravina et al. (2015)"
  )
)
Clasificación de ΔE00 según los umbrales de Paravina et al. (2015)
Categoría clínica Número de dientes Porcentaje (%)
Por encima de PT y hasta AT 2 3.33
Por encima del umbral de aceptabilidad 58 96.67

#Intervalos de confianza del 95%

tabla_proporciones <- datos_pares %>%
  count(categoria_clinica, name = "n") %>%
  mutate(
    total = sum(n),
    porcentaje = 100 * n / total,
    IC = map(
      n,
      ~ binom.test(.x, sum(n))$conf.int
    ),
    IC95_inf = 100 * map_dbl(IC, 1),
    IC95_sup = 100 * map_dbl(IC, 2)
  ) %>%
  select(
    categoria_clinica,
    n,
    porcentaje,
    IC95_inf,
    IC95_sup
  )

knitr::kable(
  tabla_proporciones,
  digits = 2,
  col.names = c(
    "Categoría clínica",
    "n",
    "Porcentaje (%)",
    "IC 95% inferior",
    "IC 95% superior"
  ),
  caption = "Proporciones clínicas e intervalos de confianza binomiales"
)
Proporciones clínicas e intervalos de confianza binomiales
Categoría clínica n Porcentaje (%) IC 95% inferior IC 95% superior
Por encima de PT y hasta AT 2 3.33 0.41 11.53
Por encima del umbral de aceptabilidad 58 96.67 88.47 99.59

### Interpretación clínica de las diferencias de color

#La diferencia de color entre las mediciones obtenidas mediante espectrofotometría dental (SpectroShade) y fotografía digital analizada con Adobe Photoshop se calculó para cada muestra mediante la fórmula CIEDE2000 (ΔE00). La interpretación clínica se fundamentó en los umbrales de perceptibilidad y aceptabilidad descritos por Paravina et al. (2015), quienes establecieron valores de ΔE00 = 0,8 para el umbral de perceptibilidad y ΔE00 = 1,8 para el umbral de aceptabilidad, en condiciones experimentales de evaluación visual de especímenes cerámicos dentales.

#Para el análisis descriptivo, las diferencias de color se clasificaron en tres categorías: valores iguales o inferiores a 0,8; valores superiores a 0,8 e iguales o inferiores a 1,8; y valores superiores a 1,8. Se calcularon las frecuencias absolutas, los porcentajes y sus intervalos de confianza del 95%.

#Dado que los umbrales originales se determinaron en condiciones experimentales específicas y sobre materiales cerámicos, su aplicación a dientes naturales evaluados mediante fotografía digital y espectrofotometría se consideró una referencia interpretativa, reconociendo las posibles diferencias entre las condiciones del estudio original y las del presente trabajo.

#Referencia: Paravina RD, Ghinea R, Herrera LJ, et al. Color Difference Thresholds in Dentistry. Journal of Esthetic and Restorative Dentistry. 2015;27(Suppl 1):S1–S9. https://doi.org/10.1111/jerd.12149

#Importante para la discusión: estos son umbrales visuales 50:50, no fronteras biológicas absolutas. La clasificación permite describir la magnitud de las diferencias de color, pero no demuestra por sí sola que Photoshop sea intercambiable con SpectroShade.