Parcial Diseño 2

Los ejercicios realizados se desarrollaron en base al libro de Diseño de Experimentos Métodos y Aplicaciones, de los autores Oscar O. Melo, Luis A. López y Sandra E. Melo, publicado en la Universidad Nacional de Colombia-Facultad de Ciencias.

Diseño en Bloques Completos Aleatorizados

La palabra bloque se refiere al hecho de que se ha agrupado a las unidades experimentales en función de alguna variable extraña; aleatorizado se refiere al hecho de que los tratamientos se asignan aleatoriamente dentro de los bloques; completo implica que se utiliza cada tratamiento exactamente una vez dentro de cada bloque y el término efectos fijos se aplica a bloques y tratamientos. Es decir, se supone que ni los bloques ni los tratamientos se eligen aleatoriamente. Además una caracterización de este diseño es que los efectos bloque y tratamiento son aditivos; es decir no hay interacción entre los bloques y los tratamientos (Melo, et al. 2020)

\[Y_{ijk}= \mu+ \tau_{i} + \beta_j + \epsilon_{ij}\] donde \(_i\) = 1,.., t es el número de tratamientos,

\(_j\) = 1,.., b es el número de bloques

\(_k\) = 1,..,n(ij) \((n_{ij} ≥ 1)\) es el número de réplicas

Ejemplo

Un agrónomo desea determinar el efecto de diferentes fuentes de nitrógeno en la producción de una materia seca sobre cebada forrajera. Hay cuatro fuentes de Nitrogeno a ser comparadas: (NH4)2SO4, NH4NO3, NaNO3 y CO(NH2)2. Se desean aplicar los resultados sobre un rango bastante amplio de condiciones; se hicieron ensayos sobre tres tipos de suelo. Para el diseño experimental se eligió un diseño en bloques completamente aleatorizado con los tipos de suelo como factor de bloqueo. La variable de interés es la producción (kg/parcela) de cebada bajo varias fuentes de nitrógeno.

library(agricolae)
library(car)

## Warning: package 'car' was built under R version 4.0.3

## Loading required package: carData

library(DT)
cebada<-c(32.1,30.1,26.4,27.1,26.1,23.2,35.6,31.5,27.1,40.0,31.0,30.8)
# 4 treatments (Nitrogeno) and 3  (suelo)
N <- factor(c(rep("NH4NO3",3), rep("NaNO3",3),rep("CO(NH2)2",3), rep("(NH4)2SO4",3)))
suelo <- c(rep("Tipo1",1), rep("Tipo2",1), rep("Tipo3",1)) 
pso<-data.frame(suelo,N,cebada)
View(pso)
pso1<-datatable(pso, class='cell-border stripe', filter='top', options = list(pageLength=3,autoWidth=T), rownames=FALSE);pso1

# Supuestos para aplicar anova
shapiro.test(cebada)

## 
##  Shapiro-Wilk normality test
## 
## data:  cebada
## W = 0.94564, p-value = 0.5743

library(car)
bartlett.test(cebada ~N, pso)

## 
##  Bartlett test of homogeneity of variances
## 
## data:  cebada by N
## Bartlett's K-squared = 1.5868, df = 3, p-value = 0.6624

bartlett.test(cebada ~suelo, pso)

## 
##  Bartlett test of homogeneity of variances
## 
## data:  cebada by suelo
## Bartlett's K-squared = 1.8198, df = 2, p-value = 0.4026

leveneTest(cebada ~N, pso)

## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  3  0.2133 0.8844
##        8

#rcbd <-design.rcbd(cebada,3,serie=2,986,"Wichmann-Hill") # seed = 986
anova<- aov(cebada ~ suelo+N,contrasts=list(N="contr.sum",
suelo="contr.sum"),data=pso)
summary(anova)

##             Df Sum Sq Mean Sq F value  Pr(>F)   
## suelo        2  94.16   47.08   12.76 0.00690 **
## N            3 114.52   38.17   10.35 0.00872 **
## Residuals    6  22.14    3.69                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

