Diseño y análisis de experimentos

Ejercicio 16

  1. Los datos que se presentan enseguida son rendimientos en toneladas por hectárea de un pasto con tres niveles de fertilización nitrogenada. El diseño fue completamente aleatorizado, con cinco repeticiones por tratamiento1.
1 2 3
14.823 25.151 32.605
14.676 25.401 32.460
14.720 25.131 32.256
14.5141 25.031 32.669
15.065 25.267 32.111

  1. ¿Las diferencias muestrales hacen obvia la presencia de diferencias poblacionales?

  2. Obtenga el análisis de varianza e interprételo.

  3. Analice los residuos, ¿hay algún problema?

Solución

  1. ¿Las diferencias muestrales hacen obvia la presencia de diferencias poblacionales?

Para responder a esta pregunta, se puede realizar un análisis descriptivo de los datos. A continuación, se presenta un resumen de los datos.

# Datos
lvl_nitrogen1 <- c(14.823, 14.676, 14.720, 14.5141, 15.065)
lvl_nitrogen2 <- c(25.151, 25.401, 25.131, 25.031, 25.267)
lvl_nitrogen3 <- c(32.605, 32.460, 32.256, 32.669, 32.111)

# Define the summary_stats function
summary_stats <- function(x) {
  # Compute the measures of central tendency and dispersion
  stats <- data.frame(
    variable = "Nivel 1 N2",
    mean = mean(x),
    median = median(x),
    mode = as.numeric(names(which.max(table(x)))),
    sd = sd(x),
    cv = sd(x) / mean(x) * 100
  )
  # Set the variable name
  stats$variable <- ""
  return(stats)
}


# Apply the summary_stats function to each nitrogen level variable
nitrogen_summary <- do.call(rbind, lapply(list(lvl_nitrogen1, lvl_nitrogen2, lvl_nitrogen3), summary_stats))
nitrogen_summary$variable <- c("Nivel 1 N2", "Nivel 2 N2", "Nivel 3 N3")

# Print the summary table
nitrogen_summary
##     variable     mean median    mode        sd        cv
## 1 Nivel 1 N2 14.75962 14.720 14.5141 0.2037867 1.3807043
## 2 Nivel 2 N2 25.19620 25.151 25.0310 0.1418986 0.5631744
## 3 Nivel 3 N3 32.42020 32.460 32.1110 0.2346289 0.7237119

De acuerdo con el análisis descriptivo, se observa que el rendimiento promedio de los tres niveles de fertilización nitrogenada es diferente. Por lo tanto, se puede concluir que las diferencias muestrales hacen obvia la presencia de diferencias poblacionales.

  1. Obtenga el análisis de varianza e interprételo.

Para realizar el análisis de varianza, se puede utilizar la función aov de R. A continuación, se presenta el análisis de varianza.

# Load the data
data_nitrogen <- data.frame(
  fertilization = factor(rep(1:3, each = 5)),
  performance = c(
    14.823, 14.676, 14.720, 14.5141, 15.065,
    25.151, 25.401, 25.131, 25.031, 25.267,
    32.605, 32.460, 32.256, 32.669, 32.111)
)

# Fit the ANOVA model
model_nitrogen <- aov(performance ~ fertilization, data = data_nitrogen)

# Print the ANOVA table
summary(model_nitrogen)
##               Df Sum Sq Mean Sq F value Pr(>F)    
## fertilization  2  788.3   394.2   10132 <2e-16 ***
## Residuals     12    0.5     0.0                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Test tukey
TukeyHSD(model_nitrogen)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = performance ~ fertilization, data = data_nitrogen)
## 
## $fertilization
##         diff      lwr      upr p adj
## 2-1 10.43658 10.10377 10.76939     0
## 3-1 17.66058 17.32777 17.99339     0
## 3-2  7.22400  6.89119  7.55681     0
show_pvalue <- summary(model_nitrogen)[[1]][["Pr(>F)"]][[1]]

