Parcial I Diseno 2020-1
Catherine Ortiz & Juan Camilo Arana
4/11/2020
Punto 1
Diseño en Bloques incompletos Balanceados (Finding the Variance Analysis of the Balanced Incomplete Block Design / Función: BIB.test()
- El diseño de bloques incompleto balanceado es un arreglo tal que todos los tratamientos tienen igual número de réplicas y cada par de tratamientos se presenta en el mismo bloque un número igual de veces en algún lugar del diseño,
Modelo del diseño en bloques incompletos \[y_{ij}= \mu +\tau_i +\beta_j + \epsilon_{ij}\] En donde: - \(y_{ij}\) = es la observacion muestral - \(\mu\) = es la media general (ajustada) - \(\tau_i\) = es el efecto del \(i~ésimo\) tratamiento - \(\beta_j\) = es el efecto del \(j~ésimo\) bloqueo - \(\epsilon_{ij}\) = es el Error aleatorio
Para este tipo de diseños se puede tener una \(H_o\) que busca probarse, esta es:
\[H_0 = \hat\mu_1=\cdots=\hat\mu_5\\ H_a = At~least~one~is~different\] Donde se se espera en \(H_o\) que las medias ajustadas \(\hat\mu\) sean iguales, y por el contrario en \(H_a\) al menos una de estas sea diferente.
Diseño:
En este ejemplo, se buscaba obtener más información específica sobre el efecto de la presión en el porcentaje de conversión del metilglucósido en isómeros de monovinil. Para el tratamiento se seleccionaron presiones dentro del intervalo que producía la conversión máxima y se eligieron cinco presiones para estimar una ecuación de respuesta: 250,325,400,475 y 550 psi.
Bloqueo: Como sólo se disponía de tres cámaras de alta presión para una corrida de las condiciones experimentales, fue necesario bloquear las corridas porque no podía haber una variación sustancial de una corrida a otra producida por nuevas preparaciones de las cámaras para el experimento.
Asi en el diseño de bloques incompletos, en cada bloque se encontraban tres unidades, experimentales (cámaras presurizadas) y se usaron tres presiones diferentes en cada corrida; el diseño obtenido tenía seis réplicas de cada tratamiento de presión.
run <- gl(10,3) # 10 = Numero de bloques, 3 = unidad experimental
psi <- c(250,325,475,
250,475,550,
325,400,550,
400,475,550,
325,475,550,
250,400,475,
250,325,400,
250,400,550,
250,325,550,
325,400,475) # Tratamientos (5 tratamientos)
trt1 <- c('250','325','475',
'250','475','550',
'325','400','550',
'400','475','550',
'325','475','550',
'250','400','475',
'250','325','400',
'250','400','550',
'250','325','550',
'325','400','475') # Tratamientos (5 tratamientos)
monovinyl <- c(16,18,32,
19,46,45,
26,39,61,
21,35,55,
19,47,48,
20,33,31,
13,13,34,
21,30,52,
24,10,50,
24,31,37) # Respuestas
Dat1<- data.frame(run, trt1, psi, monovinyl)
out <- BIB.test(run,psi,monovinyl,test="waller",group=TRUE);out## $parameters
## lambda treatmeans blockSize blocks r alpha test
## 3 5 3 10 6 0.05 BIB
##
## $statistics
## Mean Efficiency CV
## 31.66667 0.8333333 17.53667
##
## $comparison
## NULL
##
## $means
## monovinyl mean.adj SE r std Min Max Q25 Q50 Q75
## 250 18.83333 20.46667 2.441759 6 3.868678 13 24 16.75 19.5 20.75
## 325 18.33333 17.53333 2.441759 6 6.153590 10 26 14.25 18.5 22.75
## 400 31.33333 30.86667 2.441759 6 5.955390 21 39 30.25 32.0 33.75
## 475 38.00000 38.80000 2.441759 6 6.928203 31 47 32.75 36.0 43.75
## 550 51.83333 50.66667 2.441759 6 5.636193 45 61 48.50 51.0 54.25
##
## $groups
## monovinyl groups
## 550 50.66667 a
## 475 38.80000 b
## 400 30.86667 c
## 250 20.46667 d
## 325 17.53333 d
##
## attr(,"class")
## [1] "group"out_1 <- BIB.test(run,psi,monovinyl,test="tukey",group=TRUE,console=TRUE);out_1##
## ANALYSIS BIB: monovinyl
## Class level information
##
## Block: 1 2 3 4 5 6 7 8 9 10
## Trt : 250 325 475 550 400
##
## Number of observations: 30
##
## Analysis of Variance Table
##
## Response: monovinyl
## Df Sum Sq Mean Sq F value Pr(>F)
## block.unadj 9 1394.7 154.96 5.0249 0.002529 **
## trt.adj 4 3688.6 922.14 29.9020 3.026e-07 ***
## Residuals 16 493.4 30.84
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## coefficient of variation: 17.5 %
## monovinyl Means: 31.66667
##
## psi, statistics
##
## monovinyl mean.adj SE r std Min Max
## 250 18.83333 20.46667 2.441759 6 3.868678 13 24
## 325 18.33333 17.53333 2.441759 6 6.153590 10 26
## 400 31.33333 30.86667 2.441759 6 5.955390 21 39
## 475 38.00000 38.80000 2.441759 6 6.928203 31 47
## 550 51.83333 50.66667 2.441759 6 5.636193 45 61
##
## Tukey
## Alpha : 0.05
## Std.err : 2.483501
## HSD : 10.76024
## Parameters BIB
## Lambda : 3
## treatmeans : 5
## Block size : 3
## Blocks : 10
## Replication: 6
##
## Efficiency factor 0.8333333
##
## <<< Book >>>
##
## Comparison between treatments means
## Difference pvalue sig.
## 250 - 325 2.933333 0.9157
## 250 - 400 -10.400000 0.0607 .
## 250 - 475 -18.333333 0.0007 ***
## 250 - 550 -30.200000 0.0000 ***
## 325 - 400 -13.333333 0.0118 *
## 325 - 475 -21.266667 0.0001 ***
## 325 - 550 -33.133333 0.0000 ***
## 400 - 475 -7.933333 0.2087
## 400 - 550 -19.800000 0.0003 ***
## 475 - 550 -11.866667 0.0272 *
##
## Treatments with the same letter are not significantly different.
##
## monovinyl groups
## 550 50.66667 a
## 475 38.80000 b
## 400 30.86667 bc
## 250 20.46667 cd
## 325 17.53333 d## $parameters
## lambda treatmeans blockSize blocks r alpha test
## 3 5 3 10 6 0.05 BIB
##
## $statistics
## Mean Efficiency CV
## 31.66667 0.8333333 17.53667
##
## $comparison
## NULL
##
## $means
## monovinyl mean.adj SE r std Min Max Q25 Q50 Q75
## 250 18.83333 20.46667 2.441759 6 3.868678 13 24 16.75 19.5 20.75
## 325 18.33333 17.53333 2.441759 6 6.153590 10 26 14.25 18.5 22.75
## 400 31.33333 30.86667 2.441759 6 5.955390 21 39 30.25 32.0 33.75
## 475 38.00000 38.80000 2.441759 6 6.928203 31 47 32.75 36.0 43.75
## 550 51.83333 50.66667 2.441759 6 5.636193 45 61 48.50 51.0 54.25
##
## $groups
## monovinyl groups
## 550 50.66667 a
## 475 38.80000 b
## 400 30.86667 bc
## 250 20.46667 cd
## 325 17.53333 d
##
## attr(,"class")
## [1] "group"datatable(Dat1, class = 'cell-border stripe',filter = 'top', options = list(
pageLength = 6, autoWidth = TRUE))library(ggplot2)
ggplot(data = Dat1, aes(x = trt1, y = monovinyl, color = trt1)) +
geom_boxplot() +
theme_bw()
mean = Media global –> 950/30 = 31.66
CV = coeficiente de variación = 17.56
comparación / diferencia = \(mean.adj_{t_1}\) - \(mean.adj_{t_2}\)
SE = Error estandar global
$grups, donde los tratamientos con la misma letra no son significativamente diferentes, se concluye que la presion de 550 psi presenta la media mas grande y aparentemente es el mejor tratamiento.
Concluye que \(H_o\) se rechaza y al menos una de las medias ajustadas \(\hat\mu\) es diferente
Punto 2
Diseño Carolina I, II, III (North Carolina Designs I, II and III) / Función: carolina ()
Carolina I
El concepto teórico de este diseño fue dado por Comstock y Robinson (1952). En este caso, la F2 o cualquier generación avanzada mantenida bajo apareamiento aleatorio, producidas por un cruzamiento entre dos líneas puras, se toman como la población referencia. De esta población se toma un individuo enforma aleatoria y se usa como macho. Un grupo de cuatro plantas, igualmente tomadas al azar, se usan como hembras y se cruzan con el macho antes mencionado. De esta forma se produce un grupo de familias de hermanos completos. Este se denota como grupo macho. De esta manera se produce un gran número de grupos macho. Ninguna de las hembras es usada en un segundo cruzamiento.
Es un sistema anidado
Factorial incompleto, anidado, con bloqueo en el set, sin aleatorizar
Modelo del diselo North Carolina I (NC1)
\[y_{ijklt} = \mu + \tau_i + \beta_{ij} + \alpha_{ik} +\rho_{ikl} + \beta\rho_{ijkl} + \epsilon_{ijklt}\] \(y_{ijklt}\) = variable de respuesta \(\mu\) = media general \(\tau_i\) = efecto del i-ésimo set , \(\beta_{ij}\) = efecto del J-ésimo bloque en el i-ésimo set \(\alpha_{ik}\) = efecto del k-ésimo macho i-ésimo set \(\rho_{ikl}\) = efecto de la I-ésima hembra cruzada con el k-ésimo macho, i-ésimo set \(\beta\rho_{ijkl}\) = efecto de interacción \(\epsilon_{ijklt}\) = error asociado a cada observación
Para este tipo de diseños la \(H_o\), puede ser \[H_0 = var_{F2}=var_{F3}\\ H_a = var_{F2} \neq var_{F3}\] Donde se espera en \(H_o\) que las varianzas de las dos generaciones comparadas sean iguales, donde \(F2\) es la generacion de hermanos cruzados y \(F3\) son su progenie. Y en \(H_a\) las varianzas de estas sean distintas.
Diseño:
Se considera un caso particular, con s= 2 sets, b = 2 repeticiones, m = 3 machos en cada set y cada uno cruzados con h = 2 hembras.
data(DC)
#View(DC$carolina1)
carolina1 <- DC$carolina1
View(carolina1)
# str(carolina1)
output<-carolina(model=1,carolina1)## Response(y): yield
##
## Analysis of Variance Table
##
## Response: y
## Df Sum Sq Mean Sq F value Pr(>F)
## set 1 0.5339 0.5339 7.2120 0.0099144 **
## set:replication 2 2.9894 1.4947 20.1914 4.335e-07 ***
## set:male 4 22.1711 5.5428 74.8743 < 2.2e-16 ***
## set:male:female 6 4.8250 0.8042 10.8630 1.311e-07 ***
## set:replication:male:female 10 3.2072 0.3207 4.3325 0.0002462 ***
## Residuals 48 3.5533 0.0740
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## CV: 8.286715 Mean: 3.283333output[][-1]## $var.m
## [1] 0.3948843
##
## $var.f
## [1] 0.08057407
##
## $var.A
## [1] 1.579537
##
## $var.D
## [1] -1.257241collapsibleTree(carolina1, hierarchy = c("male","female","progenie"),hierarchy_attribute = c("male","female","progenie"))$var.D = -1.257241
Al ser positiva la varianza aditiva, se concluye que el loci se encuentra en el genotipo de la F3, pero al ser negativa la varianza dominante, se considera que el genotipo no es expresado en un fenotipo de la F3.
Conclusión, se rechaza \(H_0\), se tiene varianza aditiva en positivo, lo que evidencia una adición de loci en el genotipo de la F3.
Carolina II
Factorial completo, sin anidamiento, sin bloquo y sin aleatorización
El método es el más usado en plantas y es un diseño factorial. Se debe utilizar en una población panmíctica en equilibrio Hardy-Weinberg, como por ejemplo la población de una F 2 o de una variedad de polinización abierta. A diferencia del diseño 1, en este método se producen medios hermanos paternales y maternales. De una población F2, n1 machos y n2 hembras son tomados aleatoriamente y cada macho es cruzado con cada una de las hembras, de tal forma que se producen n1 x n2 progenies. De esta manera, la variación se divide en dos partes, entre y dentro de familias de hermanos completos.
La variación entre familias se divide en componentes debido a diferencias entre machos, diferencias entre hembras y aquella debida a la interacción macho por hembra
Modelo del diselo North Carolina II (NC2) \[y_{íjk}=\mu+\tau_i+\beta_j+(\tau\beta)_{ij}+\epsilon_{ijk}\] \(y_{íjk}\) = \(k-ésima\) observación en la progenie \(i-j~ésima\) \(\mu\) = Media general \(\tau_i\) = Efecto del \(i-ésimo\) macho \(\beta_j\) = Efecto de la \(j-ésima\) hembra \((\tau\beta)_{ij}\) = Interacción del \(i-ésimo\) macho por la \(j-ésima\) hembra \(\epsilon_{ijk}\) = Error asociado a \(k\) observaciones
data(DC)
carolina2 <- DC$carolina2
# str(carolina2)
# View(carolina2)
majes<-subset(carolina2,carolina2[,1]==1)
majes<-majes[,c(2,5,4,3,6:8)]
output<-carolina(model=2,majes[,c(1:4,6)])## Response(y): yield
##
## Analysis of Variance Table
##
## Response: y
## Df Sum Sq Mean Sq F value Pr(>F)
## set 1 847836 847836 45.6296 1.097e-09 ***
## set:replication 4 144345 36086 1.9421 0.109652
## set:male 8 861053 107632 5.7926 5.032e-06 ***
## set:female 8 527023 65878 3.5455 0.001227 **
## set:male:female 32 807267 25227 1.3577 0.129527
## Residuals 96 1783762 18581
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## CV: 19.08779 Mean: 714.1301output[][-1]## $var.m
## [1] 2746.815
##
## $var.f
## [1] 1355.024
##
## $var.mf
## [1] 2215.415
##
## $var.Am
## [1] 10987.26
##
## $var.Af
## [1] 5420.096
##
## $var.D
## [1] 8861.659Carolina III
carolina3 <- DC$carolina3
# str(carolina3)
View(carolina3)
output<-carolina(model=3,carolina3)## Response(y): yield
##
## Analysis of Variance Table
##
## Response: y
## Df Sum Sq Mean Sq F value Pr(>F)
## set 3 2.795 0.93167 1.2784 0.300965
## set:replication 4 3.205 0.80125 1.0995 0.376215
## set:female 4 1.930 0.48250 0.6621 0.623525
## set:male 12 20.970 1.74750 2.3979 0.027770 *
## set:female:male 12 27.965 2.33042 3.1978 0.005493 **
## Residuals 28 20.405 0.72875
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## CV: 21.95932 Mean: 3.8875output[][-1]## $var.mi
## [1] 0.8008333
##
## $var.m
## [1] 0.2546875
##
## $var.A
## [1] 1.01875
##
## $var.D
## [1] 1.601667Punto 3
Diseño en bloque aumentados (Finding the Variance Analysis of the Augmented block Design) / Función: DAU.test()
Factorial simple desbalanceado, sin anidamiento, con bloqueo incompleto, parcialmente aleatorio.
Factorial simple desbalanceado, sin anidamiento, con bloqueo completo, completamente aleatorizado.
Estos son los dise~nos para dos tipos de tratamientos: los tratamientos de control (comunes) y el aumento de tratamientos. Los tratamientos comunes son aplicadas en bloques completos al azar, y el aumento de los tratamientos, al azar. Cada tratamiento se debe aplicar en cualquier bloque de una sola vez. Se entiende que los tratamientos comunes son de un mayor interes; el error estandar de la diferencia es mucho menor que cuando entre dos aumento de los de diferentes bloques.
De esta manera los tratamientos control o comunes, aparecen en cada bloque y los tratamientos aumentados solo se aplican una sola vez.
modelo del diseño
\[Y_{ij}=\mu+\tau_i+\beta_j+\epsilon_{íj}\] \(y_{íjk}\) = observación muestral \(\mu\) = Media general \(\tau_i\) = Efecto del \(i-ésimo\) tratamiento \(\beta_j\) = Efecto del \(j-ésimo\) bloqueo \(\epsilon_{ijk}\) = Error aleatorio
Para este diseño se propone la siguente \(H_o\)
\[H_0 = \mu_A = \cdots =\mu_k\\ H_a = At~least~one~is~different\]
Donde se se espera en \(H_o\) que las medias \(\mu\) sean iguales, y por el contrario en \(H_a\) al menos una de estas sea diferente.
block <- c(rep("I",7),
rep("II",6),
rep("III",7))
trt <- c("A","B","C","D","g","k","l",
"A","B","C","D","e","i",
"A","B","C","D","f","h","j") # Tratamientos control A, B, C y D.
# Aumentados g,k,l,e,i,f,h y j
yield <- c(83,77,78,78,70,75,74,
79,81,81,91,79,78,
92,79,87,81,89,96,82)
DBAu <-data.frame(block,trt,yield)
datatable(DBAu, class = 'cell-border stripe',filter = 'top', options = list(
pageLength = 6, autoWidth = TRUE))out <- DAU.test(block,trt,yield,method="lsd", group=TRUE,console = TRUE);out##
## ANALYSIS DAU: yield
## Class level information
##
## Block: I II III
## Trt : A B C D e f g h i j k l
##
## Number of observations: 20
##
## ANOVA, Treatment Adjusted
## Analysis of Variance Table
##
## Response: yield
## Df Sum Sq Mean Sq F value Pr(>F)
## block.unadj 2 360.07 180.036
## trt.adj 11 285.10 25.918 0.9609 0.5499
## Control 3 52.92 17.639 0.6540 0.6092
## Control + control.VS.aug. 8 232.18 29.022 1.0760 0.4779
## Residuals 6 161.83 26.972
##
## ANOVA, Block Adjusted
## Analysis of Variance Table
##
## Response: yield
## Df Sum Sq Mean Sq F value Pr(>F)
## trt.unadj 11 575.67 52.333
## block.adj 2 69.50 34.750 1.2884 0.3424
## Control 3 52.92 17.639 0.6540 0.6092
## Augmented 7 505.87 72.268 2.6793 0.1253
## Control vs augmented 1 16.88 16.875 0.6256 0.4591
## Residuals 6 161.83 26.972
##
## coefficient of variation: 6.4 %
## yield Means: 81.5
##
## Critical Differences (Between)
## Std Error Diff.
## Two Control Treatments 4.240458
## Two Augmented Treatments (Same Block) 7.344688
## Two Augmented Treatments(Different Blocks) 8.211611
## A Augmented Treatment and A Control Treatment 6.360687
##
##
## Treatments with the same letter are not significantly different.
##
## yield groups
## h 93.50000 a
## f 86.50000 ab
## A 84.66667 ab
## D 83.33333 ab
## C 82.00000 ab
## j 79.50000 ab
## B 79.00000 ab
## e 78.25000 ab
## k 78.25000 ab
## i 77.25000 ab
## l 77.25000 ab
## g 73.25000 b
##
## Comparison between treatments means
##
## <<< to see the objects: comparison and means >>>## $means
## yield std r Min Max Q25 Q50 Q75 mean.adj SE block
## A 84.66667 6.658328 3 79 92 81.0 83 87.5 84.66667 2.998456
## B 79.00000 2.000000 3 77 81 78.0 79 80.0 79.00000 2.998456
## C 82.00000 4.582576 3 78 87 79.5 81 84.0 82.00000 2.998456
## D 83.33333 6.806859 3 78 91 79.5 81 86.0 83.33333 2.998456
## e 79.00000 NA 1 79 79 79.0 79 79.0 78.25000 5.193479 II
## f 89.00000 NA 1 89 89 89.0 89 89.0 86.50000 5.193479 III
## g 70.00000 NA 1 70 70 70.0 70 70.0 73.25000 5.193479 I
## h 96.00000 NA 1 96 96 96.0 96 96.0 93.50000 5.193479 III
## i 78.00000 NA 1 78 78 78.0 78 78.0 77.25000 5.193479 II
## j 82.00000 NA 1 82 82 82.0 82 82.0 79.50000 5.193479 III
## k 75.00000 NA 1 75 75 75.0 75 75.0 78.25000 5.193479 I
## l 74.00000 NA 1 74 74 74.0 74 74.0 77.25000 5.193479 I
##
## $parameters
## test name.t ntr Controls Augmented blocks alpha
## DAU trt 12 4 8 3 0.05
##
## $statistics
## Mean CV
## 81.5 6.4
##
## $comparison
## NULL
##
## $groups
## yield groups
## h 93.50000 a
## f 86.50000 ab
## A 84.66667 ab
## D 83.33333 ab
## C 82.00000 ab
## j 79.50000 ab
## B 79.00000 ab
## e 78.25000 ab
## k 78.25000 ab
## i 77.25000 ab
## l 77.25000 ab
## g 73.25000 b
##
## $SE.difference
## Std Error Diff.
## Two Control Treatments 4.240458
## Two Augmented Treatments (Same Block) 7.344688
## Two Augmented Treatments(Different Blocks) 8.211611
## A Augmented Treatment and A Control Treatment 6.360687
##
## $vartau
## A B C D e f g h
## A 0.00000 17.98148 17.98148 17.98148 40.45833 40.45833 40.45833 40.45833
## B 17.98148 0.00000 17.98148 17.98148 40.45833 40.45833 40.45833 40.45833
## C 17.98148 17.98148 0.00000 17.98148 40.45833 40.45833 40.45833 40.45833
## D 17.98148 17.98148 17.98148 0.00000 40.45833 40.45833 40.45833 40.45833
## e 40.45833 40.45833 40.45833 40.45833 0.00000 67.43056 67.43056 67.43056
## f 40.45833 40.45833 40.45833 40.45833 67.43056 0.00000 67.43056 53.94444
## g 40.45833 40.45833 40.45833 40.45833 67.43056 67.43056 0.00000 67.43056
## h 40.45833 40.45833 40.45833 40.45833 67.43056 53.94444 67.43056 0.00000
## i 40.45833 40.45833 40.45833 40.45833 53.94444 67.43056 67.43056 67.43056
## j 40.45833 40.45833 40.45833 40.45833 67.43056 53.94444 67.43056 53.94444
## k 40.45833 40.45833 40.45833 40.45833 67.43056 67.43056 53.94444 67.43056
## l 40.45833 40.45833 40.45833 40.45833 67.43056 67.43056 53.94444 67.43056
## i j k l
## A 40.45833 40.45833 40.45833 40.45833
## B 40.45833 40.45833 40.45833 40.45833
## C 40.45833 40.45833 40.45833 40.45833
## D 40.45833 40.45833 40.45833 40.45833
## e 53.94444 67.43056 67.43056 67.43056
## f 67.43056 53.94444 67.43056 67.43056
## g 67.43056 67.43056 53.94444 53.94444
## h 67.43056 53.94444 67.43056 67.43056
## i 0.00000 67.43056 67.43056 67.43056
## j 67.43056 0.00000 67.43056 67.43056
## k 67.43056 67.43056 0.00000 53.94444
## l 67.43056 67.43056 53.94444 0.00000
##
## attr(,"class")
## [1] "group"print(out$groups)## yield groups
## h 93.50000 a
## f 86.50000 ab
## A 84.66667 ab
## D 83.33333 ab
## C 82.00000 ab
## j 79.50000 ab
## B 79.00000 ab
## e 78.25000 ab
## k 78.25000 ab
## i 77.25000 ab
## l 77.25000 ab
## g 73.25000 b#plot(out)ggplot(data = DBAu, aes(x = block, y = yield, colour = block)) +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
ggplot(data = DBAu, aes(x = block, y = yield, colour = trt)) +
geom_boxplot() + theme_bw()
Conclusión = Se debe utilizar el tratamiento \(h\) ya que es el que mayor rendimiento obtenido, con una significacia mayor, estadísticamente (por la medía mayor dentro de todos los tratamientos).
Punto 4
Diseño Grecolatino (Graeco - latin square design) /Función: design.graeco ()
- Este diseño en principio de basa en el diseño de cuadrados latinos, en donde se tiene un cuadrado latino (caracterizado por letras latinas) t se interpone sobre este un segundo cuadrado latino pero en donde los tratamientos se indican con letras griegas.
- Factorial completo, aleatorizado, sin anidamiento; con bloqueo en columna, fila y letra griega
modelo del diseño \[y_{íjkl}=\mu+\theta_i+\tau_j+\omega_k+\psi_l+\epsilon{ijkl}\\ i=1,2,\cdots,\rho\\ j=1,2,\cdots,\rho\\ k=1,2,\cdots,\rho\\ l=1,2,\cdots,\rho\] \(y_{íjkl}\) = Observación en fila \(i\), la columna \(l\), para la letra latina \(j\) y la letra gierga \(k\) \(\mu\) = Media global \(\theta_i\) = Efecto de la \(i-ésima\) fila \(\tau_j\) = Efecto del tratamiento \(j\) de la letra latina \(\omega_k\) = Efecto del tratamiento de la letra griega \(k\) \(\psi_l\) = Es el efecto de la colunma \(l\) \(\epsilon_{ijkl}\) = Error aleatorio
Diseño En la obtención de un determinado producto químico se está interesado en comparar 4 procedimientos. Se supone que en dicha obtención también puede influir la temperatura, presión y tipo de catalizador empleado, decidiéndose realizar un experimento en cuadrado greco-latino. Para ello, se consideran 4 niveles de cada uno de estos factores.
- Las filas representan el factor principal, procedimientos.
- Las columnas representan el factor temperatura.
- Las letras latinas representan el factor presión.
- Las letras griegas representan el factor tipo de catalizador.
tempe <- c("T1","T1","T1","T1",
"T2","T2","T2","T2",
"T3","T3","T3","T3",
"T4","T4","T4","T4")
proce <- c("P1","P2","P3","P4",
"P1","P2","P3","P4",
"P1","P2","P3","P4",
"P1","P2","P3","P4")
llatin <- c(3,2,4,1,
2,3,1,4,
1,4,2,3,
4,1,3,2)
lgrec <- c(2,3,4,1,
1,4,3,2,
4,1,2,3,
3,2,1,4)
y_i <- c(5,12,13,13,
6,10,15,11,
7,5,5,7,
11,10,8,9)
tempe <- factor(tempe)
proce <- factor(proce)
llatin <- factor(llatin)
lgrec <- factor(lgrec)
data_1 <- data.frame(tempe,proce,llatin,lgrec,y_i)
graeco <- design.graeco(llatin,lgrec,serie = 0)## not implemented design 16 x 16 , see help(design.graeco)graeco_1 <- graeco$book
plots <- as.numeric(graeco_1[,1]);plots## numeric(0)print(matrix(plots,byrow=TRUE,ncol=4))## [,1] [,2] [,3] [,4]cathe <- lm(y_i~proce+tempe+llatin+lgrec)
ANOVA <- aov(cathe)
summary(ANOVA)## Df Sum Sq Mean Sq F value Pr(>F)
## proce 3 22.19 7.396 6.017 0.0873 .
## tempe 3 57.69 19.229 15.644 0.0245 *
## llatin 3 36.69 12.229 9.949 0.0456 *
## lgrec 3 32.19 10.729 8.729 0.0542 .
## Residuals 3 3.69 1.229
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Conclusion = , se concluye que se aceptan las hipótesis de igualdad de efectos de columnas y de letra griega y se rechazan las hipótesis de igualdad de efecto de filas y de letra latina. Es decir, son significativos los efectos de los procedimientos y presión, pero no lo son los efectos de la temperatura y catalizador
Punto 5
Diseño cuadrado latino (Latin Square Design) /Función: design.lsd()
- El diseño del cuadrado latino se utiliza para eliminar dos fuentes molestas de variabilidad; es decir, permite sistemáticamente el bloqueo en dos direcciones. Por lo tanto, las filas y columnas en realidad representan dos restricciones sobre la aleatorización. En general, un cuadrado latino para p factores, o un pxp Cuadrado latino, es un cuadrado que contiene p filas y p columnas.
Modelo del diseño \[y_{ijk}=\mu + \alpha_i +\tau_j +\beta_k + \epsilon_{ijk}\\ i = 1,\cdots, \rho\\ j = 1,\cdots, \rho\\ k = 1,\cdots, \rho\]
\(y_{ijk}\) = Es la observación de la \(i-ésima\) fila, \(k-ésima\) columna y \(j-ésimo\) tratamiento $$ = media general \(\alpha_i\) = El efecto de la \(i-ésima\) de la fila \(\tau_j\) = El efecto del \(j-ésimo\) tratamiento \(\beta_k\) = El efecto de la \(k-ésima\) columna \(\epsilon_{ijk}\) = Error aleatorio
Para este diseño se propone la siguente \(H_o\) \[H_0=(\mu_a -\mu_b)=(\mu_a-\mu_c)=(\mu_b-\mu_c)\\ H_a= At~least~one~is~different\]
Diseño:
Lsd_aov <- aov( AUC ~ Subject + Period + Treat, data = bioeqv)
trat_lsd <- bioeqv$Treat
lsd_test <- design.lsd(levels(trat_lsd),serie = 3,);lsd_test## $parameters
## $parameters$design
## [1] "lsd"
##
## $parameters$trt
## [1] "A" "B" "C"
##
## $parameters$r
## [1] 3
##
## $parameters$serie
## [1] 3
##
## $parameters$seed
## [1] -1338476284
##
## $parameters$kinds
## [1] "Super-Duper"
##
## $parameters[[7]]
## [1] TRUE
##
##
## $sketch
## [,1] [,2] [,3]
## [1,] "A" "B" "C"
## [2,] "B" "C" "A"
## [3,] "C" "A" "B"
##
## $book
## plots row col levels(trat_lsd)
## 1 1001 1 1 A
## 2 1002 1 2 B
## 3 1003 1 3 C
## 4 2001 2 1 B
## 5 2002 2 2 C
## 6 2003 2 3 A
## 7 3001 3 1 C
## 8 3002 3 2 A
## 9 3003 3 3 Bsummary(Lsd_aov)## Df Sum Sq Mean Sq F value Pr(>F)
## Subject 2 114264 57132 0.258 0.795
## Period 2 45196 22598 0.102 0.907
## Treat 2 15000 7500 0.034 0.967
## Residuals 2 442158 221079model.tables(Lsd_aov, type = "means" )$tables$Treat## Treat
## A B C
## 1198.667 1105.667 1120.333plot(TukeyHSD(Lsd_aov, "Treat"))
Punto 6
Diseño Bloques completos (Randomized Complete Block Design) /Función: design.rcbd()
Factorial simple, completamente aleatorio, sin anidamiento, con bloqueo
El diseño de bloques completos se utiliza para controlar y reducir el error experimental, en él las unidades experimentales quedan estratificadas en bloques de unidades homogéneas, cada tratamiento se asigna al azar a un número igual (por lo general uno) de unidades experimentales en cada bloque y es posible hacer comparaciones más precisas entre los tratamientos dentro del conjunto homogéneo de unidades experimentales en un bloque.
Modelo del diseño \[y_{ij}=\mu+\beta_i+\tau_i+\epsilon_{íj}\] \(y_{ij}\) = Observaciones \(\mu\) = media global \(\beta_i\) = Efecto de los bloques \(\tau_i\) = Efecto de los tratamientos \(\epsilon\) = Error aleatorio
Diseño El objetivo del diseño fue evaluar el efecto del fármaco sulfato de d-anfetamina sobre el comportamiento de las ratas fue el objeto del experimento. El comportamiento en estudio fue la velocidad a la que las ratas privadas de agua presionaron una palanca para obtener agua. La respuesta fue la tasa de presión de la palanca definida como el número de presiones de la palanca dividido por el tiempo transcurrido de la sesión. Los niveles de factor de tratamiento fueron cinco dosis diferentes del fármaco en miligramos por kilogramo de peso corporal, incluida una dosis de control que consistía en solución salina solución.
Un experimento, o corrida, consistía en inyectar a una rata una dosis de fármaco, y después de una hora comenzó una sesión experimental donde una rata recibiría agua cada vez después de presionar una segunda palanca. La unidad experimental en estos experimentos no era una rata, sino el estado de una sola rata durante una experimentar o correr, ya que una rata individual podría usarse en muchos experimentos inyectándola repetidamente con diferentes dosis del medicamento (después de una período de lavado) y observando el comportamiento de presión de la palanca. Porque allí.
Una rata representa el factor de bloqueo. Cada rata recibió todos los niveles de dosis en un orden aleatorio con un período de lavado apropiado en el medio.
Dosis <- c(0.0,0.5,1,1.5,2) # dosis em mg/Kg
RCB_design <- design.rcbd(Dosis, 10,continue = F)
rata <- rcb$block
rcb <- RCB_design$book
rcb$respuesta <- drug$rate
#rcb
#A_de_V <- aov(respuesta~rata + Dosis, data = rcb )
#summary(A_de_V)Conclusiones - la prueba F muestra que no hay diferencia en los niveles de factor de tratamiento. - Hay una diferencia significativa de acuerdo a las ratas y no a la dosis
Punto 7
Diseño Parcelas divididas (Split Plot Design) /Función: design.split ()
Modelo del diseño
\[y_{ijk}=\mu+\tau_i+\beta_j+(\tau\beta)_{íj}+\gamma_k+(\tau\gamma)_{ik}+(\beta\gamma)_{jk}+(\tau\beta\gamma)_{ijk}+\epsilon_{ijk}\\ i=1,\cdots,r\\ j=1,\cdots,a\\ k=1,\cdots,b\]
\(\tau_i\) = Replicaciones \(\beta_j\) = Medias de tratamientos \((\tau\beta)_{ij}\) = Error de toda la parcela \(\gamma_k\) = Tratamiento subplot \((\tau\gamma)_{ik}\) = Las replicas x \(B\) \((\beta\gamma)_{jk}\) = Interacciones de \(A\) y \(B\) \((\tau\beta\gamma)_{ijk}\) = Error del subplot \(\epsilon_{ijk}\) = Error aleatorio
Para este modelo la \(H_o\) se propone así:
\[H_0:\mu_{Control}=\mu_{New}\\H_a:\mu_{Control}\neq\mu_{New}\]
#dtsp <- read.csv("D:/Kevin/Trabajos/Diseno de Experimentos/Dataspliplot.txt", sep="")
dtsp<- read.csv("C:/Users/Catis/Desktop/Disenno de experimentos/PARCIAL 1/Dataspliplot.txt", sep="")
datatable(dtsp,filter = "top",class = 'cell-border stripe', options = list(pageLength = 8, autoWidth = TRUE))dtsp[, "plot"] <- factor(dtsp[, "plot"])
str(dtsp)## 'data.frame': 32 obs. of 4 variables:
## $ plot : Factor w/ 8 levels "1","2","3","4",..: 7 7 7 7 5 5 5 5 6 6 ...
## $ fertilizer: chr "control" "control" "control" "control" ...
## $ variety : chr "A" "B" "C" "D" ...
## $ mass : num 11.6 7.7 12 14 8.9 9.5 11.7 15 10.8 11 ...with(dtsp, interaction.plot(x.factor = variety, trace.factor = fertilizer, response = mass))
fit <- lmer(mass ~ fertilizer * variety + (1 | plot), data = dtsp)
anova(fit)## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## fertilizer 137.413 137.413 1 6 68.2395 0.0001702 ***
## variety 96.431 32.144 3 18 15.9627 2.594e-05 ***
## fertilizer:variety 4.173 1.391 3 18 0.6907 0.5695061
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1