summary(lm(anova))

## 
## Call:
## lm(formula = anova)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.5250 -1.0604  0.2917  0.9500  2.4500 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   37.550      1.358  27.646 1.48e-07 ***
## sueloTipo2    -4.025      1.358  -2.963  0.02517 *  
## sueloTipo3    -6.825      1.358  -5.025  0.00239 ** 
## NCO(NH2)2     -2.533      1.568  -1.615  0.15738    
## NNaNO3        -8.467      1.568  -5.398  0.00167 ** 
## NNH4NO3       -4.400      1.568  -2.805  0.03094 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.921 on 6 degrees of freedom
## Multiple R-squared:  0.9041, Adjusted R-squared:  0.8242 
## F-statistic: 11.31 on 5 and 6 DF,  p-value: 0.005178

boxplot(cebada ~ N, data=pso, id=list(method="y"))

Con base en los anteriores resultados de la tabla ANOVA se concluye que con un nivel de significancia del 5 %, el tipo de nitrógeno afecta la producción de cebada. Además, al parecer, los tipos de suelo (bloques) diferente de manera significativa, ya que el cuadrado medio es grande en relación con el cuadrado medio del error. Por lo que se procede a realizar la prueba de Tukey para analizar la dispersión de los datos entre los tratamientos, es decir las aplicaciones de Nitrogeno.

Después de haber rechazado la Hipótesis nula de las medias iguales por el ANOVA, esto permite comparar las medias de los t niveles de un factor.

Prueba de Tukey

Sirve para probar todas las diferencias entre medias de tratamientos de una experiencia. La única exigencia es que el número de repeticiones sea constante en todos los tratamientos.

TukeyHSD(anova,"N", 0.95)

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
##     factor levels have been ordered
## 
## Fit: aov(formula = cebada ~ suelo + N, data = pso, contrasts = list(N = "contr.sum", suelo = "contr.sum"))
## 
## $N
##                        diff        lwr       upr     p adj
## NH4NO3-NaNO3       4.066667 -1.3626111  9.495944 0.1404481
## CO(NH2)2-NaNO3     5.933333  0.5040556 11.362611 0.0347041
## (NH4)2SO4-NaNO3    8.466667  3.0373889 13.895944 0.0066832
## CO(NH2)2-NH4NO3    1.866667 -3.5626111  7.295944 0.6539780
## (NH4)2SO4-NH4NO3   4.400000 -1.0292778  9.829278 0.1086597
## (NH4)2SO4-CO(NH2)2 2.533333 -2.8959444  7.962611 0.4370135

tabla.medias <- model.tables(anova, type = "mean");tabla.medias

## Tables of means
## Grand mean
##          
## 30.08333 
## 
##  suelo 
## suelo
## Tipo1 Tipo2 Tipo3 
## 33.70 29.68 26.88 
## 
##  N 
## N
## (NH4)2SO4  CO(NH2)2     NaNO3    NH4NO3 
##     33.93     31.40     25.47     29.53

media.dietas <- mean(tabla.medias$tables$N); media.dietas

## [1] 30.08333

Prueba de Duncan

La prueba del rango múltiple prueba las diferencias entre las medias empezando con la media más grande contra la segunda más grande, y así sucesivamente, comparando en cada caso con un valor crítico obtenido por tablas.

duncan.test(anova,"N", group=TRUE,console=TRUE,main="N")

## 
## Study: N
## 
## Duncan's new multiple range test
## for cebada 
## 
## Mean Square Error:  3.689722 
## 
## N,  means
## 
##             cebada      std r  Min  Max
## (NH4)2SO4 33.93333 5.254839 3 30.8 40.0
## CO(NH2)2  31.40000 4.250882 3 27.1 35.6
## NaNO3     25.46667 2.025669 3 23.2 27.1
## NH4NO3    29.53333 2.891943 3 26.4 32.1
## 
## Alpha: 0.05 ; DF Error: 6 
## 
## Critical Range
##        2        3        4 
## 3.837687 3.977469 4.046711 
## 
## Means with the same letter are not significantly different.
## 
##             cebada groups
## (NH4)2SO4 33.93333      a
## CO(NH2)2  31.40000     ab
## NH4NO3    29.53333      b
## NaNO3     25.46667      c