De acuerdo con el análisis de varianza, se observa que el \(valor-p=\) 4.2982495^{-20} es menor que 0.05. Por lo tanto, se rechaza la hipótesis nula de que no hay diferencias entre los niveles de fertilización nitrogenada. En otras palabras, se concluye que hay diferencias significativas entre los niveles de fertilización nitrogenada.

Además, el test de Tukey muestra que hay diferencias significativas entre los niveles de fertilización nitrogenada.

  1. Analice los residuos, ¿hay algún problema?

Para analizar los residuos, se puede utilizar la función plot de R. A continuación, se presenta el análisis de los residuos.

# Plot the residuals
par(mfrow = c(2, 2))
plot(model_nitrogen)

De acuerdo con el análisis de los residuos, se observa que los residuos no presentan un patrón claro. Por lo tanto, se puede concluir que no hay problemas con los residuos.

Gráficos

Se realiza un gráfico de cajas para visualizar la distribución de los rendimientos por nivel de fertilización nitrogenada. Además un histograma.

# Load the ggplot2 package

library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.2.3
# Create a boxplot
boxplot(data_nitrogen$performance ~ data_nitrogen$fertilization, xlab = "Nivel de fertilización nitrogenada", ylab = "Rendimiento (toneladas por hectárea)", main = "Rendimiento por nivel de fertilización nitrogenada")

# Create a histogram
hist(data_nitrogen$performance, xlab = "Rendimiento (toneladas por hectárea)",breaks = 6, ylab = "Frecuencia", main = "Distribución del rendimiento")

El diagrama de cajas muestra que el rendimiento promedio aumenta con el nivel de fertilización nitrogenada.

Ejercicio 17

  1. Un químico del departamento de desarrollo de un laboratorio farmacéutico desea conocer cómo influye el tipo de aglutinante utilizado en tabletas de ampicilina de 500 mg en el porcentaje de friabilidad; para ello, se eligen los siguientes aglutinantes: polivinilpirrolidona (PVP), carboximetilcelulosa sódica (CMC) y grenetina (Gre). Los resultados del diseño experimental son los siguientes2.
Aglutinante
PVP 0.485 0.250 0.073 0.205 0.161
CMC 9.64 9.37 9.53 9.86 9.79
Gre 0.289 0.275 0.612 0.152 0.137
  1. Especifique el nombre del diseño experimental.
  2. ¿Sospecha que hay algún efecto significativo del tipo de aglutinante sobre la variable de respuesta?
  3. Escriba las hipótesis para probar la igualdad de medias y el modelo estadístico.
  4. Realice el análisis adecuado para probar las hipótesis e interprete los resultados.
  5. Revise los supuestos, ¿hay algún problema?

Solución

  1. Espcifique el nombre del diseño experimental.

El diseño experimental es un diseño completamente al azar.

  1. ¿Sospecha que hay algún efecto significativo del tipo de aglutinante sobre la variable de respuesta?

Para determinar si hay un efecto significativo del tipo de aglutinante sobre la variable de respuesta, se puede realizar un análisis descriptivo. A continuación, se presenta el análisis descriptivo.

# Load the data
data_binder <- data.frame(
  pvp = c(0.485, 0.250, 0.073, 0.205, 0.161),
  cmc = c(9.64, 9.37, 9.53, 9.86, 9.79),
  gre = c(0.289, 0.275, 0.612, 0.152, 0.137)
)

# Apply the summary_stats function to each binder variable
binder_summary <- do.call(rbind, lapply(list(data_binder$pvp,data_binder$cmc,data_binder$gre), summary_stats))
binder_summary$variable <- as.vector(levels(stack(data_binder)$ind))
binder_summary
##   variable   mean median  mode        sd        cv
## 1      pvp 0.2348  0.205 0.073 0.1543898 65.753734
## 2      cmc 9.6380  9.640 9.370 0.1974082  2.048228
## 3      gre 0.2930  0.275 0.137 0.1912577 65.275659

De acuerdo con el análisis descriptivo, se observa que el porcentaje de friabilidad promedio de los tres tipos de aglutinantes es diferente. Por lo tanto, se puede concluir que las diferencias muestrales hacen obvia la presencia de diferencias poblacionales.

