Los diseños de bloques incompletos son de gran utilidad en situaciones que no es posible desarrollar todo el experimento al mismo tiempo, ya que estos diseños agrupan los bloques de tal manera que en cada factor y tratamiento aparezcan exactamente una vez lo que permite realizar una repetición a la vez, en la práctica esto resuelve diversos problemas, como por ejemplo en el campo cuando se quiere analizar diferentes variedades de cultivos, en este caso es poco probable que se pueda realizar en un mismo lugar o en una misma temporada, lo que se busca es controlar de la variación a causa de la ubicación y el tiempo con el control que se realiza dentro de cada ubicación y tiempo.

Diseño Cuadrado Latino

Este tipo de diseño también se conoce como diseño de doble bloqueo y se caracteriza porque su número de filas, columnas y tratamientos es igual formando así un cuadrado perfecto. Adicionalmente los tratamientos no se pueden repetir al interior de la fila ni de la columna.

Las principales ventajas que contiene el diseño en cuadrado latino son:

Los supuestos estadísticos del sobre este diseño son:

Modelo:

\[y_{ijk} = \mu + \alpha_i + \beta_j + \tau_k + \epsilon_{ijk} \\ Y~sus~Condiciones~Laterales\]

Donde:

Para su desarrollo con la librería agricolae es por medio de la funcion design.lsd(…)

library(agricolae)
## Warning: package 'agricolae' was built under R version 4.0.3
str(design.lsd)
## function (trt, serie = 2, seed = 0, kinds = "Super-Duper", first = TRUE, 
##     randomization = TRUE)

Donde

Ejemplo

tomado de https://revistas.udea.edu.co/index.php/biogenesis/article/view/325966/20783263

Veamos un ejemplo sobre el efecto de probióticos en la lactancia de búfalas, se realizaran tres tratamientos (sin probiótico, probiótico 1, probiótico 2). Las filas son búfalas y las columnas son periodos de lactancia (periodos de 20 días).

library(agricolae)
trt_latino <- c("sin", "prob1", "prob2")
dis.latino <- design.lsd(trt_latino, serie = 1, kinds = "Wichmann-Hill", seed = 2020) 
dis.latino
## $parameters
## $parameters$design
## [1] "lsd"
## 
## $parameters$trt
## [1] "sin"   "prob1" "prob2"
## 
## $parameters$r
## [1] 3
## 
## $parameters$serie
## [1] 1
## 
## $parameters$seed
## [1] 2020
## 
## $parameters$kinds
## [1] "Wichmann-Hill"
## 
## $parameters[[7]]
## [1] TRUE
## 
## 
## $sketch
##      [,1]    [,2]    [,3]   
## [1,] "sin"   "prob1" "prob2"
## [2,] "prob2" "sin"   "prob1"
## [3,] "prob1" "prob2" "sin"  
## 
## $book
##   plots row col trt_latino
## 1    11   1   1        sin
## 2    12   1   2      prob1
## 3    13   1   3      prob2
## 4    21   2   1      prob2
## 5    22   2   2        sin
## 6    23   2   3      prob1
## 7    31   3   1      prob1
## 8    32   3   2      prob2
## 9    33   3   3        sin

Ahora le pondremos los nombre correspondientes de las búfalas y los periodos de tiempo, mediante la función rownames(…) y colnames(…).

rownames(dis.latino$sketch) <- c("Neodima","Itervia","Europia")
colnames(dis.latino$sketch) <- c("Primero","Segundo","Tercero")
dis.latino$Bufala <- rownames(dis.latino)
dis.latino$Periodo <- colnames(dis.latino)
dis.latino$sketch
##         Primero Segundo Tercero
## Neodima "sin"   "prob1" "prob2"
## Itervia "prob2" "sin"   "prob1"
## Europia "prob1" "prob2" "sin"

Se incluirán los resultados de producción de leche por día durante los 60 días que duro el experimento.

prod_leche <- c(5, 11,14, 13, 18, 7,  19, 6, 12)
datos1 <- cbind(dis.latino$book,prod_leche)
datos1
##   plots row col trt_latino prod_leche
## 1    11   1   1        sin          5
## 2    12   1   2      prob1         11
## 3    13   1   3      prob2         14
## 4    21   2   1      prob2         13
## 5    22   2   2        sin         18
## 6    23   2   3      prob1          7
## 7    31   3   1      prob1         19
## 8    32   3   2      prob2          6
## 9    33   3   3        sin         12

Realizaremos un gráfico boxplot de la producción de leche en relación con las búfalas, periodos de lactancia y tratamientos, con el objetivo de visualiza datos atípicos a causa de su toma o digitalización.

boxplot(datos1$prod_leche~datos1$trt_latino, ylab="Leche", xlab="Tratamiento", data = datos1)
abline(h=mean(datos1$prod_leche), col="blue")

No se notaron datos extraños, sin embargo se no evidencia una pista clara que nos indique la existencia de diferencias entre los tratamientos. Las posibilidades de las diferencias serán verificadas en el análisis de varianza.

View(datos1)
aov_latino <- aov(datos1$prod_leche~datos1$col + datos1$row + datos1$prod_leche, data = datos1)
## Warning in model.matrix.default(...): the response appeared on the right-hand
## side and was dropped
## Warning in model.matrix.default(...): problem with term 3 in model.matrix: no
## columns are assigned
summary(aov_latino)
##             Df Sum Sq Mean Sq F value Pr(>F)
## datos1$col   2   2.67    1.33   0.029  0.972
## datos1$row   2  12.67    6.33   0.137  0.876
## Residuals    4 184.67   46.17

Probando normalidad

normalidad_latino <- shapiro.test(aov_latino$residuals)
normalidad_latino
## 
##  Shapiro-Wilk normality test
## 
## data:  aov_latino$residuals
## W = 0.8969, p-value = 0.2346
ifelse(normalidad_latino$p.value > 0.05, "Presenta Normalidad", "NO Presenta Normalidad ")
## [1] "Presenta Normalidad"

Diseño En Cuadrados De Youden

Hemos analizado el diseño de cuadrado latino en el cual se tenía que cumplir con la premisa que los factores deben tener el mismo número de niveles, es decir que se tenga el mismo número de filas como de columnas. Sin embargo se presentan situaciones en las que el número de niveles disponibles en uno de los factores de control sea menor que el de tratamientos, en este caso se presentaría un diseño de cuadrado latino incompleto, estos diseños fueron estudiados y desarrollados por W.J. Youden y se conocen con el nombre de cuadros de Youden.

Un cuadro Youden se puede considerar simétrico en el que las filas corresponden a los bloques, si se asigna de la siguiente manera:

De este modo se puede decir que el cuadrado de Youden simétrico cumple con lo siguiente:

Modelo del diseño:

\[y_{ijk} = \mu + \alpha_i + \beta_j + \tau_k + \epsilon_{ijk} \\ i = 1,2...,I~;~j = 1,2...,J~;~k = 1,2...,K\\ con~I = J~y~K < I \\ Y~sus~Condiciones~Laterales \]

donde

para generar este diseño con la libreria agricolae se tiene la siguiente estructura

library(agricolae)
str(design.youden)
## function (trt, r, serie = 2, seed = 0, kinds = "Super-Duper", first = TRUE, 
##     randomization = TRUE)

Donde

Ejemplo