Prueba de Scheffe

La prueba de Scheffé es una prueba que se aplica para hacer comparaciones múltiples de las medias de grupos.

scheffe.test(anova,"N",group=TRUE,console=TRUE,main="N")

## 
## Study: N
## 
## Scheffe Test for cebada 
## 
## Mean Square Error  : 3.689722 
## 
## N,  means
## 
##             cebada      std r  Min  Max
## (NH4)2SO4 33.93333 5.254839 3 30.8 40.0
## CO(NH2)2  31.40000 4.250882 3 27.1 35.6
## NaNO3     25.46667 2.025669 3 23.2 27.1
## NH4NO3    29.53333 2.891943 3 26.4 32.1
## 
## Alpha: 0.05 ; DF Error: 6 
## Critical Value of F: 4.757063 
## 
## Minimum Significant Difference: 5.924903 
## 
## Means with the same letter are not significantly different.
## 
##             cebada groups
## (NH4)2SO4 33.93333      a
## CO(NH2)2  31.40000      a
## NH4NO3    29.53333     ab
## NaNO3     25.46667      b

Cuadrado latino

El diseño en cuadrado latino (DCL) es un diseño factorial Simple en Bloques Incompletos y Aleatorizados (Doble Bloqueo), se usa para eliminar dos fuentes de variabilidad, es decir, permite hacer la formación de bloques sistemática en dos direcciones (en el sentido de las filas y las columnas). Por lo tanto, las filas y las columnas representan en realidad dos restricciones sobre la aleatorización.

\[y_{ijk}=\mu+\alpha_i+\beta_j+\gamma_j+\epsilon_{ijk}\]

Ejemplo

Un investigador quiere evaluar la productividad de cuatro variedades de aguacates, A, B, C y D. Para ello decide realizar el ensayo en un terreno que posee un gradiente de pendiente de oriente a occidente y además, diferencias en la disponibilidad de Fosforo de norte a sur, para controlar los efectos de la pendiente y la disponibilidad de Nitrógeno, utilizó un diseño de cuadrado latino, los datos corresponden a la producción en kg/parcela.

Variable respuesta: Productividad

Factor: Variedad de aguacate; se establecen los niveles concretos que se van a analizar.

Bloques: Disponibilidad de Fosforo y Pendiente, ambos con 4 niveles y ambos de efectos fijos.

# series de Cuadrados Latinos 
Agte<-factor(c(rep((LETTERS[1:4]))))
Fosf<- factor(c(rep("Fosforo1",4), rep("Fosforo2",4), rep("Fosforo3",4), rep("Fosforo4",4)))
pendiente<-factor(c(rep("Pend1",1), rep("Pend2",1), rep("Pend3",1), rep("Pend4",1)))
produc<-c(785,730,700,595,855,775,760,710,950,885,795,780,945,950,880,835)
df.lsd <-data.frame(Fosf,pendiente,Agte,produc)
library(DT)
df.lsd1<-datatable(df.lsd, class='cell-border stripe', filter='top', options = list(pageLength=10,autoWidth=T), rownames=FALSE, colnames = c("Fosforo", "Pendiente", "Aguacate", "Produccion"));df.lsd1

#Supuersto para uso de ANOVA
shapiro.test(produc)

## 
##  Shapiro-Wilk normality test
## 
## data:  produc
## W = 0.95734, p-value = 0.6139

plot(produc)

#Respuesta~Bloque1+Bloque2+Factor

model=lm(produc ~ Fosf + pendiente + Agte, contrasts=list(Fosf="contr.sum", pendiente="contr.sum", Agte="contr.sum"),data=df.lsd)
anova(model)

## Analysis of Variance Table
## 
## Response: produc
##           Df Sum Sq Mean Sq F value    Pr(>F)    
## Fosf       3  92519 30839.6  48.962 6.741e-06 ***
## pendiente  3  52556 17518.7  27.814 6.957e-05 ***
## Residuals  9   5669   629.9                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