La desviación estándar y el coeficiente de variación también pueden indicar la variabilidad en los datos. Si la desviación estándar es grande en comparación con la media, podría indicar una variabilidad significativa.

  1. Escriba las hipótesis para probar la igualdad de medias y el modelo estadístico.

Las hipótesis para probar la igualdad de medias son:

  • Hipotesis nula: \[ H_0: \mu_1 = \mu_2 = \mu_3, \] es decir, no hay diferencias significativas entre los tipos de aglutinantes.

  • Hipotesis alternativa: \[ H_1: \mu_1 \neq \mu_2 \neq \mu_3, \] es decir, hay diferencias significativas entre los tipos de aglutinantes.

El modelo estadístico es:

\[ Y_{ij} = \mu + \tau_i + \varepsilon_{ij}, \]

Donde:

  • \(Y_{ij}\) es la observación
  • \(\mu\) es la media general
  • \(\tau_i\) es el efecto del tipo de aglutinante
  • \(\varepsilon_{ij}\) es el error aleatorio
  1. Realice el análisis adecuado para probar las hipótesis e interprete los resultados.

Para realizar el análisis adecuado, se puede realizar un análisis de varianza. A continuación, se presenta el análisis de varianza.

# Anova

model_binder <- aov(stack(data_binder)$values ~ stack(data_binder)$ind, data = stack(data_binder))

summary(model_binder)
##                        Df Sum Sq Mean Sq F value Pr(>F)    
## stack(data_binder)$ind  2  292.9  146.46    4421 <2e-16 ***
## Residuals              12    0.4    0.03                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

El análisis de varianza muestra que el valor p es menor que 0.05. Por lo tanto, se puede rechazar la hipótesis nula y concluir que hay diferencias significativas entre los tipos de aglutinantes.

# Tukey's test

TukeyHSD(model_binder)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = stack(data_binder)$values ~ stack(data_binder)$ind, data = stack(data_binder))
## 
## $`stack(data_binder)$ind`
##            diff        lwr        upr     p adj
## cmc-pvp  9.4032  9.0960893  9.7103107 0.0000000
## gre-pvp  0.0582 -0.2489107  0.3653107 0.8700427
## gre-cmc -9.3450 -9.6521107 -9.0378893 0.0000000

Del test Tukey, se encontraron diferencias significativas en el porcentaje de friabilidad entre tabletas con aglutinantes CMC y PVP, así como entre Gre y CMC. Sin embargo, no hubo evidencia de una diferencia significativa entre tabletas con aglutinante Gre y PVP.

  1. Revise los supuestos, ¿hay algún problema?

Para revisar los supuestos, se puede realizar un análisis de residuos. A continuación, se presenta el análisis de residuos.

# Residuals analysis

par(mfrow = c(2, 2))

plot(model_binder)

El análisis de residuos muestra que los residuos no tienen un patrón claro. Por lo tanto, se puede concluir que los supuestos del análisis de varianza se cumplen.

Gráficos

# Boxplot

boxplot(stack(data_binder)$values ~ stack(data_binder)$ind, data = stack(data_binder), xlab = "Binder", ylab = "Friability (%)", main = "Friability by Binder")

El gráfico de caja muestra que el porcentaje de friabilidad promedio de los tres tipos de aglutinantes es diferente. El cmc tiene el mayor porcentaje de friabilidad, seguido por el pvp y el gre.

Ejercicio 18

  1. Se cultivaron cuatro diferentes clonas de agave tequilana bajo un mismo esquema de manejo. Se quiere saber qué clona es la que responde mejor a dicho manejo, evaluando el nivel de respuesta con el porcentaje de azúcares reductores totales en base húmeda. Los datos se muestran a continuación3:
1 2 3 4
8.69 8.00 17.39 10.37
6.68 16.41 13.73 9.16
6.83 12.43 15.62 8.13
6.43 10.99 17.05 4.40
10.30 15.53 15.42 10.38

  1. Mediante ANOVA, compare las medias de las clonas y verifique residuales.

  2. ¿Hay una clona que haya respondido mejor al esquema de manejo? Argumente su respuesta.

  3. En caso de que exista un empate estadístico entre dos o más clonas, ¿qué propondría para desempatar?