Consideremos que se quiere evaluar el tiempo de floración en dias de 6 tipos de semillas y se desea eliminar estadísticamente el efecto del tipo de herbicida y fertilizante, pero solo se tienen 4 tipos de fertilizante. Para resolver este experimento de la manera adecuada se realizara un cuadro de Youden con 6 filas, los tipos de herbicidas (h1, h2, h3, h4), los tipos de fertilizante (f1, f2, f3) y los tipos de semillas asignando las letras latinas (a, b, c, d, e, f).

library(agricolae)
semilla_you <- letters [1:6]

dis.youden <- design.youden(semilla_you, r=4, serie = 2, seed = 2020, kinds = "Super-Duper")
fertilizante_you <- paste0("f",1:4)
herbicida_you <- paste0("h",1:6)
colnames(dis.youden$sketch) <- fertilizante_you
rownames(dis.youden$sketch) <- herbicida_you
dis.youden
## $parameters
## $parameters$design
## [1] "youden"
## 
## $parameters$trt
## [1] "a" "b" "c" "d" "e" "f"
## 
## $parameters$r
## [1] 4
## 
## $parameters$serie
## [1] 2
## 
## $parameters$seed
## [1] 2020
## 
## $parameters$kinds
## [1] "Super-Duper"
## 
## 
## $sketch
##    f1  f2  f3  f4 
## h1 "c" "e" "b" "f"
## h2 "e" "f" "d" "b"
## h3 "f" "b" "a" "d"
## h4 "d" "a" "e" "c"
## h5 "b" "d" "c" "a"
## h6 "a" "c" "f" "e"
## 
## $book
##    plots row col semilla_you
## 1    101   1   1           c
## 2    102   1   2           e
## 3    103   1   3           b
## 4    104   1   4           f
## 5    201   2   1           e
## 6    202   2   2           f
## 7    203   2   3           d
## 8    204   2   4           b
## 9    301   3   1           f
## 10   302   3   2           b
## 11   303   3   3           a
## 12   304   3   4           d
## 13   401   4   1           d
## 14   402   4   2           a
## 15   403   4   3           e
## 16   404   4   4           c
## 17   501   5   1           b
## 18   502   5   2           d
## 19   503   5   3           c
## 20   504   5   4           a
## 21   601   6   1           a
## 22   602   6   2           c
## 23   603   6   3           f
## 24   604   6   4           e

Asignando valores de los resultados teoricos

tiempo_flor <- c(sample(10:30, 24,replace = TRUE))
datos_you <- cbind(dis.youden$book,tiempo_flor)
colnames(datos_you) <- c("Plots","Herbicida","Fertilizante","Semilla","Tiempo")
datos_you
##    Plots Herbicida Fertilizante Semilla Tiempo
## 1    101         1            1       c     17
## 2    102         1            2       e     30
## 3    103         1            3       b     25
## 4    104         1            4       f     14
## 5    201         2            1       e     21
## 6    202         2            2       f     18
## 7    203         2            3       d     14
## 8    204         2            4       b     17
## 9    301         3            1       f     19
## 10   302         3            2       b     10
## 11   303         3            3       a     22
## 12   304         3            4       d     13
## 13   401         4            1       d     18
## 14   402         4            2       a     19
## 15   403         4            3       e     27
## 16   404         4            4       c     24
## 17   501         5            1       b     16
## 18   502         5            2       d     10
## 19   503         5            3       c     19
## 20   504         5            4       a     28
## 21   601         6            1       a     19
## 22   602         6            2       c     23
## 23   603         6            3       f     27
## 24   604         6            4       e     23

Analisis de varianza

aov_youden <- aov(Tiempo~Herbicida+Fertilizante+Semilla, data = datos_you)
summary(aov_youden)
##              Df Sum Sq Mean Sq F value Pr(>F)
## Herbicida     5 160.21   32.04   1.255  0.354
## Fertilizante  3  64.13   21.38   0.837  0.504
## Semilla       5 211.27   42.25   1.655  0.233
## Residuals    10 255.35   25.53

Probando normalidad

normalidad_youden <- shapiro.test(aov_youden$residuals)
normalidad_youden
## 
##  Shapiro-Wilk normality test
## 
## data:  aov_youden$residuals
## W = 0.96953, p-value = 0.6554
ifelse(normalidad_youden$p.value > 0.05, "Presenta Normalidad", "NO Presenta Normalidad ")
## [1] "Presenta Normalidad"

Diseño Greco Latino

Este modelo se puede considerar como una extensión del cuadrado latino en el que se incluye una tercera variable de control o de bloque. En este modelo, como el diseño del cuadrado latino, todos los factores deben tener el mismo número de niveles \(k\) y el número de observaciones necesarias \(k^2\).

Los cuadrados greco-latinos también conocidos como cuadrados latinos ortogonales, se obtienen por superposición de dos cuadrados latinos del mismo orden y ortogonales entre si, uno de los cuadros con letras latinas y el otro con letras griegas dos cuadrados reciben el nombre de ortogonales si, al suponerlos cada letra latina y cada letra griega aparecen juntas un sola vez por cada columna y cada fila el cuadrado resultante.

L. Euler demostró que se podía construir un cuadrado greco-latino siempre que su orden fuese impar o múltiplo de 4, es decir, par de clase par, y aseguro que los cuadrados grecos-latinos no tenian solución cuando su orden era par de clase impar, es decir, múltiplo de 2 pero no múltiplo de 4. Posteriormente G.Tarry en 1901 confirmo la conjetura de Euler para el orden 6, sin embargo E. T. Parker en 1959, construyo un cuadro greco-latino soluble de orden 10, el mas pequeño posible de los ordenes pares de clase impar. De este modo se demostro que existen cuadrados grecos-latinos de orden \(k\) para todo \(k > 2\), excepto para \(k = 6\)

En un diseño en cuadrado greco-latino la variable respuesta \(y_{ij(hp)}\) viene descrita por la siguiente ecuación

\[ y_{ij(hp)} = \mu + \alpha_i + \beta_j + \tau_h + \delta_p + \epsilon_{ij(hp)} \\ i = 1,2...,K ~~;~~ j = 1,2...,K ~~;~~ h = 1,2...,K ~~;~~ p = 1,2...,K \] Donde

La notación \(y_{ij(hp)}\) indica que los niveles \(i\) y \(j\) determinan los niveles \(h\) y \(p\) para un cuadrado greco-latino especificado. Es decir, los subíndices \(h\) y \(p\) toman valores que dependen de la celdilla \((i, j)\).

Para generar este diseño con la libreria agricolae se deben tener en cuenta los siguientes parametros.

library(agricolae)
str(design.graeco)
## function (trt1, trt2, serie = 2, seed = 0, kinds = "Super-Duper", randomization = TRUE)

Donde

Suponiendo un diseño 4x4 se genera de la siguiente manera.