boxplot(produc ~ Agte, data=df.lsd)

# Prueba de Tukey para comparaciones múltiples y el gráfico correspondiente
tuk<-TukeyHSD(aov(model),which ="pendiente", 0.95, ordered=TRUE)
tuk

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
##     factor levels have been ordered
## 
## Fit: aov(formula = model)
## 
## $pendiente
##               diff       lwr      upr     p adj
## Pend3-Pend4  53.75 -1.650324 109.1503 0.0575123
## Pend2-Pend4 105.00 49.599676 160.4003 0.0010456
## Pend1-Pend4 153.75 98.349676 209.1503 0.0000560
## Pend2-Pend3  51.25 -4.150324 106.6503 0.0710796
## Pend1-Pend3 100.00 44.599676 155.4003 0.0014808
## Pend1-Pend2  48.75 -6.650324 104.1503 0.0877758

A la vista de los p-valores, todos ellos inferiores a 0.05, podemos afirmar que todos los efectos son significativos. Tanto las variedades de aguacates utilizadas, como la pendiente del terreno y la disponibilidad de fosforo influyen en la productividad de los aguacates.

# Prueba LSD de Fisher
#Diseños en cuadro latino y análisis de covarianza 
lsd<-LSD.test(model,"Agte",group=TRUE,console=TRUE,main="Agte") 

## 
## Study: Agte
## 
## LSD t Test for produc 
## 
## Mean Square Error:  629.8611 
## 
## Agte,  means and individual ( 95 %) CI
## 
##   produc       std r      LCL      UCL Min Max
## A 883.75  78.99103 4 855.3633 912.1367 785 950
## B 835.00 100.58164 4 806.6133 863.3867 730 950
## C 783.75  75.20804 4 755.3633 812.1367 700 880
## D 730.00 103.52133 4 701.6133 758.3867 595 835
## 
## Alpha: 0.05 ; DF Error: 9
## Critical Value of t: 2.262157 
## 
## least Significant Difference: 40.14488 
## 
## Treatments with the same letter are not significantly different.
## 
##   produc groups
## A 883.75      a
## B 835.00      b
## C 783.75      c
## D 730.00      d

print(lsd)

## $statistics
##    MSerror Df    Mean       CV  t.value      LSD
##   629.8611  9 808.125 3.105588 2.262157 40.14488
## 
## $parameters
##         test p.ajusted name.t ntr alpha
##   Fisher-LSD      none   Agte   4  0.05
## 
## $means
##   produc       std r      LCL      UCL Min Max    Q25   Q50    Q75
## A 883.75  78.99103 4 855.3633 912.1367 785 950 837.50 900.0 946.25
## B 835.00 100.58164 4 806.6133 863.3867 730 950 763.75 830.0 901.25
## C 783.75  75.20804 4 755.3633 812.1367 700 880 745.00 777.5 816.25
## D 730.00 103.52133 4 701.6133 758.3867 595 835 681.25 745.0 793.75
## 
## $comparison
## NULL
## 
## $groups
##   produc groups
## A 883.75      a
## B 835.00      b
## C 783.75      c
## D 730.00      d
## 
## attr(,"class")
## [1] "group"

# Prueba de Scheffe
scheffe.test(model,"Agte",group=TRUE,console=TRUE,main="Agte")

## 
## Study: Agte
## 
## Scheffe Test for produc 
## 
## Mean Square Error  : 629.8611 
## 
## Agte,  means
## 
##   produc       std r Min Max
## A 883.75  78.99103 4 785 950
## B 835.00 100.58164 4 730 950
## C 783.75  75.20804 4 700 880
## D 730.00 103.52133 4 595 835
## 
## Alpha: 0.05 ; DF Error: 9 
## Critical Value of F: 3.862548 
## 
## Minimum Significant Difference: 60.40947 
## 
## Means with the same letter are not significantly different.
## 
##   produc groups
## A 883.75      a
## B 835.00     ab
## C 783.75     bc
## D 730.00      c