Solución

  1. Mediante ANOVA, compare las medias de las clonas y verifique residuales.

Para comparar las medias de las clonas, se puede realizar un análisis de varianza, donde tiene como hipótesis nula,

\(H_0: \mu_1 = \mu_2 = \mu_3 = \mu_4,\) es decir, no hay diferencias significativas entre las medias de las clonas.

E hipotesis alternativa,

\(H_1: \mu_1 \neq \mu_2 \neq \mu_3 \neq \mu_4,\) es decir, hay diferencias significativas entre las medias de las clonas.

A continuación, se presenta el análisis de varianza.

# Load the data
data_agave <- data.frame(
  clona1 = c(8.69, 6.68, 6.83, 6.43, 10.30),
  clona2 = c(8.00, 16.41, 12.43, 10.99, 15.53),
  clona3 = c(17.39, 13.73, 15.62, 17.05, 15.42),
  clona4 = c(10.37, 9.16, 8.13, 4.40, 10.38)
)

# Order the dataframe
data_agave <- stack(data_agave)

# Anova

model_agave <- aov(data_agave$values ~ data_agave$ind, data = data_agave)

summary(model_agave)
##                Df Sum Sq Mean Sq F value   Pr(>F)    
## data_agave$ind  3 213.63   71.21   12.53 0.000181 ***
## Residuals      16  90.93    5.68                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

El análisis de varianza muestra que el valor p es menor que 0.05. Por lo tanto, se puede rechazar la hipótesis nula y concluir que hay diferencias significativas entre las medias de las clonas.

# Residuals analysis

par(mfrow = c(2, 2))

plot(model_agave)

El análisis de residuos muestra que los residuos no tienen un patrón claro. Por lo tanto, se puede concluir que los supuestos del análisis de varianza se cumplen.

# Tukey's test

TukeyHSD(model_agave)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = data_agave$values ~ data_agave$ind, data = data_agave)
## 
## $`data_agave$ind`
##                 diff         lwr        upr     p adj
## clona2-clona1  4.886   0.5724502  9.1995498 0.0237858
## clona3-clona1  8.056   3.7424502 12.3695498 0.0003472
## clona4-clona1  0.702  -3.6115498  5.0155498 0.9655112
## clona3-clona2  3.170  -1.1435498  7.4835498 0.1943027
## clona4-clona2 -4.184  -8.4975498  0.1295498 0.0588980
## clona4-clona3 -7.354 -11.6675498 -3.0404502 0.0008694

  • Clona 2 vs. Clona 1: Hay una diferencia significativa entre la clona 2 y la clona 1 en términos de porcentaje de azúcares reductores. La clona 2 muestra una respuesta positiva al manejo en comparación con la clona 1.

  • Clona 3 vs. Clona 1: Existe una diferencia altamente significativa entre la clona 3 y la clona 1 en cuanto al porcentaje de azúcares reductores. La clona 3 muestra una respuesta considerablemente mejor al manejo en comparación con la clona 1.

  • Clona 4 vs. Clona 1: No hay una diferencia significativa entre la clona 4 y la clona 1 en términos de respuesta al manejo. La clona 4 no muestra una mejora significativa ni una disminución en comparación con la clona 1.

  • Clona 3 vs. Clona 2: Aunque hay una diferencia, no es estadísticamente significativa.

  • Clona 4 vs. Clona 2: La diferencia no es altamente significativa pero se acerca al umbral convencional de significancia.

  • Clona 4 vs. Clona 3: Existe una diferencia altamente significativa, con la clona 4 mostrando una disminución significativa en comparación con la clona 3.