library(agricolae)
T1 <- letters[1:4]
T2 <- c(1:4)
dis.greco <- design.graeco(T1,T2,serie = 1,seed = 2020, kinds = "Super-Duper")
head(dis.greco)
## $parameters
## $parameters$design
## [1] "graeco"
## 
## $parameters$trt1
## [1] "a" "b" "c" "d"
## 
## $parameters$trt2
## [1] 1 2 3 4
## 
## $parameters$r
## [1] 4
## 
## $parameters$serie
## [1] 1
## 
## $parameters$seed
## [1] 2020
## 
## $parameters$kinds
## [1] "Super-Duper"
## 
## $parameters[[8]]
## [1] TRUE
## 
## 
## $sketch
##      [,1]   [,2]   [,3]   [,4]  
## [1,] "NA 1" "NA 4" "NA 2" "NA 3"
## [2,] "NA 2" "NA 3" "NA 1" "NA 4"
## [3,] "NA 3" "NA 2" "NA 4" "NA 1"
## [4,] "NA 4" "NA 1" "NA 3" "NA 2"
## 
## $book
##    plots row col   T1 T2
## 1     11   1   1 <NA>  1
## 2     12   1   2 <NA>  4
## 3     13   1   3 <NA>  2
## 4     14   1   4 <NA>  3
## 5     21   2   1 <NA>  2
## 6     22   2   2 <NA>  3
## 7     23   2   3 <NA>  1
## 8     24   2   4 <NA>  4
## 9     31   3   1 <NA>  3
## 10    32   3   2 <NA>  2
## 11    33   3   3 <NA>  4
## 12    34   3   4 <NA>  1
## 13    41   4   1 <NA>  4
## 14    42   4   2 <NA>  1
## 15    43   4   3 <NA>  3
## 16    44   4   4 <NA>  2

Ejemplo

tomado de https://wpd.ugr.es/~bioestad/guia-de-r/practica-7/

Se quiere determinar el rendimiento de un proceso químico en cinco tiempos de reposo(t1,t2,…,t5), se consideran cinco lotes de materia prima (lot1,lot2…,lot5) que reaccionan con cinco concentraciones de ácido distintas (c1,c2…,c5) a cinco temperaturas distintas (tem1,tem2…,tem3), de manera que cada lote de materia prima con cada concentración de ácido y cada temperatura se someten a un tiempo de reposo. para asignación aleatoria de los factores se implementa un diseño greco-latino 5x5 el cual se genera de la siguiente manera

tiempo_rep <- c(paste("t",1:5))
lotes_mat <- c(paste("lot", 1:5))
concentracion_acid <- c(paste("c",1:5))
temperatura_trt <- c(paste("tem",1:5))

diseño_grec <- design.graeco(tiempo_rep,temperatura_trt,serie = 5,seed = 2021,kinds = "Super-Duper",randomization = TRUE)
head(diseño_grec)
## $parameters
## $parameters$design
## [1] "graeco"
## 
## $parameters$trt1
## [1] "t 1" "t 2" "t 3" "t 4" "t 5"
## 
## $parameters$trt2
## [1] "tem 1" "tem 2" "tem 3" "tem 4" "tem 5"
## 
## $parameters$r
## [1] 5
## 
## $parameters$serie
## [1] 5
## 
## $parameters$seed
## [1] 2021
## 
## $parameters$kinds
## [1] "Super-Duper"
## 
## $parameters[[8]]
## [1] TRUE
## 
## 
## $sketch
##      [,1]     [,2]     [,3]     [,4]     [,5]    
## [1,] "t 2 NA" "t 4 NA" "t 1 NA" "t 5 NA" "t 3 NA"
## [2,] "t 4 NA" "t 1 NA" "t 5 NA" "t 3 NA" "t 2 NA"
## [3,] "t 1 NA" "t 5 NA" "t 3 NA" "t 2 NA" "t 4 NA"
## [4,] "t 5 NA" "t 3 NA" "t 2 NA" "t 4 NA" "t 1 NA"
## [5,] "t 3 NA" "t 2 NA" "t 4 NA" "t 1 NA" "t 5 NA"
## 
## $book
##     plots row col tiempo_rep temperatura_trt
## 1  100001   1   1        t 2            <NA>
## 2  100002   1   2        t 4            <NA>
## 3  100003   1   3        t 1            <NA>
## 4  100004   1   4        t 5            <NA>
## 5  100005   1   5        t 3            <NA>
## 6  200001   2   1        t 4            <NA>
## 7  200002   2   2        t 1            <NA>
## 8  200003   2   3        t 5            <NA>
## 9  200004   2   4        t 3            <NA>
## 10 200005   2   5        t 2            <NA>
## 11 300001   3   1        t 1            <NA>
## 12 300002   3   2        t 5            <NA>
## 13 300003   3   3        t 3            <NA>
## 14 300004   3   4        t 2            <NA>
## 15 300005   3   5        t 4            <NA>
## 16 400001   4   1        t 5            <NA>
## 17 400002   4   2        t 3            <NA>
## 18 400003   4   3        t 2            <NA>
## 19 400004   4   4        t 4            <NA>
## 20 400005   4   5        t 1            <NA>
## 21 500001   5   1        t 3            <NA>
## 22 500002   5   2        t 2            <NA>
## 23 500003   5   3        t 4            <NA>
## 24 500004   5   4        t 1            <NA>
## 25 500005   5   5        t 5            <NA>
colnames(diseño_grec$sketch) <- concentracion_acid
rownames(diseño_grec$sketch) <- lotes_mat

print(diseño_grec$sketch)
##       c 1      c 2      c 3      c 4      c 5     
## lot 1 "t 2 NA" "t 4 NA" "t 1 NA" "t 5 NA" "t 3 NA"
## lot 2 "t 4 NA" "t 1 NA" "t 5 NA" "t 3 NA" "t 2 NA"
## lot 3 "t 1 NA" "t 5 NA" "t 3 NA" "t 2 NA" "t 4 NA"
## lot 4 "t 5 NA" "t 3 NA" "t 2 NA" "t 4 NA" "t 1 NA"
## lot 5 "t 3 NA" "t 2 NA" "t 4 NA" "t 1 NA" "t 5 NA"

Arreglando la tabla teniendo en cuenta lo que representa cada columna y cada fila en base al grafico anterior, asignamos los resultados obtenidos

arreglo_dis <- design.lsd(temperatura_trt,serie = 2)
diseño_final1 <- cbind(diseño_grec$book , temperatura= arreglo_dis$book$temperatura_trt)
diseño_final2 <- diseño_final1 [,-5]
colnames(diseño_final2) <- c("Plots","Lote","Concentracion","Tiempo de reposo","Temperatura")
diseño_final2
##     Plots Lote Concentracion Tiempo de reposo Temperatura
## 1  100001    1             1              t 2       tem 2
## 2  100002    1             2              t 4       tem 4
## 3  100003    1             3              t 1       tem 5
## 4  100004    1             4              t 5       tem 3
## 5  100005    1             5              t 3       tem 1
## 6  200001    2             1              t 4       tem 3
## 7  200002    2             2              t 1       tem 5
## 8  200003    2             3              t 5       tem 1
## 9  200004    2             4              t 3       tem 4
## 10 200005    2             5              t 2       tem 2
## 11 300001    3             1              t 1       tem 5
## 12 300002    3             2              t 5       tem 2
## 13 300003    3             3              t 3       tem 3
## 14 300004    3             4              t 2       tem 1
## 15 300005    3             5              t 4       tem 4
## 16 400001    4             1              t 5       tem 4
## 17 400002    4             2              t 3       tem 1
## 18 400003    4             3              t 2       tem 2
## 19 400004    4             4              t 4       tem 5
## 20 400005    4             5              t 1       tem 3
## 21 500001    5             1              t 3       tem 1
## 22 500002    5             2              t 2       tem 3
## 23 500003    5             3              t 4       tem 4
## 24 500004    5             4              t 1       tem 2
## 25 500005    5             5              t 5       tem 5
resultados_greco <- c(runif(25,5,20))
datos_greco <- cbind(diseño_final2,resultados_greco)
colnames(datos_greco) <- c("Plots","Lote","Concentracion","Tiempo de reposo","Temperatura","Resultados")
datos_greco
##     Plots Lote Concentracion Tiempo de reposo Temperatura Resultados
## 1  100001    1             1              t 2       tem 2  11.044188
## 2  100002    1             2              t 4       tem 4   7.746480
## 3  100003    1             3              t 1       tem 5  12.638424
## 4  100004    1             4              t 5       tem 3   8.717244
## 5  100005    1             5              t 3       tem 1   7.581159
## 6  200001    2             1              t 4       tem 3  18.637169
## 7  200002    2             2              t 1       tem 5   6.621399
## 8  200003    2             3              t 5       tem 1  15.412615
## 9  200004    2             4              t 3       tem 4   7.150847
## 10 200005    2             5              t 2       tem 2  14.373670
## 11 300001    3             1              t 1       tem 5  16.514326
## 12 300002    3             2              t 5       tem 2  12.187929
## 13 300003    3             3              t 3       tem 3  15.501183
## 14 300004    3             4              t 2       tem 1  10.870481
## 15 300005    3             5              t 4       tem 4   9.847514
## 16 400001    4             1              t 5       tem 4   7.754865
## 17 400002    4             2              t 3       tem 1  19.111220
## 18 400003    4             3              t 2       tem 2  12.320852
## 19 400004    4             4              t 4       tem 5  17.678749
## 20 400005    4             5              t 1       tem 3  15.853823
## 21 500001    5             1              t 3       tem 1  11.826050
## 22 500002    5             2              t 2       tem 3   7.861468
## 23 500003    5             3              t 4       tem 4  15.007886
## 24 500004    5             4              t 1       tem 2  17.118993
## 25 500005    5             5              t 5       tem 5   9.655801