Diseño Cuadrado greco-latino

Modelo

\[y_{ijhp}=\mu+\tau_i+\beta_j+\gamma_h+\delta_p+\epsilon_{ij(hp)}\]

A diferencia del cuadrado latino normal, este incluye una tercera variable de control o variable de bloque. En otras palabras se podria decir que es la superposición de dos cuadrados latino de la misma magnitud, donde las letras aparecen juntas una sola vez en el cuadrado resultante. Su nombre al venir de un diseño consistente en un arreglo cuadrado de n letras latinas y n letras griegas.

Es una fracción del diseño completo en bloques aleatorizados con un factor principal y tres factores secundarios que requeriría K4 observaciones. Se pueden construir cuadrados grecolatinos para todo número de tratamientos mayores o iguales a 3, excepto para 6. Teóricamente, es posible utilizar estos diseños para cualquier t, siempre y cuando t sea un número primo o la potencia de un número primo.

Ejemplo

Se presenta un experimento, en que se probaron cuatro métodos distintos, A, B, C y D, para preparar mezclas de sustrato. Consistieron los métodos de dos relaciones de sustrato y materia organica, y dos duraciones de mezclado. Los cuatro métodos fueron controlados por cuatro lotes durante cuatro días. El sustrato se coló en macetas y se midió la resistencia a la compresión en kg/cm2, además se tiene que la máquina con la cual se prepara el mismo podría ser importante.

-Variable respuesta: resistencia

-Factor: Metodo,maquina

-Bloques: dias, lote

graec <- data.frame(dia=factor(c(rep(1,4),rep(2,4),rep(3,4),rep(4,4))), lote=factor(rep(c(1,2,3,4),4)), metodo=factor(c(1,2,3,4,2,1,4,3,3,4,1,2,4,3,2,1)),
maquina=factor(c(1,2,3,4,4,3,2,1,2,1,4,3,3,4,1,2)),
resistencia=c(303,299,290,290,280,321,313,282,275,315,319,300,304,293,295,305))

design.graeco(graec$metodo, graec$maquina, serie=2, seed=0)

## not implemented design  16 x 16 , see help(design.graeco)

## NULL

anova3<- lm(resistencia ~ dia+lote+metodo+maquina,data=graec)
summary(aov(anova3))

##             Df Sum Sq Mean Sq F value Pr(>F)  
## dia          3   91.5    30.5   0.741 0.5944  
## lote         3  745.5   248.5   6.036 0.0870 .
## metodo       3 1750.0   583.3  14.170 0.0282 *
## maquina      3  143.5    47.8   1.162 0.4524  
## Residuals    3  123.5    41.2                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# Prueba LSD de Fisher
LSD.test(anova3,"metodo", group=TRUE,console=TRUE,main="Máquina")

## 
## Study: Máquina
## 
## LSD t Test for resistencia 
## 
## Mean Square Error:  41.16667 
## 
## metodo,  means and individual ( 95 %) CI
## 
##   resistencia       std r      LCL      UCL Min Max
## 1       312.0  9.309493 4 301.7905 322.2095 303 321
## 2       293.5  9.255629 4 283.2905 303.7095 280 300
## 3       285.0  8.124038 4 274.7905 295.2095 275 293
## 4       305.5 11.387127 4 295.2905 315.7095 290 315
## 
## Alpha: 0.05 ; DF Error: 3
## Critical Value of t: 3.182446 
## 
## least Significant Difference: 14.4384 
## 
## Treatments with the same letter are not significantly different.
## 
##   resistencia groups
## 1       312.0      a
## 4       305.5     ab
## 2       293.5     bc
## 3       285.0      c