Basándonos en estos resultados, la clona 3 parece ser la que responde mejor al manejo, ya que muestra la mayor diferencia en el porcentaje de azúcares reductores en comparación con las otras clonas. La clona 2 también muestra una diferencia significativa en comparación con la clona 1, pero la magnitud de la diferencia es menor en comparación con la clona 3. Las clonas 4 y 1 no muestran diferencias significativas en su respuesta al manejo.

  1. En caso de que exista un empate estadístico entre dos o más clonas, ¿qué propondría para desempatar?
  • Análisis de Otras Variables: Examinar otras variables recopiladas durante el estudio que puedan no haberse tenido en cuenta inicialmente, pero que podrían influir en el rendimiento de las clonas.
  • Replicación del Estudio: Repetir el estudio con un diseño experimental similar para verificar la consistencia de los resultados. A veces, la replicación puede ayudar a confirmar o refutar las conclusiones iniciales.

Gráficos

# Boxplot

boxplot(data_agave$values ~ data_agave$ind, data = data_agave, col = "lightblue", ylab = "Porcentaje de azúcares reductores", xlab = "Clonas")

El gráfico de caja muestra que la clona 3 tiene la mediana más alta en comparación con las otras clonas. La clona 2 también tiene una mediana alta, pero no tan alta como la clona 3. Las clonas 1 y 4 tienen medianas más bajas en comparación con las clonas 2 y 3.

Ejercicio 19

  1. Uno de los defectos que causan mayor desperdicio en la manufactura de discos ópticos compactos son los llamados “cometas”. Típicamente, se trata de una partícula que opone resistencia al fluido en la etapa de entintado. Se quiere comprobar de manera experimental la efectividad de un tratamiento de limpieza de partículas que está basado en fuerza centrípeta y aire ionizado. A 12 lotes de 50 CD se les aplica el tratamiento y a otros 12 lotes no se les aplica; en cada caso se mide el porcentaje de discos que presentan cometas, los resultados son los siguientes4:
Con tratamiento Sin tratamiento
5.30 8.02
4.03 13.18
4.03 7.15
4.00 8.23
2.56 9.11
2.05 6.66
5.06 12.15
4.06 16.3
2.08 9.20
4.03 6.35
2.04 7.15
1.18 8.66
  1. Con el ANOVA vea si es efectivo el tratamiento de limpieza. ¿Debería implemen tarse?
  2. ¿Es razonable suponer en el inciso a) que las varianzas son iguales?
  3. ¿En qué porcentaje se reducen los discos con cometas?

Solución

  1. Con el ANOVA vea si es efectivo el tratamiento de limpieza. ¿Debería implementarse?
  • La hipótesis nula es,

\(H_0: \mu_1 = \mu_2,\) es decir, no hay diferencias significativas entre las medias de los lotes con y sin tratamiento.

  • La hipótesis alternativa es,

\(H_1: \mu_1 \neq \mu_2,\) es decir, hay diferencias significativas entre las medias de los lotes con y sin tratamiento.

A continuación, se presenta el análisis de varianza.

# Load the data

data_cd <- data.frame(
  con_tratamiento = c(5.30, 4.03, 4.03, 4.00, 2.56, 2.05, 5.06, 4.06, 2.08, 4.03, 2.04, 1.18),
  sin_tratamiento = c(8.02, 13.18, 7.15, 8.23, 9.11, 6.66, 12.15, 16.3, 9.20, 6.35, 7.15, 8.66)
)

# Order the dataframe

data_cd <- stack(data_cd)

# ANOVA

anova_cd<- aov(values ~ ind, data = data_cd)
summary(anova_cd)
##             Df Sum Sq Mean Sq F value   Pr(>F)    
## ind          1  214.4  214.44   39.41 2.56e-06 ***
## Residuals   22  119.7    5.44                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

El análisis de varianza muestra que el valor p es menor que 0.05. Por lo tanto, se puede rechazar la hipótesis nula y concluir que hay diferencias significativas entre las medias de los lotes con y sin tratamiento.

Para saber si se deberia implementar el tratamiento de limpieza, se debe comparar el porcentaje de discos con cometas en los lotes con y sin tratamiento. Si el porcentaje de discos con cometas es menor en los lotes con tratamiento, entonces se debería implementar el tratamiento.

# Test de comparación de medias