Analisis de varianza

modelo.grec <- lm(datos_greco$Resultados ~ datos_greco$`Tiempo de reposo` + datos_greco$Temperatura + datos_greco$Lote + datos_greco$Concentracion )
aov_greco <- aov(modelo.grec)
summary(aov_greco)
##                                Df Sum Sq Mean Sq F value Pr(>F)
## datos_greco$`Tiempo de reposo`  4  38.57    9.64   0.800  0.558
## datos_greco$Temperatura         4 134.60   33.65   2.790  0.101
## datos_greco$Lote                4  65.46   16.36   1.357  0.330
## datos_greco$Concentracion       4  37.38    9.35   0.775  0.571
## Residuals                       8  96.49   12.06

Diseño Látice

Aquellos diseños en bloques incompletos que tienen la característica en común de que el número de tratamientos es un cuadrado exacto y el tamaño de los bloques es la raíz cuadrada del número de tratamientos se denominan diseños Látice. Estos se caracterizan porque es posible establecer una relación uno a uno entre los tratamientos y las combinaciones de los mismos en un experimento factorial.

El diseño Látice demuestra su potencial en comparación con los diseños en bloques al azar con respecto a experimentos donde se dificulta la obtención de gran número de unidades experimentales homogéneas, un claro ejemplo y donde generalmente se aplica este diseño es en los suelos ya que representan un gran nivel de heterogeneidad en diversos factores.

Existen una clasificación para los diseños Látice la cual se basa en el número de bloques necesarios en relación con su tamaño, esto determina si son rectangulares, bidimensionales, tridimensionales o cúbicos, etc. Si denotamos “p” al tamaño del bloque, los Látices rectangulares evalúan \(p\ (p+1)\) tratamientos en \(p+1\) bloques de tamaño \(p\); mientras que los n-dimencionales se tienen \(p^n\) tratamientos en \(p^{n-1}\) bloques de tamaño \(p\), de esta manera los diseños látices bidimencionales (rectangulares) se tienen \(p^2\) tratamientos en \(p\) bloques de tamaño \(p\), y en los látices cúbicos se evalúan \(p^3\) tratamientos en \(p^2\) bloques de tamaño \(p\).

Para generar este diseño con la libreria agricolae se tiene en cuenta los siguientes parametros

library(agricolae)
str(design.lattice)
## function (trt, r = 3, serie = 2, seed = 0, kinds = "Super-Duper", randomization = TRUE)

Donde

Como se mencionó anteriormente se deben tener un número de tratamientos que sea resultado de un cuadrado y se puede generar un Látice simple (2 Rep.) o un Látice triple (3 Rep.), supongamos diseño Látice triple con 9 tratamientos 3x3, este se realiza de la siguiente manera:

library(agricolae)

trt_lat <- letters[1:9]
dis.latice <- design.lattice(trt_lat, r=3, serie=2, seed=2020, kinds = "Super-Duper")
## 
## Lattice design,  triple   3 x 3 
## 
## Efficiency factor
## (E ) 0.7272727 
## 
## <<< Book >>>
dis.latice
## $parameters
## $parameters$design
## [1] "lattice"
## 
## $parameters$type
## [1] "triple"
## 
## $parameters$trt
## [1] "a" "b" "c" "d" "e" "f" "g" "h" "i"
## 
## $parameters$r
## [1] 3
## 
## $parameters$serie
## [1] 2
## 
## $parameters$seed
## [1] 2020
## 
## $parameters$kinds
## [1] "Super-Duper"
## 
## 
## $statistics
##        treatmens blockSize blocks Efficiency
## values         9         3      3  0.7272727
## 
## $sketch
## $sketch$rep1
##      [,1] [,2] [,3]
## [1,] "g"  "e"  "f" 
## [2,] "c"  "a"  "d" 
## [3,] "b"  "h"  "i" 
## 
## $sketch$rep2
##      [,1] [,2] [,3]
## [1,] "b"  "g"  "c" 
## [2,] "h"  "e"  "a" 
## [3,] "i"  "f"  "d" 
## 
## $sketch$rep3
##      [,1] [,2] [,3]
## [1,] "i"  "g"  "a" 
## [2,] "h"  "f"  "c" 
## [3,] "b"  "e"  "d" 
## 
## 
## $book
##    plots r block trt
## 1    101 1     1   g
## 2    102 1     1   e
## 3    103 1     1   f
## 4    104 1     2   c
## 5    105 1     2   a
## 6    106 1     2   d
## 7    107 1     3   b
## 8    108 1     3   h
## 9    109 1     3   i
## 10   201 2     4   b
## 11   202 2     4   g
## 12   203 2     4   c
## 13   204 2     5   h
## 14   205 2     5   e
## 15   206 2     5   a
## 16   207 2     6   i
## 17   208 2     6   f
## 18   209 2     6   d
## 19   301 3     7   i
## 20   302 3     7   g
## 21   303 3     7   a
## 22   304 3     8   h
## 23   305 3     8   f
## 24   306 3     8   c
## 25   307 3     9   b
## 26   308 3     9   e
## 27   309 3     9   d

Ejemplo

se quiere evaluar la disposición de nitrógeno orgánico en el suelo mediante la implementación de 9 especies de bacterias del genero Pseudomonas (Ps1,Ps2,…,Ps9), el experimento se realizara bajo un diseño experimental latice 3x3.claramente se trata de un diseño factorial incompleto por la naturaleza de sus factores. Este diseño se obtiene mediante la librería agricolae de la siguiente manera

De esta manera tenemos:

  • Numero de tratamientos: 9
  • Tamaño de bloque: 3
  • Numero de repeticiones: 3