# Prueba de Tukey para comparaciones múltiples y el gráfico correspondiente
TukeyHSD(aov(anova3),which="metodo",ordered=TRUE)

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
##     factor levels have been ordered
## 
## Fit: aov(formula = anova3)
## 
## $metodo
##     diff        lwr      upr     p adj
## 2-3  8.5 -13.393509 30.39351 0.3925651
## 4-3 20.5  -1.393509 42.39351 0.0594223
## 1-3 27.0   5.106491 48.89351 0.0283529
## 4-2 12.0  -9.893509 33.89351 0.2103492
## 1-2 18.5  -3.393509 40.39351 0.0773241
## 1-4  6.5 -15.393509 28.39351 0.5604919

plot(TukeyHSD(aov(anova3),which="metodo",ordered=TRUE))

Se encuentro que los métodos diferen ya que rechaza la hipotesis nula de igualdad de medias en los grupos al ser 2.8% (Fm = 14.17 > F(3,3,0.05) = 9.277). Asimismo, al parecer los días y las máquinas no difieren en dicha resistencia, observando que el cuadrado medio es pequeño en relación con el del error, por el contrario los lotes se encuentran cercanos a que difieran.

# Prueba de Scheffe
scheffe.test(anova3,"metodo",group=TRUE,console=TRUE,main="Máquina")

## 
## Study: Máquina
## 
## Scheffe Test for resistencia 
## 
## Mean Square Error  : 41.16667 
## 
## metodo,  means
## 
##   resistencia       std r Min Max
## 1       312.0  9.309493 4 303 321
## 2       293.5  9.255629 4 280 300
## 3       285.0  8.124038 4 275 293
## 4       305.5 11.387127 4 290 315
## 
## Alpha: 0.05 ; DF Error: 3 
## Critical Value of F: 9.276628 
## 
## Minimum Significant Difference: 23.9339 
## 
## Means with the same letter are not significantly different.
## 
##   resistencia groups
## 1       312.0      a
## 4       305.5     ab
## 2       293.5     ab
## 3       285.0      b

Prueba de Kruskal-Wallis

Es un método no paramétrico para probar si un grupo de datos proviene de la misma población, es idéntico al ANOVA cambiando que los datos son reemplazados por categorías. Al ser una prueba no parametrica no asume normalidad en los datos, en oposición al tradicional ANOVA. Asimismo, asume la hipótesis nula de que los datos vienen de la misma distribución (Wikipedia).

Las técnicas no paramétricas desarrolladas para el problema de t-muestras no requieren otro supuesto más que el de continuidad. La estrategia básica de la prueba de Kruskal-Wallis es asignar rangos a las n observaciones y comparar la suma de los rangos por muestra (columna o tratamiento).

Ejemplo

En un estudio experimental, se quieren comparar tres fertilizantes con un contenido de potasio diferente, la finalidad es medir el rendimiento en plantas de tomate. Se consideraron 5 plantas con el fertilizante tipo A, 4 con el tipo B y 4 con el C.

tomate <- data.frame(replicacion=factor(c(seq(1,5),seq(1,4),seq(1,4))),frt=factor(c(rep(1,5),rep(2,4),rep(3,4))), rdto=c(172,169,180,172,178,175,164,150,161,160,160,150,148))
View(tomate)
# Prueba de Kruskal-Wallis
moddca<-kruskal.test(tomate$rdto, tomate$frt)
print(moddca)

## 
##  Kruskal-Wallis rank sum test
## 
## data:  tomate$rdto and tomate$frt
## Kruskal-Wallis chi-squared = 7.8731, df = 2, p-value = 0.01952

Para r1 = 5, r2 = r3 = 4, se rechaza la hipótesis de igualdad de los tres fertilizantes, ya que se obtuvo un p-valor de 0.0195 menor al 5%. Se rechaza también la hipótesis de que los rendiemientos promedio son iguales para las tres fertilizantes.

# comparaciones múltiples no paramétricas
library(pgirmess)

## Warning: package 'pgirmess' was built under R version 4.0.3

kruskalmc(tomate$rdto, tomate$frt)

## Multiple comparison test after Kruskal-Wallis 
## p.value: 0.05 
## Comparisons
##     obs.dif critical.dif difference
## 1-2   3.775     6.254201      FALSE
## 1-3   7.275     6.254201       TRUE
## 2-3   3.500     6.592506      FALSE