t.test(data_cd$values ~ data_cd$ind, var.equal = TRUE)
## 
##  Two Sample t-test
## 
## data:  data_cd$values by data_cd$ind
## t = -6.2781, df = 22, p-value = 2.559e-06
## alternative hypothesis: true difference in means between group con_tratamiento and group sin_tratamiento is not equal to 0
## 95 percent confidence interval:
##  -7.953181 -4.003486
## sample estimates:
## mean in group con_tratamiento mean in group sin_tratamiento 
##                      3.368333                      9.346667

El test de comparación de medias muestra que el porcentaje de discos con cometas es significativamente menor en los lotes con tratamiento en comparación con los lotes sin tratamiento. Por lo tanto, se debería implementar el tratamiento de limpieza.

  1. ¿Es razonable suponer en el inciso a) que las varianzas son iguales?

Para verificar si las varianzas son iguales, se puede realizar una prueba de igualdad de varianzas.

library(car)
## Warning: package 'car' was built under R version 4.2.2
## Loading required package: carData
## Warning: package 'carData' was built under R version 4.2.1
# Test de igualdad de varianzas

var.test(data_cd$values ~ data_cd$ind)
## 
##  F test to compare two variances
## 
## data:  data_cd$values by data_cd$ind
## F = 0.19329, num df = 11, denom df = 11, p-value = 0.01119
## alternative hypothesis: true ratio of variances is not equal to 1
## 95 percent confidence interval:
##  0.0556440 0.6714331
## sample estimates:
## ratio of variances 
##          0.1932905
# Test de Levene

leveneTest(data_cd$values ~ data_cd$ind)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  1  2.0562 0.1656
##       22

Ambos tests muestran que las varianzas no son iguales. Por lo tanto, no es razonable suponer que las varianzas son iguales.

  1. ¿En qué porcentaje se reducen los discos con cometas?

Para calcular el porcentaje de reducción de los discos con cometas, se puede utilizar la siguiente fórmula,

\(\%\ de\ reducción = \frac{\%\ de\ cometas\ sin\ tratamiento - \%\ de\ cometas\ con\ tratamiento}{\%\ de\ cometas\ sin\ tratamiento} \times 100\)

# Porcentaje de reducción

porcentaje_reduccion <- (mean(data_cd$values[data_cd$ind == "sin_tratamiento"]) - mean(data_cd$values[data_cd$ind == "con_tratamiento"]))/mean(data_cd$values[data_cd$ind == "sin_tratamiento"]) * 100
porcentaje_reduccion
## [1] 63.9622

El porcentaje de reducción de los discos con cometas es del 63.96%. Por lo tanto, el tratamiento de limpieza reduce el porcentaje de discos con cometas en un 63.96%.

Gráficos

# Gráfico de cajas

boxplot(data_cd$values ~ data_cd$ind, col = c("lightblue", "lightgreen"), ylab = "Porcentaje de discos con cometas", xlab = "Tratamiento", main = "Porcentaje de discos con cometas por tratamiento")

El gráfico de cajas muestra que el porcentaje de discos con cometas es menor en los lotes con tratamiento en comparación con los lotes sin tratamiento. Por lo tanto, se debería implementar el tratamiento de limpieza.

  1. Ejercicio extraido del libro Análisis y diseño de experimentos.

    Gutiérrez Pulido, H., & Vara Salazar, R. d. l. (2012). Análisis y diseño de experimentos (3a. ed. --.). México D.F.: McGrawHill.↩︎

  2. Ejercicio extraido del libro Análisis y diseño de experimentos.

    Gutiérrez Pulido, H., & Vara Salazar, R. d. l. (2012). Análisis y diseño de experimentos (3a. ed. --.). México D.F.: McGrawHill.↩︎

  3. Ejercicio extraido del libro Análisis y diseño de experimentos.

    Gutiérrez Pulido, H., & Vara Salazar, R. d. l. (2012). Análisis y diseño de experimentos (3a. ed. --.). México D.F.: McGrawHill.↩︎

  4. Ejercicio extraido del libro Análisis y diseño de experimentos.

    Gutiérrez Pulido, H., & Vara Salazar, R. d. l. (2012). Análisis y diseño de experimentos (3a. ed. --.). México D.F.: McGrawHill.↩︎