trt_suelo <- c(paste("Ps", 1:9))
dis.suelo <- design.lattice(trt_suelo, r=3, serie = 2, seed = 2021, kinds = "Super-Duper")
## 
## Lattice design,  triple   3 x 3 
## 
## Efficiency factor
## (E ) 0.7272727 
## 
## <<< Book >>>
head(dis.suelo)
## $parameters
## $parameters$design
## [1] "lattice"
## 
## $parameters$type
## [1] "triple"
## 
## $parameters$trt
## [1] "Ps 1" "Ps 2" "Ps 3" "Ps 4" "Ps 5" "Ps 6" "Ps 7" "Ps 8" "Ps 9"
## 
## $parameters$r
## [1] 3
## 
## $parameters$serie
## [1] 2
## 
## $parameters$seed
## [1] 2021
## 
## $parameters$kinds
## [1] "Super-Duper"
## 
## 
## $statistics
##        treatmens blockSize blocks Efficiency
## values         9         3      3  0.7272727
## 
## $sketch
## $sketch$rep1
##      [,1]   [,2]   [,3]  
## [1,] "Ps 8" "Ps 3" "Ps 9"
## [2,] "Ps 2" "Ps 4" "Ps 5"
## [3,] "Ps 6" "Ps 7" "Ps 1"
## 
## $sketch$rep2
##      [,1]   [,2]   [,3]  
## [1,] "Ps 2" "Ps 8" "Ps 6"
## [2,] "Ps 5" "Ps 9" "Ps 1"
## [3,] "Ps 4" "Ps 3" "Ps 7"
## 
## $sketch$rep3
##      [,1]   [,2]   [,3]  
## [1,] "Ps 2" "Ps 3" "Ps 1"
## [2,] "Ps 5" "Ps 8" "Ps 7"
## [3,] "Ps 4" "Ps 9" "Ps 6"
## 
## 
## $book
##    plots r block  trt
## 1    101 1     1 Ps 8
## 2    102 1     1 Ps 3
## 3    103 1     1 Ps 9
## 4    104 1     2 Ps 2
## 5    105 1     2 Ps 4
## 6    106 1     2 Ps 5
## 7    107 1     3 Ps 6
## 8    108 1     3 Ps 7
## 9    109 1     3 Ps 1
## 10   201 2     4 Ps 2
## 11   202 2     4 Ps 8
## 12   203 2     4 Ps 6
## 13   204 2     5 Ps 5
## 14   205 2     5 Ps 9
## 15   206 2     5 Ps 1
## 16   207 2     6 Ps 4
## 17   208 2     6 Ps 3
## 18   209 2     6 Ps 7
## 19   301 3     7 Ps 2
## 20   302 3     7 Ps 3
## 21   303 3     7 Ps 1
## 22   304 3     8 Ps 5
## 23   305 3     8 Ps 8
## 24   306 3     8 Ps 7
## 25   307 3     9 Ps 4
## 26   308 3     9 Ps 9
## 27   309 3     9 Ps 6

Asignando los resultados obtenidos

concentracion_N <- c(runif(27,0.1,2))
datos_latice <- cbind(dis.suelo$book, concentracion_N)
colnames(datos_latice) <- c("Plots", "Repeticion","Bloqueo", "Tratamiento", "Concentracion (N)")
datos_latice
##    Plots Repeticion Bloqueo Tratamiento Concentracion (N)
## 1    101          1       1        Ps 8         0.3606448
## 2    102          1       1        Ps 3         0.1357802
## 3    103          1       1        Ps 9         1.6404400
## 4    104          1       2        Ps 2         1.5368586
## 5    105          1       2        Ps 4         1.3107446
## 6    106          1       2        Ps 5         1.1141117
## 7    107          1       3        Ps 6         0.5625922
## 8    108          1       3        Ps 7         0.2673146
## 9    109          1       3        Ps 1         1.1594062
## 10   201          2       4        Ps 2         1.8623304
## 11   202          2       4        Ps 8         1.7035161
## 12   203          2       4        Ps 6         1.2751191
## 13   204          2       5        Ps 5         0.2254268
## 14   205          2       5        Ps 9         1.2596117
## 15   206          2       5        Ps 1         1.7895853
## 16   207          2       6        Ps 4         0.9036313
## 17   208          2       6        Ps 3         1.6486700
## 18   209          2       6        Ps 7         0.3303529
## 19   301          3       7        Ps 2         0.4525949
## 20   302          3       7        Ps 3         1.6902496
## 21   303          3       7        Ps 1         1.6741534
## 22   304          3       8        Ps 5         1.3352490
## 23   305          3       8        Ps 8         1.2762990
## 24   306          3       8        Ps 7         0.6534096
## 25   307          3       9        Ps 4         1.3023844
## 26   308          3       9        Ps 9         1.0870202
## 27   309          3       9        Ps 6         1.5049188

Análisis de varianza para el experimento