Debido a que la prueba de Kruskal-Walis rechazo la igual entre los tres fertilizantes de procede a realizar la prueba kruskalmc que ayuda a determinar cuales fertilizantes son diferentes. Se encuentra que el grupo 2 presenta una fuerte diferencia.

Bloques incompletos balanceados

Es un diseño por bloques incompletos en el que cualquier par de tratamientos ocurren juntos el mismo número de veces. En este tipo de diseño, el análisis estadístico se centra en la información intra-bloque, en donde para estimar el efecto de los tratamientos, se considera inicialmente la estimación de las parcelas dentro del mismo bloque (Gomez, 2010).

Se resalta los diseños en bloques incompletos balanceados (DBIB), los cuales fueron introducidos por Yates (1936). Lo que lo caracteriza es:

1. Cada bloque contiene k unidades experimentales.
2. Hay más tratamientos que unidades experimentales en un bloque.
3. Cada tratamiento aparece exactamente en r bloques.
4. Cada par de tratamientos ocurre justo en el mismo número de bloques lamda veces.

Ejemplo

Suponga que un ingeniero químico piensa que el tiempo de reacción de un proceso químico es una función del tipo de catalizador empleado. Se están investigando cuatro catalizadores, en cuatro lotes de materia prima, y se observa el tiempo de reacción (Montgomery 2003). En este conjunto de datos, se tiene r = 3, k = 3.

Variable respuesta: Tiempo de reacción

Factor: Catalizador

Bloques: Lotes

rct <- data.frame(lote=factor(c(1,1,1,2,2,2,3,3,3,4,4,4)),catalizador=factor(c(1,3,4,1,2,3,2,3,4,1,2,4)), tiempo=c(73,73,75,74,75,75,67,68,72,71,72,75))

library(ibd)

## Warning: package 'ibd' was built under R version 4.0.3

bibd(4,4,3,3,2,pbar=FALSE)

## $v
## [1] 4
## 
## $b
## [1] 4
## 
## $r
## [1] 3
## 
## $k
## [1] 3
## 
## $lambda
## [1] 2
## 
## $design
##         [,1] [,2] [,3]
## Block-1    1    3    4
## Block-2    2    3    4
## Block-3    1    2    4
## Block-4    1    2    3
## 
## $N
##      [,1] [,2] [,3] [,4]
## [1,]    1    0    1    1
## [2,]    0    1    1    1
## [3,]    1    1    0    1
## [4,]    1    1    1    0
## 
## $NNP
##      [,1] [,2] [,3] [,4]
## [1,]    3    2    2    2
## [2,]    2    3    2    2
## [3,]    2    2    3    2
## [4,]    2    2    2    3
## 
## $Aeff
## [1] 1
## 
## $Deff
## [1] 1

# Maneras de realizar la prueba de ANOVA
# Manual
anov_rct <- aov(tiempo ~ lote + catalizador,data=rct)
summary(anov_rct)

##             Df Sum Sq Mean Sq F value  Pr(>F)   
## lote         3  55.00  18.333   28.20 0.00147 **
## catalizador  3  22.75   7.583   11.67 0.01074 * 
## Residuals    5   3.25   0.650                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# library(ibd)
aov.ibd(tiempo~factor(catalizador)+factor(lote),data=rct)

## $ANOVA.table
## Anova Table (Type III tests)
## 
## Response: tiempo
##                     Sum Sq Df   F value    Pr(>F)    
## (Intercept)         8948.7  1 13767.198 8.528e-10 ***
## factor(catalizador)   22.7  3    11.667 0.0107387 *  
## factor(lote)          66.1  3    33.889 0.0009528 ***
## Residuals              3.3  5                        
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

#aov.ibd(formula,specs,data,contrast,joint=FALSE,details=FALSE,sort=TRUE,by=NULL,alpha=0.05,Letters = "ABCDEFGHIJ",...)


