Felipe
Ricardo Enciso
2026-10-27
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:
##Instalación y carga de paquetes
# Ejecutar una sola vez si los paquetes no están instalados
paquetes <- c(
"readxl", "dplyr", "tidyr", "ggplot2",
"knitr", "broom", "car", "effectsize",
"emmeans", "farver", "purrr", "stringr"
)
faltantes <- paquetes[
!paquetes %in% rownames(installed.packages())
]
if (length(faltantes) > 0) {
install.packages(faltantes)
}
# Carga de paquetes
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, unionlibrary(tidyr)
library(ggplot2)
library(knitr)
library(broom)
library(car)## Cargando paquete requerido: carData##
## Adjuntando el paquete: 'car'## The following object is masked from 'package:dplyr':
##
## recodelibrary(effectsize)
library(emmeans)## Welcome to emmeans.
## Caution: You lose important information if you filter this package's results.
## See '? untidy'library(farver)
library(purrr)##
## Adjuntando el paquete: 'purrr'## The following object is masked from 'package:car':
##
## somelibrary(stringr)##Importación y extracción de las mediciones
library(readxl)
DATOS_F <- read_excel("D:/usuario nuevo/Downloads/DATOS.F.xlsx")## New names:
## • `` -> `...1`
## • `` -> `...2`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...7`
## • `` -> `...8`
## • `` -> `...9`
## • `` -> `...10`
## • `` -> `...11`
## • `` -> `...12`
## • `` -> `...13`View(DATOS_F)library(readxl)
library(dplyr)
library(stringr)
library(readr)
# Importar el archivo corregido
matriz <- read_excel(
"D:/usuario nuevo/Downloads/DATOS.F.xlsx",
sheet = "Hoja1",
skip = 5,
col_names = FALSE,
col_types = "text"
)## New names:
## • `` -> `...1`
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`
## • `` -> `...8`
## • `` -> `...9`
## • `` -> `...10`
## • `` -> `...11`
## • `` -> `...12`
## • `` -> `...13`# Comprobar dimensiones esperadas
print(dim(matriz))## [1] 40 13if (nrow(matriz) != 40 || ncol(matriz) != 13) {
stop("La hoja no tiene las 40 filas y 13 columnas esperadas.")
}
# Convertir las coordenadas a números
convertir_decimal <- function(x) {
x <- str_trim(as.character(x))
x[x == ""] <- NA_character_
x <- str_replace_all(x, ",", ".")
readr::parse_number(x, na = c("", "NA"))
}
# Crear base de datos con los tres tiempos
datos <- tibble(
id = str_trim(matriz[[1]]),
# T0: antes de aplicar el glaze
L0 = convertir_decimal(matriz[[3]]),
a0 = convertir_decimal(matriz[[4]]),
b0 = convertir_decimal(matriz[[5]]),
# T1: después del glaze
grupo_T1 = str_squish(matriz[[6]]),
L1 = convertir_decimal(matriz[[7]]),
a1 = convertir_decimal(matriz[[8]]),
b1 = convertir_decimal(matriz[[9]]),
# T2: después del termociclado
grupo_T2 = str_squish(matriz[[10]]),
L2 = convertir_decimal(matriz[[11]]),
a2 = convertir_decimal(matriz[[12]]),
b2 = convertir_decimal(matriz[[13]])
)
# Normalizar etiquetas para comprobar la concordancia
normalizar_grupo <- function(x) {
str_to_lower(str_squish(as.character(x)))
}
if (any(normalizar_grupo(datos$grupo_T1) !=
normalizar_grupo(datos$grupo_T2))) {
stop("Los grupos de T1 y T2 no coinciden. Revisar el Excel.")
}
# Usar el grupo experimental de T1
datos <- datos %>%
mutate(
grupo = case_when(
normalizar_grupo(grupo_T1) == "sin glaze" ~ "Sin glaze",
normalizar_grupo(grupo_T1) == "t glaze" ~ "T Glaze",
normalizar_grupo(grupo_T1) == "optiglaze" ~ "Optiglaze",
normalizar_grupo(grupo_T1) == "skin glaze" ~ "Skin Glaze",
TRUE ~ NA_character_
),
grupo = factor(
grupo,
levels = c("Sin glaze", "T Glaze",
"Optiglaze", "Skin Glaze")
)
)
# Verificar resultados
cat("Dimensiones de datos:", dim(datos), "\n")## Dimensiones de datos: 40 13cat("\nNúmero de especímenes por grupo:\n")##
## Número de especímenes por grupo:print(table(datos$grupo, useNA = "ifany"))##
## Sin glaze T Glaze Optiglaze Skin Glaze
## 10 10 10 10cat("\nValores faltantes en las coordenadas:\n")##
## Valores faltantes en las coordenadas:print(sapply(datos[c(
"L0", "a0", "b0",
"L1", "a1", "b1",
"L2", "a2", "b2"
)], function(x) sum(is.na(x))))## L0 a0 b0 L1 a1 b1 L2 a2 b2
## 0 0 0 0 0 0 0 0 0cat("\nPrimeras seis filas:\n")##
## Primeras seis filas:print(head(datos))## # A tibble: 6 × 13
## id L0 a0 b0 grupo_T1 L1 a1 b1 grupo_T2 L2 a2 b2
## <chr> <dbl> <dbl> <dbl> <chr> <dbl> <dbl> <dbl> <chr> <dbl> <dbl> <dbl>
## 1 1 76.3 -1.8 14.1 T glaze 74.8 -2.3 11.4 T glaze 79.3 -2.2 13.2
## 2 2 76.9 -1.6 14.4 T glaze 74.4 -2.4 12.1 T glaze 79 -2.3 13.5
## 3 3 72.4 -2.1 11.6 T glaze 74.3 -2.3 11.9 T glaze 78.9 -2.1 13.5
## 4 4 72.2 -2.1 11.8 T glaze 74 -2.5 12.6 T glaze 79.3 -2.1 13.7
## 5 5 73 -2.1 11 T glaze 74.2 -2.2 12.1 T glaze 79.4 -2.1 13.7
## 6 6 73.3 -2 10.9 T glaze 74.8 -2.2 12.1 T glaze 78.8 -2.4 14.7
## # ℹ 1 more variable: grupo <fct>cat("\nEstructura de la base:\n")##
## Estructura de la base:str(datos)## tibble [40 × 13] (S3: tbl_df/tbl/data.frame)
## $ id : chr [1:40] "1" "2" "3" "4" ...
## $ L0 : num [1:40] 76.3 76.9 72.4 72.2 73 73.3 76.4 73.5 73 77.3 ...
## $ a0 : num [1:40] -1.8 -1.6 -2.1 -2.1 -2.1 -2 -1.7 -1.9 -2 -1.8 ...
## $ b0 : num [1:40] 14.1 14.4 11.6 11.8 11 10.9 14.3 10.6 11.3 14.3 ...
## $ grupo_T1: chr [1:40] "T glaze" "T glaze" "T glaze" "T glaze" ...
## $ L1 : num [1:40] 74.8 74.4 74.3 74 74.2 74.8 74.6 74.1 74.6 74.6 ...
## $ a1 : num [1:40] -2.3 -2.4 -2.3 -2.5 -2.2 -2.2 -2.3 -2.3 -2.2 -2.3 ...
## $ b1 : num [1:40] 11.4 12.1 11.9 12.6 12.1 12.1 12 11.7 12.6 12.5 ...
## $ grupo_T2: chr [1:40] "T glaze" "T glaze" "T glaze" "T glaze" ...
## $ L2 : num [1:40] 79.3 79 78.9 79.3 79.4 78.8 79.6 79.3 78.9 79.1 ...
## $ a2 : num [1:40] -2.2 -2.3 -2.1 -2.1 -2.1 -2.4 -2.2 -2.2 -2.3 -2.2 ...
## $ b2 : num [1:40] 13.2 13.5 13.5 13.7 13.7 14.7 13.4 13.7 13.5 13.4 ...
## $ grupo : Factor w/ 4 levels "Sin glaze","T Glaze",..: 2 2 2 2 2 2 2 2 2 2 ...##Validación
library(dplyr)
library(stringr)
datos <- datos %>%
mutate(
grupo_limpio = str_to_lower(
str_squish(as.character(grupo_T1))
),
grupo = case_when(
grupo_limpio == "sin glaze" ~ "Sin glaze",
grupo_limpio == "t glaze" ~ "T Glaze",
grupo_limpio == "optiglaze" ~ "Optiglaze",
grupo_limpio == "skin glaze" ~ "Skin Glaze",
TRUE ~ NA_character_
),
grupo = factor(
grupo,
levels = c(
"Sin glaze",
"T Glaze",
"Optiglaze",
"Skin Glaze"
)
)
)
# Verificar los grupos
print(table(datos$grupo, useNA = "ifany"))##
## Sin glaze T Glaze Optiglaze Skin Glaze
## 10 10 10 10# Identificar etiquetas que no se reconocieron
print(
unique(datos$grupo_T1[is.na(datos$grupo)])
)## character(0)install.packages("farver")## Warning: package 'farver' is in use and will not be installed# Cálculo de diferencias de color CIEDE2000
# Función para calcular la diferencia entre filas correspondientes
calcular_deltaE00 <- function(datos, sufijo1, sufijo2) {
columnas1 <- paste0(c("L", "a", "b"), sufijo1)
columnas2 <- paste0(c("L", "a", "b"), sufijo2)
color1 <- as.matrix(datos[, columnas1])
color2 <- as.matrix(datos[, columnas2])
diag(
farver::compare_colour(
from = color1,
to = color2,
from_space = "lab",
method = "cie2000"
)
)
}
# Cambios de color entre tiempos
datos$DeltaE00_T0_T1 <- calcular_deltaE00(datos, "0", "1")
datos$DeltaE00_T1_T2 <- calcular_deltaE00(datos, "1", "2")
datos$DeltaE00_T0_T2 <- calcular_deltaE00(datos, "0", "2")
# Verificar resultados
head(datos[, c(
"id", "grupo",
"DeltaE00_T0_T1",
"DeltaE00_T1_T2",
"DeltaE00_T0_T2"
)])##Resumir los resultados por tratamiento
#Estadística descriptiva de Delta E00
resumen_color <- datos %>%
group_by(grupo) %>%
summarise(
n = sum(!is.na(DeltaE00_T0_T1)),
media_T0_T1 = mean(DeltaE00_T0_T1, na.rm = TRUE),
DE_T0_T1 = sd(DeltaE00_T0_T1, na.rm = TRUE),
media_T1_T2 = mean(DeltaE00_T1_T2, na.rm = TRUE),
DE_T1_T2 = sd(DeltaE00_T1_T2, na.rm = TRUE),
media_T0_T2 = mean(DeltaE00_T0_T2, na.rm = TRUE),
DE_T0_T2 = sd(DeltaE00_T0_T2, na.rm = TRUE),
mediana_T1_T2 = median(DeltaE00_T1_T2, na.rm = TRUE),
IQR_T1_T2 = IQR(DeltaE00_T1_T2, na.rm = TRUE),
.groups = "drop"
)
print(resumen_color)## # A tibble: 4 × 10
## grupo n media_T0_T1 DE_T0_T1 media_T1_T2 DE_T1_T2 media_T0_T2 DE_T0_T2
## <fct> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Sin glaze 10 3.37 1.64 2.72 0.984 5.79 1.53
## 2 T Glaze 10 1.72 0.569 3.55 0.291 3.69 1.48
## 3 Optiglaze 10 1.82 0.900 4.82 0.627 4.12 1.12
## 4 Skin Gla… 10 3.34 1.06 6.23 0.919 4.16 1.67
## # ℹ 2 more variables: mediana_T1_T2 <dbl>, IQR_T1_T2 <dbl>calcula media, desviación estándar, mediana, rango intercuartílico y tamaño de muestra para cada intervalo.
La diferencia ΔE00 mide la magnitud del cambio de color; no indica por sí sola si el color aumentó o disminuyó en luminosidad. Para conocer la dirección, también analizaremos por separado los cambios en L, a y b*.
##El análisis principal para evaluar la estabilidad de los tratamientos será la comparación de ΔE00 entre T1 y T2, porque mide cuánto cambió el color durante el termociclado. El grupo sin glaze funcionará como control. ##Visualización de los resultados
Grupo T0–T1: media ± DE T1–T2: media ± DE T0–T2: media ± DE
#Sin glaze 3,37 ± 1,64 2,72 ± 0,98 5,79 ± 1,53 #T Glaze 1,72 ± 0,57 3,55 ± 0,29 3,69 ± 1,48 #Optiglaze 1,82 ± 0,90 4,82 ± 0,63 4,12 ± 1,12 #Skin Glaze 3,34 ± 1,06 6,23 ± 0,92 4,16 ± 1,67
##DE: desviación estándar. ΔE00 expresa la magnitud de la diferencia de color, no su dirección. ##Hallazgos preliminares #- T0–T1: T Glaze presenta el menor cambio medio inicial (1,72), seguido de Optiglaze (1,82). Sin glaze y Skin Glaze muestran cambios iniciales mayores. #- T1–T2: Sin glaze presenta el menor cambio medio durante el termociclado (2,72), seguido de T Glaze (3,55), Optiglaze (4,82) y Skin Glaze (6,23). #- T0–T2: T Glaze presenta el menor cambio medio acumulado (3,69), mientras que Sin glaze presenta el mayor (5,79).
library(ggplot2)
library(dplyr)
ggplot(datos, aes(x = grupo, y = DeltaE00_T1_T2, fill = grupo)) +
geom_boxplot(alpha = 0.65, outlier.shape = NA) +
geom_jitter(width = 0.12, size = 2, alpha = 0.8) +
labs(
title = "Cambio de color durante el termociclado",
subtitle = "Diferencia CIEDE2000 entre T1 y T2",
x = "Grupo experimental",
y = expression(Delta*E[00])
) +
theme_minimal() +
theme(legend.position = "none")
##Evaluar los supuestos
# Normalidad dentro de cada grupo
normalidad <- datos %>%
group_by(grupo) %>%
summarise(
n = sum(!is.na(DeltaE00_T1_T2)),
W = shapiro.test(DeltaE00_T1_T2)$statistic,
p_Shapiro = shapiro.test(DeltaE00_T1_T2)$p.value,
.groups = "drop"
)
print(normalidad)## # A tibble: 4 × 4
## grupo n W p_Shapiro
## <fct> <int> <dbl> <dbl>
## 1 Sin glaze 10 0.924 0.394
## 2 T Glaze 10 0.918 0.342
## 3 Optiglaze 10 0.947 0.628
## 4 Skin Glaze 10 0.867 0.0932# Homogeneidad de varianzas
install.packages("car") # Solo la primera vez## Warning: package 'car' is in use and will not be installedlibrary(car)
car::leveneTest(
DeltaE00_T1_T2 ~ grupo,
data = datos,
center = median
)##Shapiro–Wilk con \(p > 0,05\): no se detecta evidencia suficiente contra la normalidad; no demuestra que la distribución sea normal.
##Levene con \(p < 0,05\): hay evidencia de varianzas diferentes, por lo que no conviene depender del ANOVA clásico.
##Comparar los cuatro grupos
# ANOVA de Welch
welch <- oneway.test(
DeltaE00_T1_T2 ~ grupo,
data = datos,
var.equal = FALSE
)
print(welch)##
## One-way analysis of means (not assuming equal variances)
##
## data: DeltaE00_T1_T2 and grupo
## F = 35.569, num df = 3.000, denom df = 17.714, p-value = 1.038e-07# Comparaciones post hoc de Games-Howell
posthoc_welch <- rstatix::games_howell_test(
data = datos,
formula = DeltaE00_T1_T2 ~ grupo
)
print(posthoc_welch)## # A tibble: 6 × 8
## .y. group1 group2 estimate conf.low conf.high p.adj p.adj.signif
## * <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 DeltaE00_T1_T2 Sin gl… T Gla… 0.829 -0.155 1.81 1.08e-1 ns
## 2 DeltaE00_T1_T2 Sin gl… Optig… 2.10 1.04 3.16 2.10e-4 ***
## 3 DeltaE00_T1_T2 Sin gl… Skin … 3.51 2.31 4.71 9.28e-7 ****
## 4 DeltaE00_T1_T2 T Glaze Optig… 1.27 0.628 1.91 3.32e-4 ***
## 5 DeltaE00_T1_T2 T Glaze Skin … 2.68 1.76 3.60 1.53e-5 ****
## 6 DeltaE00_T1_T2 Optigl… Skin … 1.41 0.402 2.42 5.11e-3 **# Análisis complementario no paramétrico
kruskal <- kruskal.test(
DeltaE00_T1_T2 ~ grupo,
data = datos
)
print(kruskal)##
## Kruskal-Wallis rank sum test
##
## data: DeltaE00_T1_T2 by grupo
## Kruskal-Wallis chi-squared = 31.251, df = 3, p-value = 7.526e-07# Comparaciones por pares de Dunn con ajuste Holm
posthoc_dunn <- rstatix::dunn_test(
data = datos,
formula = DeltaE00_T1_T2 ~ grupo,
p.adjust.method = "holm"
)
print(posthoc_dunn)## # A tibble: 6 × 9
## .y. group1 group2 n1 n2 statistic p p.adj p.adj.signif
## * <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <chr>
## 1 DeltaE00_T1_… Sin g… T Gla… 10 10 1.01 3.11e-1 3.11e-1 ns
## 2 DeltaE00_T1_… Sin g… Optig… 10 10 3.46 5.36e-4 2.14e-3 **
## 3 DeltaE00_T1_… Sin g… Skin … 10 10 5.01 5.40e-7 3.24e-6 ****
## 4 DeltaE00_T1_… T Gla… Optig… 10 10 2.45 1.44e-2 4.31e-2 *
## 5 DeltaE00_T1_… T Gla… Skin … 10 10 4.00 6.40e-5 3.20e-4 ***
## 6 DeltaE00_T1_… Optig… Skin … 10 10 1.55 1.21e-1 2.43e-1 ns##Interpretación de los supuestos ##Normalidad: Shapiro–Wilk #Grupo W Valor p Interpretación #Sin glaze 0,924 0,394 No se detecta desviación significativa #T Glaze 0,918 0,342 No se detecta desviación significativa #Optiglaze 0,947 0,628 No se detecta desviación significativa #Skin Glaze 0,867 0,093 No se detecta desviación significativa
#En los cuatro grupos, \(p>0,05\). Por tanto, las pruebas de Shapiro–Wilk no detectan evidencia suficiente contra la normalidad. Sin embargo, con solo 10 especímenes por grupo, estas pruebas tienen potencia limitada.
##Homogeneidad de varianzas: Levene #- \(F(3,36)=3,206\) #- \(p=0,0345\) #Como \(p<0,05\), existe evidencia de que las varianzas no son iguales entre los grupos. Por ello, es apropiado utilizar el ANOVA de Welch en lugar del ANOVA clásico, seguido de comparaciones post hoc que no exijan igualdad de varianzas.
library(rstatix)##
## Adjuntando el paquete: 'rstatix'## The following objects are masked from 'package:effectsize':
##
## cohens_d, eta_squared, omega_squared## The following object is masked from 'package:stats':
##
## filterlibrary(dplyr)
posthoc_welch <- datos %>%
games_howell_test(DeltaE00_T1_T2 ~ grupo)
print(posthoc_welch)## # A tibble: 6 × 8
## .y. group1 group2 estimate conf.low conf.high p.adj p.adj.signif
## * <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 DeltaE00_T1_T2 Sin gl… T Gla… 0.829 -0.155 1.81 1.08e-1 ns
## 2 DeltaE00_T1_T2 Sin gl… Optig… 2.10 1.04 3.16 2.10e-4 ***
## 3 DeltaE00_T1_T2 Sin gl… Skin … 3.51 2.31 4.71 9.28e-7 ****
## 4 DeltaE00_T1_T2 T Glaze Optig… 1.27 0.628 1.91 3.32e-4 ***
## 5 DeltaE00_T1_T2 T Glaze Skin … 2.68 1.76 3.60 1.53e-5 ****
## 6 DeltaE00_T1_T2 Optigl… Skin … 1.41 0.402 2.42 5.11e-3 **##ANOVA de Welch resultado #F(3, 17{,}714)=35{,}569,p=1{,}038^{-7} ]
#El valor p es mucho menor que 0,001. Por tanto, rechazamos la hipótesis nula de igualdad de las medias poblacionales de ΔE00 entre los cuatro grupos.
#Interpretación: hay evidencia estadística muy sólida de que al menos uno de los tratamientos presenta un cambio de color durante el termociclado diferente al de otro grupo. El ANOVA de Welch no identifica por sí solo cuáles grupos difieren; para eso necesitamos el análisis post hoc.
#Los cambios medios que ya calculaste fueron: #- Sin glaze: 2,72 #- T Glaze: 3,55 #- Optiglaze: 4,82 #- Skin Glaze: 6,23 #Descriptivamente, Sin glaze mostró el menor cambio y Skin Glaze el mayor. Aún debemos comprobar qué diferencias por pares son estadísticamente significativas.
##Comparaciones post hoc de Games–Howell #La diferencia estimada corresponde a la media del primer grupo menos la media del segundo grupo, según el orden de la tabla de resultados. #Comparación Diferencia estimada de ΔE00 IC del 95 % p ajustado Interpretación #Sin glaze – T Glaze 0,829 −0,155 a 1,81 0,108 No significativa #Sin glaze – Optiglaze 2,10 1,04 a 3,16 0,000210 Significativa #Sin glaze – Skin Glaze 3,51 2,31 a 4,71 0,000000928 Significativa #T Glaze – Optiglaze 1,27 0,628 a 1,91 0,000332 Significativa #T Glaze – Skin Glaze 2,68 1,76 a 3,60 0,0000153 Significativa #Optiglaze – Skin Glaze 1,41 0,402 a 2,42 0,00511 Significativa
##Sin glaze frente a T Glaze: no se encontró una diferencia estadísticamente significativa (\(p=0,108\)). Aunque T Glaze tuvo un cambio medio mayor, los datos no permiten concluir que difieran en la población.
#Optiglaze: presentó un cambio de color significativamente mayor que Sin glaze y T Glaze.
#Skin Glaze: presentó el mayor cambio de color. Sus diferencias frente a los otros tres grupos fueron estadísticamente significativas.
#Orden descriptivo del cambio durante el termociclado: Sin glaze (2,72) < T Glaze (3,55) < Optiglaze (4,82) < Skin Glaze (6,23).
# ==========================================
# ANALISIS DE LOS TRES INTERVALOS DE COLOR
# ==========================================
library(rstatix)
library(dplyr)
# 1. Analisis descriptivo de cada intervalo
resumen_intervalos <- datos %>%
group_by(grupo) %>%
summarise(
n = n(),
media_T0_T1 = mean(DeltaE00_T0_T1, na.rm = TRUE),
DE_T0_T1 = sd(DeltaE00_T0_T1, na.rm = TRUE),
media_T1_T2 = mean(DeltaE00_T1_T2, na.rm = TRUE),
DE_T1_T2 = sd(DeltaE00_T1_T2, na.rm = TRUE),
media_T0_T2 = mean(DeltaE00_T0_T2, na.rm = TRUE),
DE_T0_T2 = sd(DeltaE00_T0_T2, na.rm = TRUE),
.groups = "drop"
)
print(resumen_intervalos)## # A tibble: 4 × 8
## grupo n media_T0_T1 DE_T0_T1 media_T1_T2 DE_T1_T2 media_T0_T2 DE_T0_T2
## <fct> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Sin glaze 10 3.37 1.64 2.72 0.984 5.79 1.53
## 2 T Glaze 10 1.72 0.569 3.55 0.291 3.69 1.48
## 3 Optiglaze 10 1.82 0.900 4.82 0.627 4.12 1.12
## 4 Skin Gla… 10 3.34 1.06 6.23 0.919 4.16 1.67# 2. Welch y Games-Howell para T0-T1
welch_T0_T1 <- oneway.test(
DeltaE00_T0_T1 ~ grupo,
data = datos,
var.equal = FALSE
)
print(welch_T0_T1)##
## One-way analysis of means (not assuming equal variances)
##
## data: DeltaE00_T0_T1 and grupo
## F = 7.7738, num df = 3.000, denom df = 18.873, p-value = 0.001401posthoc_T0_T1 <- rstatix::games_howell_test(
datos,
DeltaE00_T0_T1 ~ grupo
)
print(posthoc_T0_T1)## # A tibble: 6 × 8
## .y. group1 group2 estimate conf.low conf.high p.adj p.adj.signif
## * <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 DeltaE00_T0_T1 Sin gl… T Gla… -1.64 -3.30 0.00990 0.0515 ns
## 2 DeltaE00_T0_T1 Sin gl… Optig… -1.55 -3.27 0.178 0.0859 ns
## 3 DeltaE00_T0_T1 Sin gl… Skin … -0.0288 -1.81 1.75 1.00 ns
## 4 DeltaE00_T0_T1 T Glaze Optig… 0.0976 -0.872 1.07 0.991 ns
## 5 DeltaE00_T0_T1 T Glaze Skin … 1.61 0.509 2.72 0.00406 **
## 6 DeltaE00_T0_T1 Optigl… Skin … 1.52 0.273 2.76 0.0141 *# 3. Welch y Games-Howell para T0-T2
welch_T0_T2 <- oneway.test(
DeltaE00_T0_T2 ~ grupo,
data = datos,
var.equal = FALSE
)
print(welch_T0_T2)##
## One-way analysis of means (not assuming equal variances)
##
## data: DeltaE00_T0_T2 and grupo
## F = 3.5584, num df = 3.000, denom df = 19.755, p-value = 0.03298posthoc_T0_T2 <- rstatix::games_howell_test(
datos,
DeltaE00_T0_T2 ~ grupo
)print(posthoc_T0_T2)## # A tibble: 6 × 8
## .y. group1 group2 estimate conf.low conf.high p.adj p.adj.signif
## * <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 DeltaE00_T0_T2 Sin gla… T Gla… -2.10 -4.00 -0.196 0.0278 *
## 2 DeltaE00_T0_T2 Sin gla… Optig… -1.67 -3.38 0.0370 0.0563 ns
## 3 DeltaE00_T0_T2 Sin gla… Skin … -1.63 -3.66 0.391 0.140 ns
## 4 DeltaE00_T0_T2 T Glaze Optig… 0.428 -1.24 2.10 0.884 ns
## 5 DeltaE00_T0_T2 T Glaze Skin … 0.465 -1.53 2.46 0.911 ns
## 6 DeltaE00_T0_T2 Optigla… Skin … 0.0369 -1.78 1.86 1.00 ns##gráficos para los tres intervalos
# Gráfica de cambios de color CIEDE2000
library(ggplot2)
library(tidyr)
library(dplyr)
# Verificar que existan las columnas necesarias
columnas_necesarias <- c(
"grupo",
"DeltaE00_T0_T1",
"DeltaE00_T1_T2",
"DeltaE00_T0_T2"
)
if (!all(columnas_necesarias %in% names(datos))) {
stop("Faltan columnas necesarias en el objeto datos. Verifique sus nombres.")
}
# Preparar los datos en formato largo
datos_intervalos <- datos %>%
dplyr::select(
grupo,
DeltaE00_T0_T1,
DeltaE00_T1_T2,
DeltaE00_T0_T2
) %>%
tidyr::pivot_longer(
cols = starts_with("DeltaE00_"),
names_to = "intervalo",
values_to = "DeltaE00"
) %>%
dplyr::mutate(
intervalo = dplyr::case_when(
intervalo == "DeltaE00_T0_T1" ~ "T0-T1: cambio inicial",
intervalo == "DeltaE00_T1_T2" ~ "T1-T2: termociclado",
intervalo == "DeltaE00_T0_T2" ~ "T0-T2: cambio acumulado",
TRUE ~ intervalo
),
intervalo = factor(
intervalo,
levels = c(
"T0-T1: cambio inicial",
"T1-T2: termociclado",
"T0-T2: cambio acumulado"
)
)
)
# Crear gráfica
grafica_deltaE00 <- ggplot(
datos_intervalos,
aes(x = grupo, y = DeltaE00, fill = grupo)
) +
geom_boxplot(
alpha = 0.65,
outlier.shape = NA
) +
geom_jitter(
width = 0.12,
size = 1.8,
alpha = 0.8
) +
facet_wrap(~ intervalo) +
labs(
title = "Cambios de color CIEDE2000 por grupo",
x = "Grupo experimental",
y = expression(Delta * E[00])
) +
theme_minimal() +
theme(
legend.position = "none",
axis.text.x = element_text(
angle = 25,
hjust = 1
)
)
print(grafica_deltaE00)
##T0–T1: cambio inicial
#Evalúa cuánto difiere el color después de aplicar el glaze, antes del termociclado. En el grupo sin glaze representa el cambio durante ese intervalo sin aplicación de recubrimiento. ##T1–T2: estabilidad durante el termociclado
#Mide cuánto cambió el color después de los 10.000 ciclos. Ya encontraste diferencias significativas entre los grupos con Welch y Games–Howell. ##T0–T2: cambio acumulado
#Evalúa la diferencia total entre el color inicial y el final. Permite comparar qué grupos conservan mejor el color original, aunque el resultado también refleja el cambio producido al aplicar el tratamiento.
##Resumen #### Resultados: cambios de color después de la aplicación del glaze y del termociclado
#Las diferencias de color se evaluaron mediante la fórmula CIEDE2000 (ΔE00) en tres intervalos: antes y después del tratamiento (T0–T1), durante el termociclado (T1–T2) y entre la medición inicial y la final (T0–T2). Debido a la falta de homogeneidad de varianzas, evidenciada mediante la prueba de Levene para el intervalo T1–T2 (F = 3,206; p = 0,035), se empleó el análisis de varianza de Welch y se realizaron comparaciones post hoc mediante Games–Howell.
#Para el intervalo T0–T1 se observaron diferencias globales entre los grupos (F(3, 18,873) = 7,774; p = 0,0014). Las comparaciones post hoc identificaron diferencias significativas entre T Glaze y Skin Glaze (p ajustado = 0,0041), así como entre Optiglaze y Skin Glaze (p ajustado = 0,0141). No se encontraron diferencias estadísticamente significativas en las demás comparaciones.
#Durante el termociclado (T1–T2), se detectaron diferencias globales altamente significativas entre los tratamientos (F(3, 17,714) = 35,569; p < 0,001). Los valores medios de ΔE00 fueron 2,72 para Sin glaze, 3,55 para T Glaze, 4,82 para Optiglaze y 6,23 para Skin Glaze. Las comparaciones de Games–Howell mostraron diferencias significativas entre todos los pares de grupos, excepto entre Sin glaze y T Glaze (p ajustado = 0,108). Skin Glaze presentó el mayor cambio de color durante el envejecimiento térmico.
#En el intervalo acumulado T0–T2 también se identificaron diferencias globales entre los grupos (F(3, 19,755) = 3,558; p = 0,033). Sin embargo, después del ajuste por comparaciones múltiples, únicamente se detectó una diferencia significativa entre Sin glaze y T Glaze (p ajustado = 0,0278). Las demás comparaciones no alcanzaron significación estadística.
#En conjunto, los resultados muestran que el cambio de color varió entre los tratamientos, especialmente durante el termociclado. Skin Glaze presentó el mayor cambio durante este intervalo, mientras que Sin glaze y T Glaze mostraron cambios menores. No obstante, las diferencias observadas en el cambio acumulado fueron menos consistentes entre los grupos. La relevancia clínica de estos hallazgos debe establecerse considerando los umbrales de perceptibilidad y aceptabilidad de color en odontología.
# ==========================================
# CAMBIOS EN LAS COORDENADAS CIE L*a*b*
# Durante el termociclado: T1 a T2
# ==========================================
library(dplyr)
datos <- datos %>%
mutate(
dL_T1_T2 = L2 - L1,
da_T1_T2 = a2 - a1,
db_T1_T2 = b2 - b1
)
# Resumen por grupo
resumen_lab <- datos %>%
group_by(grupo) %>%
summarise(
n = n(),
media_dL = mean(dL_T1_T2, na.rm = TRUE),
DE_dL = sd(dL_T1_T2, na.rm = TRUE),
media_da = mean(da_T1_T2, na.rm = TRUE),
DE_da = sd(da_T1_T2, na.rm = TRUE),
media_db = mean(db_T1_T2, na.rm = TRUE),
DE_db = sd(db_T1_T2, na.rm = TRUE),
.groups = "drop"
)
print(resumen_lab)## # A tibble: 4 × 8
## grupo n media_dL DE_dL media_da DE_da media_db DE_db
## <fct> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Sin glaze 10 3.58 1.51 -0.0300 0.116 1.72 0.424
## 2 T Glaze 10 4.72 0.434 0.0900 0.160 1.53 0.523
## 3 Optiglaze 10 6.58 0.868 0.26 0.184 0.68 1.21
## 4 Skin Glaze 10 8.4 1.31 -0.54 0.599 0.840 1.53##Gráficas cambio de color
library(dplyr)
library(tidyr)
library(ggplot2)
datos_lab_largos <- datos %>%
dplyr::select(
grupo,
dL_T1_T2,
da_T1_T2,
db_T1_T2
) %>%
tidyr::pivot_longer(
cols = c(dL_T1_T2, da_T1_T2, db_T1_T2),
names_to = "coordenada",
values_to = "cambio"
) %>%
dplyr::mutate(
coordenada = dplyr::case_when(
coordenada == "dL_T1_T2" ~ "Luminosidad (ΔL*)",
coordenada == "da_T1_T2" ~ "Eje verde-rojo (Δa*)",
coordenada == "db_T1_T2" ~ "Eje azul-amarillo (Δb*)",
TRUE ~ coordenada
),
coordenada = factor(
coordenada,
levels = c(
"Luminosidad (ΔL*)",
"Eje verde-rojo (Δa*)",
"Eje azul-amarillo (Δb*)"
)
)
)
grafica_lab <- ggplot(
datos_lab_largos,
aes(x = grupo, y = cambio, fill = grupo)
) +
geom_boxplot(
alpha = 0.65,
outlier.shape = NA
) +
geom_jitter(
width = 0.12,
size = 1.8,
alpha = 0.8
) +
geom_hline(
yintercept = 0,
linetype = "dashed"
) +
facet_wrap(
~ coordenada,
scales = "free_y"
) +
labs(
title = "Cambios en las coordenadas CIE L*a*b*",
subtitle = "Después de 10.000 ciclos de termociclado",
x = "Grupo experimental",
y = "Cambio entre T1 y T2"
) +
theme_minimal() +
theme(
legend.position = "none",
axis.text.x = element_text(
angle = 25,
hjust = 1
)
)
print(grafica_lab)
pruebas de Welch y Games–Howell para cada coordenada.
# Luminosidad: L*
welch_dL <- oneway.test(
dL_T1_T2 ~ grupo,
data = datos,
var.equal = FALSE
)
posthoc_dL <- rstatix::games_howell_test(
datos,
dL_T1_T2 ~ grupo
)
print(welch_dL)##
## One-way analysis of means (not assuming equal variances)
##
## data: dL_T1_T2 and grupo
## F = 33.716, num df = 3.000, denom df = 17.861, p-value = 1.44e-07print(posthoc_dL)## # A tibble: 6 × 8
## .y. group1 group2 estimate conf.low conf.high p.adj p.adj.signif
## * <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 dL_T1_T2 Sin glaze T Glaze 1.14 -0.372 2.65 1.63e-1 ns
## 2 dL_T1_T2 Sin glaze Optiglaze 3 1.40 4.60 4.18e-4 ***
## 3 dL_T1_T2 Sin glaze Skin Glaze 4.82 3.03 6.61 3.09e-6 ****
## 4 dL_T1_T2 T Glaze Optiglaze 1.86 0.962 2.76 1.92e-4 ***
## 5 dL_T1_T2 T Glaze Skin Glaze 3.68 2.37 4.99 2.00e-5 ****
## 6 dL_T1_T2 Optiglaze Skin Glaze 1.82 0.398 3.24 1.03e-2 *# Componente cromático: a*
welch_da <- oneway.test(
da_T1_T2 ~ grupo,
data = datos,
var.equal = FALSE
)
posthoc_da <- rstatix::games_howell_test(
datos,
da_T1_T2 ~ grupo
)
print(welch_da)##
## One-way analysis of means (not assuming equal variances)
##
## data: da_T1_T2 and grupo
## F = 8.77, num df = 3.000, denom df = 18.963, p-value = 0.0007422print(posthoc_da)## # A tibble: 6 × 8
## .y. group1 group2 estimate conf.low conf.high p.adj p.adj.signif
## * <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 da_T1_T2 Sin glaze T Glaze 0.120 -0.0579 0.298 0.256 ns
## 2 da_T1_T2 Sin glaze Optiglaze 0.29 0.0922 0.488 0.00361 **
## 3 da_T1_T2 Sin glaze Skin Glaze -0.51 -1.10 0.0834 0.0979 ns
## 4 da_T1_T2 T Glaze Optiglaze 0.17 -0.0479 0.388 0.159 ns
## 5 da_T1_T2 T Glaze Skin Glaze -0.63 -1.23 -0.0336 0.0379 *
## 6 da_T1_T2 Optiglaze Skin Glaze -0.8 -1.40 -0.201 0.00944 **# Componente cromático: b*
welch_db <- oneway.test(
db_T1_T2 ~ grupo,
data = datos,
var.equal = FALSE
)
posthoc_db <- rstatix::games_howell_test(
datos,
db_T1_T2 ~ grupo
)
print(welch_db)##
## One-way analysis of means (not assuming equal variances)
##
## data: db_T1_T2 and grupo
## F = 2.7907, num df = 3.000, denom df = 18.585, p-value = 0.06915print(posthoc_db)## # A tibble: 6 × 8
## .y. group1 group2 estimate conf.low conf.high p.adj p.adj.signif
## * <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 db_T1_T2 Sin glaze T Glaze -0.190 -0.794 0.414 0.809 ns
## 2 db_T1_T2 Sin glaze Optiglaze -1.04 -2.25 0.173 0.101 ns
## 3 db_T1_T2 Sin glaze Skin Glaze -0.880 -2.41 0.648 0.348 ns
## 4 db_T1_T2 T Glaze Optiglaze -0.85 -2.08 0.380 0.225 ns
## 5 db_T1_T2 T Glaze Skin Glaze -0.69 -2.23 0.849 0.554 ns
## 6 db_T1_T2 Optiglaze Skin Glaze 0.160 -1.59 1.91 0.994 ns##Luminosidad (L) #Todos los grupos presentaron un aumento de L, lo que indica que las muestras fueron, en promedio, más claras después del termociclado. El mayor incremento se observó en Skin Glaze (8,40), seguido de Optiglaze (6,58), T Glaze (4,72) y Sin glaze (3,58).
#Esta diferencia descriptiva sugiere que el cambio de luminosidad fue mayor en Skin Glaze. Sin embargo, debemos comprobar mediante pruebas inferenciales si las diferencias entre grupos son estadísticamente significativas. ##Componente a #La coordenada a representa el eje cromático verde–rojo: los valores positivos corresponden al sentido rojo y los negativos al verde. #- Sin glaze: prácticamente no presentó cambio promedio (−0,03). #- T Glaze: mostró un incremento pequeño (0,09). #- Optiglaze: presentó un incremento promedio de 0,26. #- Skin Glaze: presentó una disminución promedio de −0,54. #Por tanto, Skin Glaze mostró el mayor desplazamiento promedio hacia el sentido verde, mientras que Optiglaze presentó el mayor desplazamiento hacia el sentido rojo. La magnitud de estos cambios debe evaluarse con las pruebas estadísticas y en conjunto con ΔE00. ##C. Componente b* #Ninguna de las seis comparaciones fue estadísticamente significativa (todos los valores de p ajustado fueron superiores a 0,05).
#Aunque Sin glaze y T Glaze presentaron incrementos medios de b* mayores que Optiglaze y Skin Glaze, la variabilidad observada impide concluir que esas diferencias sean estadísticamente significativas en esta muestra.
Resumen de los hallazgos
#Variable Welch Comparaciones post hoc significativas Conclusión #L* p < 0,001 5 de 6 Diferencias marcadas entre grupos #a* p < 0,001 3 de 6 Diferencias en el desplazamiento cromático #b* p = 0,069 0 de 6 No se detectaron diferencias entre grupos
Resumen
Cambios en las coordenadas CIE Lab* después del termociclado
#Los cambios en las coordenadas CIE Lab* entre las mediciones realizadas antes y después del termociclado (T1–T2) se analizaron mediante pruebas de Welch, debido a que no se cumplió el supuesto de homogeneidad de varianzas. Las comparaciones post hoc se efectuaron mediante la prueba de Games–Howell.
#Se identificaron diferencias estadísticamente significativas entre los grupos para la coordenada L* (F(3, 17,861) = 33,716; p < 0,001) y para la coordenada a* (F(3, 18,963) = 8,770; p < 0,001). En contraste, no se encontraron diferencias estadísticamente significativas entre los grupos para la coordenada b* (F(3, 18,585) = 2,791; p = 0,069).
#En cuanto a L*, Skin Glaze presentó el mayor incremento medio (8,40 ± 1,31), seguido de Optiglaze (6,58 ± 0,87), T Glaze (4,72 ± 0,43) y Sin glaze (3,58 ± 1,51). Las comparaciones de Games–Howell mostraron diferencias significativas entre Skin Glaze y cada uno de los otros tres grupos, así como entre Optiglaze y los grupos Sin glaze y T Glaze. No se detectaron diferencias entre Sin glaze y T Glaze.
#Para la coordenada a, Optiglaze presentó un incremento medio de 0,26 ± 0,18, mientras que Skin Glaze mostró una disminución media de −0,54 ± 0,60. Se encontraron diferencias significativas entre Sin glaze y Optiglaze, entre T Glaze y Skin Glaze, y entre Optiglaze y Skin Glaze. Para b, aunque las medias descriptivas mostraron incrementos en los cuatro grupos, las diferencias entre grupos no alcanzaron significación estadística.
#En conjunto, los resultados indican que el cambio de luminosidad fue la dimensión que presentó las diferencias más claras entre los tratamientos, mientras que las diferencias en el componente a* fueron más limitadas. No se detectó evidencia estadística suficiente de diferencias entre grupos en el componente b*.