aov_latice <- PBIB.test(datos_latice$Bloqueo, datos_latice$Tratamiento, datos_latice$Repeticion, datos_latice$`Concentracion (N)`, k=4, method="REML", group= F, test="lsd")
## 
## <<< to see the objects: means, comparison and groups. >>>
aov_latice
## $ANOVA
## Analysis of Variance Table
## 
## Response: datos_latice$`Concentracion (N)`
##                          Df Sum Sq Mean Sq F value Pr(>F)
## datos_latice$Tratamiento  8 2.4733 0.30916  1.2709 0.3543
## Residuals                10 2.4326 0.24326               
## 
## $method
## [1] "Residual (restricted) maximum likelihood"
## 
## $parameters
##       test                   name.t treatments blockSize blocks r alpha
##   PBIB-lsd datos_latice$Tratamiento          9         4   2.25 3  0.05
## 
## $statistics
##   Efficiency     Mean       CV
##    0.8101266 1.113423 44.29709
## 
## $model
## Linear mixed-effects model fit by REML
##   Data: NULL 
##   Log-restricted-likelihood: -19.39125
##   Fixed: y ~ trt.adj 
## (Intercept) trt.adjPs 2 trt.adjPs 3 trt.adjPs 4 trt.adjPs 5 trt.adjPs 6 
##   1.6307934  -0.4387216  -0.3952866  -0.5116726  -0.7893233  -0.5437311 
## trt.adjPs 7 trt.adjPs 8 trt.adjPs 9 
##  -1.2083413  -0.5539192  -0.2153397 
## 
## Random effects:
##  Formula: ~1 | replication
##          (Intercept)
## StdDev: 1.995083e-05
## 
##  Formula: ~1 | block.adj %in% replication
##         (Intercept)  Residual
## StdDev:   0.2338391 0.4932139
## 
## Number of Observations: 27
## Number of Groups: 
##                replication block.adj %in% replication 
##                          3                          9 
## 
## $Fstat
##                       Fit Statistics
## AIC                         62.78249
## BIC                         73.46695
## -2 Res Log Likelihood      -19.39125
## 
## $comparison
##              Difference    stderr pvalue
## Ps 1 - Ps 2  0.43872155 0.4230115 0.3240
## Ps 1 - Ps 3  0.39528661 0.4230115 0.3720
## Ps 1 - Ps 4  0.51167261 0.4328065 0.2644
## Ps 1 - Ps 5  0.78932332 0.4230115 0.0916
## Ps 1 - Ps 6  0.54373111 0.4230115 0.2276
## Ps 1 - Ps 7  1.20834131 0.4230115 0.0170
## Ps 1 - Ps 8  0.55391921 0.4328065 0.2294
## Ps 1 - Ps 9  0.21533968 0.4230115 0.6218
## Ps 2 - Ps 3 -0.04343494 0.4230115 0.9202
## Ps 2 - Ps 4  0.07295106 0.4230115 0.8666
## Ps 2 - Ps 5  0.35060176 0.4230115 0.4266
## Ps 2 - Ps 6  0.10500955 0.4230115 0.8090
## Ps 2 - Ps 7  0.76961976 0.4328065 0.1058
## Ps 2 - Ps 8  0.11519766 0.4230115 0.7910
## Ps 2 - Ps 9 -0.22338188 0.4328065 0.6170
## Ps 3 - Ps 4  0.11638600 0.4230115 0.7888
## Ps 3 - Ps 5  0.39403671 0.4328065 0.3840
## Ps 3 - Ps 6  0.14844449 0.4328065 0.7388
## Ps 3 - Ps 7  0.81305470 0.4230115 0.0836
## Ps 3 - Ps 8  0.15863260 0.4230115 0.7154
## Ps 3 - Ps 9 -0.17994693 0.4230115 0.6796
## Ps 4 - Ps 5  0.27765070 0.4230115 0.5264
## Ps 4 - Ps 6  0.03205849 0.4230115 0.9410
## Ps 4 - Ps 7  0.69666870 0.4230115 0.1306
## Ps 4 - Ps 8  0.04224660 0.4328065 0.9242
## Ps 4 - Ps 9 -0.29633294 0.4230115 0.4996
## Ps 5 - Ps 6 -0.24559221 0.4328065 0.5830
## Ps 5 - Ps 7  0.41901800 0.4230115 0.3452
## Ps 5 - Ps 8 -0.23540411 0.4230115 0.5902
## Ps 5 - Ps 9 -0.57398364 0.4230115 0.2046
## Ps 6 - Ps 7  0.66461021 0.4230115 0.1472
## Ps 6 - Ps 8  0.01018811 0.4230115 0.9812
## Ps 6 - Ps 9 -0.32839143 0.4230115 0.4556
## Ps 7 - Ps 8 -0.65442210 0.4230115 0.1528
## Ps 7 - Ps 9 -0.99300164 0.4328065 0.0446
## Ps 8 - Ps 9 -0.33857954 0.4230115 0.4420
## 
## $means
##      datos_latice$`Concentracion (N)` datos_latice$`Concentracion (N)`.adj
## Ps 1                        1.5410483                            1.6307934
## Ps 2                        1.2839280                            1.1920718
## Ps 3                        1.1582333                            1.2355068
## Ps 4                        1.1722535                            1.1191208
## Ps 5                        0.8915958                            0.8414701
## Ps 6                        1.1142100                            1.0870623
## Ps 7                        0.4170257                            0.4224521
## Ps 8                        1.1134866                            1.0768742
## Ps 9                        1.3290240                            1.4154537
##             SE r       std       Min       Max       Q25       Q50       Q75
## Ps 1 0.3091035 3 0.3355133 1.1594062 1.7895853 1.4167798 1.6741534 1.7318694
## Ps 2 0.3091035 3 0.7381185 0.4525949 1.8623304 0.9947267 1.5368586 1.6995945
## Ps 3 0.3091035 3 0.8857143 0.1357802 1.6902496 0.8922251 1.6486700 1.6694598
## Ps 4 0.3091035 3 0.2326712 0.9036313 1.3107446 1.1030079 1.3023844 1.3065645
## Ps 5 0.3091035 3 0.5874192 0.2254268 1.3352490 0.6697692 1.1141117 1.2246804
## Ps 6 0.3091035 3 0.4913386 0.5625922 1.5049188 0.9188557 1.2751191 1.3900189
## Ps 7 0.3091035 3 0.2071267 0.2673146 0.6534096 0.2988338 0.3303529 0.4918812
## Ps 8 0.3091035 3 0.6860807 0.3606448 1.7035161 0.8184719 1.2762990 1.4899075
## Ps 9 0.3091035 3 0.2831641 1.0870202 1.6404400 1.1733160 1.2596117 1.4500259
## 
## $groups
## NULL
## 
## $vartau
##             trt.adjPs 1 trt.adjPs 2 trt.adjPs 3 trt.adjPs 4 trt.adjPs 5
## trt.adjPs 1 0.095545000 0.006075637 0.006075637 0.001884289 0.006075637
## trt.adjPs 2 0.006075637 0.095545000 0.006075637 0.006075637 0.006075637
## trt.adjPs 3 0.006075637 0.006075637 0.095545000 0.006075637 0.001884289
## trt.adjPs 4 0.001884289 0.006075637 0.006075637 0.095545000 0.006075637
## trt.adjPs 5 0.006075637 0.006075637 0.001884289 0.006075637 0.095545000
## trt.adjPs 6 0.006075637 0.006075637 0.001884289 0.006075637 0.001884289
## trt.adjPs 7 0.006075637 0.001884289 0.006075637 0.006075637 0.006075637
## trt.adjPs 8 0.001884289 0.006075637 0.006075637 0.001884289 0.006075637
## trt.adjPs 9 0.006075637 0.001884289 0.006075637 0.006075637 0.006075637
##             trt.adjPs 6 trt.adjPs 7 trt.adjPs 8 trt.adjPs 9
## trt.adjPs 1 0.006075637 0.006075637 0.001884289 0.006075637
## trt.adjPs 2 0.006075637 0.001884289 0.006075637 0.001884289
## trt.adjPs 3 0.001884289 0.006075637 0.006075637 0.006075637
## trt.adjPs 4 0.006075637 0.006075637 0.001884289 0.006075637
## trt.adjPs 5 0.001884289 0.006075637 0.006075637 0.006075637
## trt.adjPs 6 0.095545000 0.006075637 0.006075637 0.006075637
## trt.adjPs 7 0.006075637 0.095545000 0.006075637 0.001884289
## trt.adjPs 8 0.006075637 0.006075637 0.095545000 0.006075637
## trt.adjPs 9 0.006075637 0.001884289 0.006075637 0.095545000
## 
## attr(,"class")
## [1] "group"

Diseño Alpha

En 1976 H. D. Patterson y E. R. Williams introdujeron una nueva clase de diseño de bloques incompletos llamado Diseño Alpha, es tuvo una gran acogida por parte de los diseñadores de experimentos principalmente por la disponibilidad del diseño frente a diversas combinaciones (\(r, k, s\)), donde \(r\) es el número de repeticiones, \(k\) es el tamaño del bloque y \(s\) es el número de bloques por repetición, así entonces el número de repeticiones debe ser igual a \(k∗s\) y el total de unidades experimentales \(r∗k∗s\). Un diseño Látice cuadrado, por ejemplo, no existe para la combinación (4,6,6) ya que no se presenta un cuadrado greco latino de lado 6. Del mismo modo, no existe un diseño Látice rectangular para la combinación (4,5,6). Sin embargo, existen diseños \(\alpha\) eficientes para estas combinaciones.

La construcción de un diseño \(\alpha\) se basa en un matriz \(r\)x\(k\), cada fila de \(\alpha\) se utiliza para generar \(s\)-1 filas adicionales mediante sustitución cíclica. Las filas de la matriz resultantes son bloques del diseño. Un diseño \(\alpha\) con pares de tratamientos que aparecen en bloques 0 y 1 veces, se denomina diseño \(\alpha\) (1,0).

Para generar este diseño con la libreria agricolae se deben tener en cuenta los siguientes parametros.

library(agricolae)
str(design.alpha)
## function (trt, k, r, serie = 2, seed = 0, kinds = "Super-Duper", randomization = TRUE)