# Prueba de Scheffe
scheffe.test(anov_rct,"catalizador",group=TRUE,console=TRUE,main="Catalizador")

## 
## Study: Catalizador
## 
## Scheffe Test for tiempo 
## 
## Mean Square Error  : 0.65 
## 
## catalizador,  means
## 
##     tiempo      std r Min Max
## 1 72.66667 1.527525 3  71  74
## 2 71.33333 4.041452 3  67  75
## 3 72.00000 3.605551 3  68  75
## 4 74.00000 1.732051 3  72  75
## 
## Alpha: 0.05 ; DF Error: 5 
## Critical Value of F: 5.409451 
## 
## Minimum Significant Difference: 2.651846 
## 
## Means with the same letter are not significantly different.
## 
##     tiempo groups
## 4 74.00000      a
## 1 72.66667     ab
## 3 72.00000     ab
## 2 71.33333      b

# cada tratamiento aparece en 3 bloques
r <- 3
# cada bloque contiene 3 unidades experimentales
k <- 3
# número de tratamientos
t <- 4
lambda <- r*(k-1)/(t-1); lambda

## [1] 2

# Eficiencia relativa
ER <- lambda*t/(k*r); ER

## [1] 0.8888889

Se concluye que el tipo de catalizador empleado tiene un efecto diferente sobre el tiempo de reacción, ya que es menor del 5%, por lo que se rechaza la Hipótesis nula de igualdad de tratamientos. Asimismo, se concluye que los lotes de materia prima (bloques) difieren sobre el tiempo de reacción.

Para comprobar la hipótesis

\[H_0 : \tau_1 = \tau_2 = \tau_3 = \tau_4\] se construyen las diferentes sumas de cuadrados con base en la estructura de las siguientes matrices:

R <- diag(c(3,3,3,3),4)
K <- diag(c(3,3,3,3),4)
N <- matrix(c(1,0,1,1,1,1,1,0,0,1,1,1,1,1,0,1),nrow=4,byrow=F)
inversaK<-solve(K)
NinversaKtN<-N%*%inversaK%*%t(N)
C <- R-N%*%solve(K)%*%t(N)
# I <- diag(4)
# J <- matrix(1:1,nrow=4,ncol=4, byrow=T)
# C <- 2/3*(4*I-J)
T <- matrix(c(218,214,216,222),nrow=4,byrow=F)
B <- matrix(c(221,224,207,218),nrow=4,byrow=F)
NinversaK<-N%*%inversaK
NinversaKB<-N%*%inversaK%*%B
Q <- T-N%*%solve(K)%*%B
J <- matrix(1:1,nrow=4,ncol=4, byrow=T)
omega <- C+J
taoestimado <- solve(omega)%*%Q
SCTrajustado <- t(Q)%*%taoestimado

REFERENCIAS

-Lawson, J. (2014). Design and Analysis of Experiments with R (Vol. 115). CRC press. -Melo, O., López, L., & Melo, S. (2007). Diseño de Experimentos [Métodos y Aplicaciones]. Universidad Nacional de Colombia. - Gomez.(2010).DISEÑOS EN BLOQUES INCOMPLETOS. Recuperado de: http://estadistica.260mb.com/Heber_DBIB.pdf?ckattempt=1&i=1 -Hoshmand, R. (2006). Design of Experiments for Agriculture and the Natural Sciences Second Edition. CRC Press. -AGRICOLAE. Recuperado de: https://coesincelejo.files.wordpress.com/2011/01/manualpracticoagricolae.pdf -Universidad de Granada.Recuperado de: http://wpd.ugr.es/~bioestad/wp-content/uploads/GrecoLatinos1.pdf http://wpd.ugr.es/~bioestad/guia-spss/practica-7/#17 -http://cursos.aiu.edu/Estadistica%20Superior/PDF/Tema%203.pdf -Wikipedia.https://es.wikipedia.org/wiki/Prueba_de_Kruskal-Wallis#:~:text=En%20estad%C3%ADstica%2C%20la%20prueba%20de,los%20datos%20reemplazados%20por%20categor%C3%ADas.