Donde

Ejemplo

tomado de http://www.scielo.org.mx/scielo.php?script=sci_arttext&pid=S2007-07052019000100433&lng=es&nrm=iso

Supongamos que son 50 proyectos a evaluar, cada evaluador deberá evaluar 5 proyectos y existen 3 réplicas, donde las réplicas lo conformara cada evaluador. Observar, no fue necesario definir el número de evaluadores, será el propio diseño el que determina la cantidad de bloques (evaluadores) necesarios.

Entonces

library(agricolae)
trt <- paste("Proyecto", 1:50) # funcion paste() une todos los vectores de caracteres que se le suministran y construye una sola cadena de caracteres
k <- 5
r <- 3
Dis.Alpha <- design.alpha(trt, k, r, seed = 2020)
## 
## Alpha Design (0,1) - Serie  III 
## 
## Parameters Alpha Design
## =======================
## Treatmeans : 50
## Block size : 5
## Blocks     : 10
## Replication: 3 
## 
## Efficiency factor
## (E ) 0.784 
## 
## <<< Book >>>

Obtenemos que se deban implementar 10 evaluadores (bloques) por repetición para un total de 30 evaluadores en todo el experimento. Cabe mencionar que la estructura de Dis.Alpha no solo contiene el diseño de los bloques, además incluye la lista para añadir las clasificaciones obtenidas para cada tratamiento. Para analizar dicha estructura se hace por medio de la función str(…).

str(Dis.Alpha)
## List of 4
##  $ parameters:List of 7
##   ..$ design: chr "alpha"
##   ..$ trt   : chr [1:50] "Proyecto 1" "Proyecto 2" "Proyecto 3" "Proyecto 4" ...
##   ..$ k     : num 5
##   ..$ r     : num 3
##   ..$ serie : chr "III"
##   ..$ seed  : num 2020
##   ..$ kinds : chr "Super-Duper"
##  $ statistics:'data.frame':  1 obs. of  3 variables:
##   ..$ treatments: int 50
##   ..$ blocks    : num 10
##   ..$ Efficiency: num 0.784
##  $ sketch    :List of 3
##   ..$ rep1: chr [1:10, 1:5] "Proyecto 36" "Proyecto 14" "Proyecto 30" "Proyecto 4" ...
##   ..$ rep2: chr [1:10, 1:5] "Proyecto 19" "Proyecto 6" "Proyecto 25" "Proyecto 47" ...
##   ..$ rep3: chr [1:10, 1:5] "Proyecto 35" "Proyecto 32" "Proyecto 13" "Proyecto 21" ...
##  $ book      :'data.frame':  150 obs. of  5 variables:
##   ..$ plots      : num [1:150] 101 102 103 104 105 106 107 108 109 110 ...
##   ..$ cols       : Factor w/ 5 levels "1","2","3","4",..: 1 2 3 4 5 1 2 3 4 5 ...
##   ..$ block      : Factor w/ 30 levels "1","2","3","4",..: 1 1 1 1 1 2 2 2 2 2 ...
##   ..$ trt        : Factor w/ 50 levels "Proyecto 1","Proyecto 10",..: 30 36 26 43 31 6 25 8 20 35 ...
##   ..$ replication: Factor w/ 3 levels "1","2","3": 1 1 1 1 1 1 1 1 1 1 ...

La lista muestra 4 componentes principales:

  • parameters: Parámetros utilizados.
  • statistics: Un pequeño análisis sobre el la eficiencia del bloque propuesto.
  • sketch: Diseño de los bloques.
  • book: Lista preparada realizar el tatamientos de los datos

Para obtener la distribución de los bloques entre las repeticiones:

head(Dis.Alpha$sketch)
## $rep1
##       [,1]          [,2]          [,3]          [,4]          [,5]         
##  [1,] "Proyecto 36" "Proyecto 41" "Proyecto 32" "Proyecto 48" "Proyecto 37"
##  [2,] "Proyecto 14" "Proyecto 31" "Proyecto 16" "Proyecto 27" "Proyecto 40"
##  [3,] "Proyecto 30" "Proyecto 50" "Proyecto 15" "Proyecto 29" "Proyecto 28"
##  [4,] "Proyecto 4"  "Proyecto 11" "Proyecto 38" "Proyecto 33" "Proyecto 5" 
##  [5,] "Proyecto 8"  "Proyecto 18" "Proyecto 42" "Proyecto 2"  "Proyecto 17"
##  [6,] "Proyecto 25" "Proyecto 21" "Proyecto 1"  "Proyecto 6"  "Proyecto 20"
##  [7,] "Proyecto 34" "Proyecto 46" "Proyecto 44" "Proyecto 7"  "Proyecto 24"
##  [8,] "Proyecto 22" "Proyecto 43" "Proyecto 10" "Proyecto 45" "Proyecto 26"
##  [9,] "Proyecto 39" "Proyecto 35" "Proyecto 49" "Proyecto 13" "Proyecto 12"
## [10,] "Proyecto 3"  "Proyecto 23" "Proyecto 19" "Proyecto 47" "Proyecto 9" 
## 
## $rep2
##       [,1]          [,2]          [,3]          [,4]          [,5]         
##  [1,] "Proyecto 19" "Proyecto 44" "Proyecto 12" "Proyecto 16" "Proyecto 43"
##  [2,] "Proyecto 6"  "Proyecto 13" "Proyecto 31" "Proyecto 26" "Proyecto 48"
##  [3,] "Proyecto 25" "Proyecto 17" "Proyecto 30" "Proyecto 33" "Proyecto 37"
##  [4,] "Proyecto 47" "Proyecto 28" "Proyecto 14" "Proyecto 35" "Proyecto 24"
##  [5,] "Proyecto 34" "Proyecto 9"  "Proyecto 29" "Proyecto 18" "Proyecto 5" 
##  [6,] "Proyecto 38" "Proyecto 36" "Proyecto 49" "Proyecto 22" "Proyecto 21"
##  [7,] "Proyecto 3"  "Proyecto 50" "Proyecto 20" "Proyecto 42" "Proyecto 4" 
##  [8,] "Proyecto 15" "Proyecto 46" "Proyecto 40" "Proyecto 2"  "Proyecto 23"
##  [9,] "Proyecto 7"  "Proyecto 32" "Proyecto 27" "Proyecto 10" "Proyecto 39"
## [10,] "Proyecto 45" "Proyecto 41" "Proyecto 1"  "Proyecto 11" "Proyecto 8" 
## 
## $rep3
##       [,1]          [,2]          [,3]          [,4]          [,5]         
##  [1,] "Proyecto 35" "Proyecto 25" "Proyecto 11" "Proyecto 16" "Proyecto 7" 
##  [2,] "Proyecto 32" "Proyecto 26" "Proyecto 18" "Proyecto 49" "Proyecto 50"
##  [3,] "Proyecto 13" "Proyecto 2"  "Proyecto 10" "Proyecto 3"  "Proyecto 29"
##  [4,] "Proyecto 21" "Proyecto 41" "Proyecto 40" "Proyecto 19" "Proyecto 24"
##  [5,] "Proyecto 38" "Proyecto 37" "Proyecto 1"  "Proyecto 47" "Proyecto 46"
##  [6,] "Proyecto 9"  "Proyecto 45" "Proyecto 15" "Proyecto 6"  "Proyecto 36"
##  [7,] "Proyecto 12" "Proyecto 30" "Proyecto 5"  "Proyecto 27" "Proyecto 42"
##  [8,] "Proyecto 8"  "Proyecto 44" "Proyecto 20" "Proyecto 14" "Proyecto 33"
##  [9,] "Proyecto 39" "Proyecto 17" "Proyecto 43" "Proyecto 4"  "Proyecto 31"
## [10,] "Proyecto 28" "Proyecto 34" "Proyecto 23" "Proyecto 22" "Proyecto 48"

Se generaran una serie de datos sintéticos como simulación de los datos obtenidos en el experimento para su respectiva evaluación y análisis.

library(Matrix)
colnames(Dis.Alpha$book) <- c("plots","cols","Id_Evaluador","Id_Proyecto","Repeticion")
set.seed(2020)
Z1 <- model.matrix(~0+Dis.Alpha$book$Repeticion)
Z2 <- model.matrix(~0+Dis.Alpha$book$Repeticion:Dis.Alpha$book$Id_Evaluador)
X <- model.matrix(~0+Dis.Alpha$book$Id_Proyecto)
Betas <- round(rnorm(50,7,0.75),0)
us1 <- rnorm(dim(Z1)[2],sd=2)
us2 <- rnorm(dim(Z2)[2],sd=1)
y <- X %*% Betas + Z1 %*% us1 + Z2 %*% us2+ rnorm(dim(X)[1], sd=0.2)
y[which(y>10)] <- 10

Dis.Alpha$book$Calificacion <- round(y[1: length(y),],0)
datos_alpha <- Dis.Alpha$book
head(datos_alpha)
##   plots cols Id_Evaluador Id_Proyecto Repeticion Calificacion
## 1   101    1            1 Proyecto 36          1            5
## 2   102    2            1 Proyecto 41          1            7
## 3   103    3            1 Proyecto 32          1            4
## 4   104    4            1 Proyecto 48          1            5
## 5   105    5            1 Proyecto 37          1            5
## 6   106    1            2 Proyecto 14          1            6

Para realizar el análisis de varianza se debe utilizar la función lmer(…) la cual proviene del paquete (lme4).

library(lme4)
## Warning: package 'lme4' was built under R version 4.0.3
modelo.alpha1 <- lmer(Calificacion~Id_Proyecto + (1|Repeticion) + (1|Repeticion/Id_Evaluador), data = datos_alpha)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues
summary(modelo.alpha1)
## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## Calificacion ~ Id_Proyecto + (1 | Repeticion) + (1 | Repeticion/Id_Evaluador)
##    Data: datos_alpha
## 
## REML criterion at convergence: 198.6
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -1.86384 -0.38942 -0.00661  0.38478  1.85981 
## 
## Random effects:
##  Groups                  Name        Variance Std.Dev.
##  Id_Evaluador.Repeticion (Intercept) 0.684777 0.8275  
##  Repeticion              (Intercept) 0.004224 0.0650  
##  Repeticion.1            (Intercept) 0.041105 0.2027  
##  Residual                            0.096190 0.3101  
## Number of obs: 150, groups:  Id_Evaluador:Repeticion, 30; Repeticion, 3
## 
## Fixed effects:
##                        Estimate Std. Error t value
## (Intercept)             5.96125    0.28309  21.058
## Id_ProyectoProyecto 10  1.23070    0.29692   4.145
## Id_ProyectoProyecto 11  0.02484    0.27745   0.090
## Id_ProyectoProyecto 12 -0.06978    0.29761  -0.234
## Id_ProyectoProyecto 13  0.05127    0.29692   0.173
## Id_ProyectoProyecto 14  0.05709    0.29290   0.195
## Id_ProyectoProyecto 15  0.82761    0.29340   2.821
## Id_ProyectoProyecto 16 -0.24028    0.29499  -0.815
## Id_ProyectoProyecto 17  0.29007    0.29337   0.989
## Id_ProyectoProyecto 18  0.76017    0.29635   2.565
## Id_ProyectoProyecto 19  1.12543    0.29290   3.842
## Id_ProyectoProyecto 2   0.30449    0.29519   1.032
## Id_ProyectoProyecto 20  0.10725    0.27893   0.385
## Id_ProyectoProyecto 21 -1.04282    0.27708  -3.764
## Id_ProyectoProyecto 22 -0.84961    0.29309  -2.899
## Id_ProyectoProyecto 23 -0.10724    0.29499  -0.364
## Id_ProyectoProyecto 24  1.09556    0.29214   3.750
## Id_ProyectoProyecto 25  0.02619    0.27745   0.094
## Id_ProyectoProyecto 26 -1.12316    0.29590  -3.796
## Id_ProyectoProyecto 27  1.10238    0.29761   3.704
## Id_ProyectoProyecto 28 -0.47050    0.29554  -1.592
## Id_ProyectoProyecto 29 -0.91343    0.29837  -3.061
## Id_ProyectoProyecto 3  -0.93097    0.29519  -3.154
## Id_ProyectoProyecto 30  1.39911    0.29465   4.748
## Id_ProyectoProyecto 31 -0.36746    0.29603  -1.241
## Id_ProyectoProyecto 32 -0.64234    0.29461  -2.180
## Id_ProyectoProyecto 33  1.12156    0.28930   3.877
## Id_ProyectoProyecto 34  0.19802    0.29554   0.670
## Id_ProyectoProyecto 35 -0.82841    0.29348  -2.823
## Id_ProyectoProyecto 36 -0.36691    0.28930  -1.268
## Id_ProyectoProyecto 37  0.05220    0.27712   0.188
## Id_ProyectoProyecto 38 -0.64512    0.27712  -2.328
## Id_ProyectoProyecto 39 -0.64722    0.29837  -2.169
## Id_ProyectoProyecto 4   1.20381    0.29337   4.103
## Id_ProyectoProyecto 40  1.08709    0.29290   3.711
## Id_ProyectoProyecto 41  1.98649    0.27708   7.169
## Id_ProyectoProyecto 42  0.90189    0.29590   3.048
## Id_ProyectoProyecto 43  1.30648    0.29603   4.413
## Id_ProyectoProyecto 44  2.22070    0.29290   7.582
## Id_ProyectoProyecto 45  0.73648    0.27911   2.639
## Id_ProyectoProyecto 46  0.18372    0.28045   0.655
## Id_ProyectoProyecto 47  1.05845    0.28045   3.774
## Id_ProyectoProyecto 48  0.36132    0.29309   1.233
## Id_ProyectoProyecto 49  0.63397    0.29461   2.152
## Id_ProyectoProyecto 5   0.09156    0.29465   0.311
## Id_ProyectoProyecto 50 -0.01854    0.29635  -0.063
## Id_ProyectoProyecto 6   0.25143    0.27911   0.901
## Id_ProyectoProyecto 7   0.17402    0.29348   0.593
## Id_ProyectoProyecto 8  -0.47451    0.27893  -1.701
## Id_ProyectoProyecto 9   0.03752    0.29340   0.128
## 
## Correlation matrix not shown by default, as p = 50 > 12.
## Use print(x, correlation=TRUE)  or
##     vcov(x)        if you need it
## optimizer (nloptwrap) convergence code: 0 (OK)
## unable to evaluate scaled gradient
## Model failed to converge: degenerate  Hessian with 1 negative eigenvalues
anova(modelo.alpha1)
## Analysis of Variance Table
##             npar Sum Sq Mean Sq F value
## Id_Proyecto   49 76.768  1.5667  16.287