Parcial Diseno 2020-I
Kevin Quiroga, Sergio Rocha
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()
\[ y_{ij}= \mu +\tau_i +\beta_j + \epsilon_{ij}\]
\(y_{íj}\) = Observación muestral \(\mu\) = Media ajustada \(\tau_i\) = Efecto del \(i~ésimo\) tratamiento \(\beta_j\) = Efecto del \(j~esimo\) bloque \(\epsilon_{ij}\) = Error aleatorio
BIBD
Este es un diseño factorial simple incompleto y balanceado, en bloques, parcialmente aleatorizado, se caracteriza porque el número de tratamientos es menor al de unidades experimentales \((k < t)\), y tiene una condición de aleatorización por par de niveles
\[H_0 = \hat\mu_1=\cdots=\hat\mu_5\\ H_a = At~least~one~is~different\]
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
Datos1<- data.frame(run, trt1, psi, monovinyl)
datatable(Datos1, class = 'cell-border stripe',filter = 'top', options = list(
pageLength = 6, autoWidth = TRUE))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"bar.err(out$means,variation="range",ylim=c(0,60),bar=FALSE,col=0)
# Se añade un barplot para estudiar el comportamiento de los datos
aggregate(monovinyl ~ trt1, data = Datos1, FUN = mean)## trt1 monovinyl
## 1 250 18.83333
## 2 325 18.33333
## 3 400 31.33333
## 4 475 38.00000
## 5 550 51.83333aggregate(monovinyl ~ trt1, data = Datos1, FUN = sd)## trt1 monovinyl
## 1 250 3.868678
## 2 325 6.153590
## 3 400 5.955390
## 4 475 6.928203
## 5 550 5.636193ggplot(data = Datos1, aes(x = trt1, y = monovinyl, color = trt1)) +
geom_boxplot() +
theme_bw()
# se comprueba con el shapiro test y con graficas la normalidad de los datos
sp.test <- shapiro.test(Datos1$monovinyl)
sp.test##
## Shapiro-Wilk normality test
##
## data: Datos1$monovinyl
## W = 0.95797, p-value = 0.2747par(mfrow= c(2,3))
qqnorm(Datos1[Datos1$trt1 == "250","monovinyl"], main = "250")
qqline(Datos1[Datos1$trt1 == "250","monovinyl"])
qqnorm(Datos1[Datos1$trt1 == "325","monovinyl"], main = "325")
qqline(Datos1[Datos1$trt1 == "325","monovinyl"])
qqnorm(Datos1[Datos1$trt1 == "400","monovinyl"], main = "400")
qqline(Datos1[Datos1$trt1 == "400","monovinyl"])
qqnorm(Datos1[Datos1$trt1 == "475","monovinyl"], main = "475")
qqline(Datos1[Datos1$trt1 == "475","monovinyl"])
qqnorm(Datos1[Datos1$trt1 == "550","monovinyl"], main = "550")
qqline(Datos1[Datos1$trt1 == "550","monovinyl"])
# se usa el test de Levene para comprobar la igualdad de varianzas
leveneTest(y = Datos1$monovinyl, group = Datos1$trt1, center = "median")## Warning in leveneTest.default(y = Datos1$monovinyl, group = Datos1$trt1, :
## Datos1$trt1 coerced to factor.## Levene's Test for Homogeneity of Variance (center = "median")
## Df F value Pr(>F)
## group 4 0.3944 0.8107
## 25# ANOVA
anova <- aov(Datos1$monovinyl ~ Datos1$trt1 + Datos1$run)
summary(anova)## Df Sum Sq Mean Sq F value Pr(>F)
## Datos1$trt1 4 4736 1184.1 38.40 5.18e-08 ***
## Datos1$run 9 347 38.5 1.25 0.334
## Residuals 16 493 30.8
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#gráficos par comprobar los supuestos después de correr el ANOVA
plot(anova, 1)
plot(anova, 2)
# En el plot(anova, 1) y plot(anova, 2) se puede evidenciar la homocedasticidad y la normalidad, en el ANOVA se puede evidenciar que el tratamiento tiene efecto en el monovinil.
#Prueba de comparación múltiple
TukeyHSD(anova, 'Datos1$trt1')## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Datos1$monovinyl ~ Datos1$trt1 + Datos1$run)
##
## $`Datos1$trt1`
## diff lwr upr p adj
## 325-250 -0.500000 -10.322706 9.322706 0.9998514
## 400-250 12.500000 2.677294 22.322706 0.0096500
## 475-250 19.166667 9.343961 28.989372 0.0001637
## 550-250 33.000000 23.177294 42.822706 0.0000002
## 400-325 13.000000 3.177294 22.822706 0.0070549
## 475-325 19.666667 9.843961 29.489372 0.0001226
## 550-325 33.500000 23.677294 43.322706 0.0000001
## 475-400 6.666667 -3.156039 16.489372 0.2755938
## 550-400 20.500000 10.677294 30.322706 0.0000762
## 550-475 13.833333 4.010628 23.656039 0.0041848residual <- anova$residuals
hist(residual)
#prueba de normalidad
shapiro.test(residual)##
## Shapiro-Wilk normality test
##
## data: residual
## W = 0.95181, p-value = 0.189#preuba de homocedasticidad
bartlett.test(residual~Datos1$trt1)##
## Bartlett test of homogeneity of variances
##
## data: residual by Datos1$trt1
## Bartlett's K-squared = 1.3005, df = 4, p-value = 0.8613
Punto 2
Diseño Carolina I (North Carolina Designs I) / Función: carolina ()
North Carolina Design I
Factorial incompleto, anidado, con bloqueo en el set, sin aleatorizar
\[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 \(\aplha_{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
\[H_0 = var_{F2}=var_{F3}\\ H_a = var_{F2} \neq var_{F3}\]
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"))Diseño Carolina II (North Carolina Designs II) / Función: carolina ()
North Carolina Design II
Factorial completo, sin anidamiento, sin bloquo y sin aleatorización
\[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.659Diseño Carolina III (North Carolina Designs III) / Función: carolina ()
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()
ABD
Factorial simple desbalanceado, sin anidamiento, con bloqueo incompleto, parcialmente aleatorio
ABD
Factorial simple desbalanceado, sin anidamiento, con bloqueo completo, completamente aleatorizado
\[Y_{ij}=\mu+\tau_i+\beta_j+\epsilon_{íj}\]
\[H_0 = \mu_A = \cdots =\mu_k\\ H_a = At~least~one~is~different\]
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)
DBA <- data.frame(block,trt,yield)
datatable(DBA, 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 bggplot(data = DBA, aes(x = block, y = yield, colour = block)) +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
ggplot(data = DBA, aes(x = trt, y = yield, colour = trt)) +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
ggplot(data = DBA, aes(x = block, y = yield, colour = trt)) +
geom_boxplot() + theme_bw()
#plot(out)Punto 4
Diseño Grecolatino (Graeco - latin square design) /Función: design.graeco ()
\[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\]
Graeco Latin Design
Factorial completo, aleatorizado, sin anidamiento; con bloqueo en columna, fila y letra griega
\(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
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 ' ' 1Punto 5
Diseño cuadrado latino (Latin Square Design) /Función: design.lsd()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 221079
```r
model.tables(Lsd_aov, type = "means" )$tables$Treat## Treat
## A B C
## 1198.667 1105.667 1120.333plot(TukeyHSD(Lsd_aov, "Treat"))
plot(Lsd_aov)
#Prueba de comparación múltiple
TukeyHSD(Lsd_aov, 'Treat')## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = AUC ~ Subject + Period + Treat, data = bioeqv)
##
## $Treat
## diff lwr upr p adj
## B-A -93.00000 -2354.511 2168.511 0.9686678
## C-A -78.33333 -2339.844 2183.178 0.9775653
## C-B 14.66667 -2246.844 2276.178 0.9991960residual_1 <- Lsd_aov$residuals
hist(residual_1)
#prueba de normalidad
shapiro.test(residual_1)##
## Shapiro-Wilk normality test
##
## data: residual_1
## W = 0.72813, p-value = 0.00302#preuba de homocedasticidad
bartlett.test(residual_1~bioeqv$Treat)##
## Bartlett test of homogeneity of variances
##
## data: residual_1 by bioeqv$Treat
## Bartlett's K-squared = 0, df = 2, p-value = 1## No se cuple el supuesto de normalidadEjemplo 2
Tratamiento <- c('A', 'B', 'C', 'D')
tabla <- design.lsd(trt=Tratamiento, seed = 4)
tabla## $parameters
## $parameters$design
## [1] "lsd"
##
## $parameters$trt
## [1] "A" "B" "C" "D"
##
## $parameters$r
## [1] 4
##
## $parameters$serie
## [1] 2
##
## $parameters$seed
## [1] 4
##
## $parameters$kinds
## [1] "Super-Duper"
##
## $parameters[[7]]
## [1] TRUE
##
##
## $sketch
## [,1] [,2] [,3] [,4]
## [1,] "D" "A" "C" "B"
## [2,] "B" "C" "A" "D"
## [3,] "C" "D" "B" "A"
## [4,] "A" "B" "D" "C"
##
## $book
## plots row col Tratamiento
## 1 101 1 1 D
## 2 102 1 2 A
## 3 103 1 3 C
## 4 104 1 4 B
## 5 201 2 1 B
## 6 202 2 2 C
## 7 203 2 3 A
## 8 204 2 4 D
## 9 301 3 1 C
## 10 302 3 2 D
## 11 303 3 3 B
## 12 304 3 4 A
## 13 401 4 1 A
## 14 402 4 2 B
## 15 403 4 3 D
## 16 404 4 4 Cmatrix(data=tabla$book[,4], c(5,5))## Warning in matrix(data = tabla$book[, 4], c(5, 5)): la longitud de los datos
## [16] no es un submúltiplo o múltiplo del número de filas [5] en la matriz## [,1] [,2] [,3] [,4]
## [1,] "D" "C" "B" "C"
## [2,] "A" "A" "A" "D"
## [3,] "C" "D" "A" "A"
## [4,] "B" "C" "B" "C"
## [5,] "B" "D" "D" "B"Tratamiento <- c('D', 'A', 'C', 'B',
'B', 'C', 'A', 'D',
'D', 'C', 'B', 'A',
'A', 'B', 'D', 'C')
Variedad <- c(1,1,1,1,
2,2,2,2,
3,3,3,3,
4,4,4,4)
Parcela <- c(1,2,3,4,
1,2,3,4,
1,2,3,4,
1,2,3,4)
RespuestaX <- c(12, 14, 15, 13,
11, 12, 14, 14,
13, 11, 10, 13,
8, 10, 9, 9)
TratamientoF <- factor(Tratamiento)
Vaiedad <- factor(Variedad)
Parcela <- factor(Parcela)
DatosX <- data.frame(Variedad, Parcela, RespuestaX)
ggplot(data = DatosX, aes(x = TratamientoF, y = RespuestaX, colour =TratamientoF,)) +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
ggplot(data = DatosX, aes(x = Variedad, y = RespuestaX, colour =Variedad, group = Variedad)) +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
ggplot(data = DatosX, aes(x = Parcela, y = RespuestaX, colour =Parcela,)) +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
#Gracias a los boxplots parece ser que el mayor efecto se debe a la variedad
Modelo <- lm(RespuestaX~TratamientoF+Variedad+Parcela)
anova_lsd2 <- aov(Modelo)
summary(anova_lsd2)## Df Sum Sq Mean Sq F value Pr(>F)
## TratamientoF 3 3.50 1.17 0.548 0.66338
## Variedad 1 42.05 42.05 19.750 0.00216 **
## Parcela 3 4.42 1.47 0.691 0.58246
## Residuals 8 17.03 2.13
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# El anova muestra significancia para el factor Variedad
ldsT_T<-LSD.test(y = anova_lsd2, trt = 'TratamientoF', group = T, console = T)##
## Study: anova_lsd2 ~ "TratamientoF"
##
## LSD t Test for RespuestaX
##
## Mean Square Error: 2.129167
##
## TratamientoF, means and individual ( 95 %) CI
##
## RespuestaX std r LCL UCL Min Max
## A 12.25 2.872281 4 10.567578 13.93242 8 14
## B 11.00 1.414214 4 9.317578 12.68242 10 13
## C 11.75 2.500000 4 10.067578 13.43242 9 15
## D 12.00 2.160247 4 10.317578 13.68242 9 14
##
## Alpha: 0.05 ; DF Error: 8
## Critical Value of t: 2.306004
##
## least Significant Difference: 2.379304
##
## Treatments with the same letter are not significantly different.
##
## RespuestaX groups
## A 12.25 a
## D 12.00 a
## C 11.75 a
## B 11.00 aldsT_V<-LSD.test(y = anova_lsd2, trt = 'Variedad', group = T, console = T) ##
## Study: anova_lsd2 ~ "Variedad"
##
## LSD t Test for RespuestaX
##
## Mean Square Error: 2.129167
##
## Variedad, means and individual ( 95 %) CI
##
## RespuestaX std r LCL UCL Min Max
## 1 13.50 1.2909944 4 11.817578 15.18242 12 15
## 2 12.75 1.5000000 4 11.067578 14.43242 11 14
## 3 11.75 1.5000000 4 10.067578 13.43242 10 13
## 4 9.00 0.8164966 4 7.317578 10.68242 8 10
##
## Alpha: 0.05 ; DF Error: 8
## Critical Value of t: 2.306004
##
## least Significant Difference: 2.379304
##
## Treatments with the same letter are not significantly different.
##
## RespuestaX groups
## 1 13.50 a
## 2 12.75 a
## 3 11.75 a
## 4 9.00 bldsT_P<-LSD.test(y = anova_lsd2, trt = 'Parcela', group = T, console = T)##
## Study: anova_lsd2 ~ "Parcela"
##
## LSD t Test for RespuestaX
##
## Mean Square Error: 2.129167
##
## Parcela, means and individual ( 95 %) CI
##
## RespuestaX std r LCL UCL Min Max
## 1 11.00 2.160247 4 9.317578 12.68242 8 13
## 2 11.75 1.707825 4 10.067578 13.43242 10 14
## 3 12.00 2.943920 4 10.317578 13.68242 9 15
## 4 12.25 2.217356 4 10.567578 13.93242 9 14
##
## Alpha: 0.05 ; DF Error: 8
## Critical Value of t: 2.306004
##
## least Significant Difference: 2.379304
##
## Treatments with the same letter are not significantly different.
##
## RespuestaX groups
## 4 12.25 a
## 3 12.00 a
## 2 11.75 a
## 1 11.00 aresidual_3 <- anova_lsd2$residuals
hist(residual_3)
#prueba de normalidad
shapiro.test(residual_3)##
## Shapiro-Wilk normality test
##
## data: residual_3
## W = 0.95418, p-value = 0.5587#preuba de homocedasticidad
bartlett.test(residual_3~DatosX$Variedad)##
## Bartlett test of homogeneity of variances
##
## data: residual_3 by DatosX$Variedad
## Bartlett's K-squared = 2.1207, df = 3, p-value = 0.5477plot(anova_lsd2, 1)
plot(anova_lsd2, 2)
# Se cumplen los supuestos de normalidad y homocedasticidadPunto 6
Diseño Bloques completos (Randomized Complete Block Design) /Función: design.rcbd()
Randomized Complete Block Design
Factorial simple, completamente aleatorio, sin anidamiento, con bloqueo
\[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
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
names(rcb)[2] = 'Rata'
rcb## plots Rata Dosis respuesta
## 1 101 1 0 0.60
## 2 102 1 2 0.80
## 3 103 1 1.5 0.82
## 4 104 1 1 0.81
## 5 105 1 0.5 0.50
## 6 201 2 0.5 0.51
## 7 202 2 1.5 0.61
## 8 203 2 2 0.79
## 9 204 2 1 0.78
## 10 205 2 0 0.77
## 11 301 3 0.5 0.62
## 12 302 3 0 0.82
## 13 303 3 1.5 0.83
## 14 304 3 2 0.80
## 15 305 3 1 0.52
## 16 401 4 1 0.60
## 17 402 4 1.5 0.95
## 18 403 4 2 0.91
## 19 404 4 0.5 0.95
## 20 405 4 0 0.70
## 21 501 5 0.5 0.92
## 22 502 5 1 0.82
## 23 503 5 0 1.04
## 24 504 5 2 1.13
## 25 505 5 1.5 1.03
## 26 601 6 0 0.63
## 27 602 6 1 0.93
## 28 603 6 2 1.02
## 29 604 6 1.5 0.96
## 30 605 6 0.5 0.63
## 31 701 7 0 0.84
## 32 702 7 0.5 0.74
## 33 703 7 1 0.98
## 34 704 7 2 0.98
## 35 705 7 1.5 1.00
## 36 801 8 2 0.96
## 37 802 8 1 1.24
## 38 803 8 1.5 1.27
## 39 804 8 0 1.20
## 40 805 8 0.5 1.06
## 41 901 9 2 1.01
## 42 902 9 1.5 1.23
## 43 903 9 1 1.30
## 44 904 9 0 1.25
## 45 905 9 0.5 1.24
## 46 1001 10 0 0.95
## 47 1002 10 2 1.20
## 48 1003 10 0.5 1.18
## 49 1004 10 1 1.23
## 50 1005 10 1.5 1.05ggplot(data = rcb, aes(x = Rata, y = respuesta, colour = Rata,)) +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
ggplot(data = rcb, aes(x = Dosis, y = respuesta, colour = Dosis,)) +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
ggplot(data = rcb, aes(x = Rata, y = respuesta, colour = Dosis)) +
geom_boxplot() + theme_bw()
# Gracias al boxplot se puede presumir que la mayor variación en las medias es debido a la interación con la Rata
A_de_V <- aov(respuesta~Rata + Dosis, data = rcb )
summary(A_de_V)## Df Sum Sq Mean Sq F value Pr(>F)
## Rata 9 1.6685 0.18538 10.628 8.2e-08 ***
## Dosis 4 0.1328 0.03321 1.904 0.131
## Residuals 36 0.6279 0.01744
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1plot(A_de_V, 1) # Hay homocedasticidad
plot(A_de_V, 2) # El comportamiento de los datos es Nromal
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 ()
Factorial incompleto, anidado con bloqueo en parcela (plot), totalmente aleatorizado
Split Plot
\[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
\[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="")
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 ...ggplot(data = dtsp, aes(x = fertilizer, y = mass, colour = fertilizer,)) +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
ggplot(data = dtsp, aes(x = variety, y = mass, colour = variety,)) +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
ggplot(data = dtsp, aes(x = fertilizer, y = mass, colour = variety,)) +
geom_boxplot() +
theme_bw() +
theme(legend.position = "none")
with(dtsp, interaction.plot(x.factor = variety, trace.factor = fertilizer, response = mass))
fit <- lmer(mass ~ fertilizer * variety + (1 | plot), data = dtsp)
anova_1<-anova(fit)
anova_1## 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 ' ' 1anova_2<-aov(mass~fertilizer*variety + plot:fertilizer, data = dtsp)
summary(anova_2)## Df Sum Sq Mean Sq F value Pr(>F)
## fertilizer 1 192.08 192.08 95.388 1.28e-08 ***
## variety 3 96.43 32.14 15.963 2.59e-05 ***
## fertilizer:variety 3 4.17 1.39 0.691 0.570
## fertilizer:plot 6 16.89 2.81 1.398 0.269
## Residuals 18 36.25 2.01
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1plot(anova_2, 1)
plot(anova_2, 2)
# en las graficas se puede evidenciar la homocedasticidad y la normalidad de los datos
# Gracias a los boxplot y el ANOVA se puede concluir que ambos factores tienen efecto sobre la respuestaLa relación entre fertilzante y varidad es insignificante, mientras que los efectos por separado, son significantemente diferenciadores, por lo que se rechaza \(H_0\)
Punto 8
Diseño Lattice balanceado, con análisis función PBIB.test
\[y_{ijk}=\mu+\tau_i+\gamma_j+\rho_{k(i)}+\epsilon_{ijk}\] \(y_{ijk}\) = Observaciones \(\mu\) = Media global \(\tau_i\) = Efecto del \(i-ésimo\) tratamiento \(\gamma_j\) = Efecto de la \(j-ésima\) reiplación \(\rho_{k(i)}\) = Bloque dentro del efecto replicado \(\epsilon_{ijk}\) = Error aleatorio
Diseño de bloques incompleto, sin anidamiento; factorial simple, con bloques aleatorios
Lattice design
\[H_0 = \mu_1=\cdots=\mu_9\\ H_a = At~least~one~is~different\]
# Vector replicación
rep <- rep(1:4,each=9)
# Vector bloqueo
block <- rep(1:12,each=3)
# Vector tratamiento
trt<-c(1,2,3,4,5,6,7,8,9,
3,4,8,2,6,7,1,5,9,
1,4,7,2,5,8,3,6,9,
3,5,7,2,4,9,1,6,8)
# Vector respuesta
gain.wt <-c(2.20,1.84,2.18,2.05,0.85,1.86,0.73,1.60,1.76, 1.71,1.57,1.13,1.76,2.16,1.80,1.81,1.16,1.11,1.19,1.20,1.15,2.26,1.0,1.45,2.12,2.03,1.63,2.04,0.93,1.78,1.50,1.60,1.42,1.77,1.57,1.43)
modeltt <- PBIB.test(block,trt,rep,gain.wt,k=3);modeltt##
## <<< to see the objects: means, comparison and groups. >>>## $ANOVA
## Analysis of Variance Table
##
## Response: gain.wt
## Df Sum Sq Mean Sq F value Pr(>F)
## trt 8 2.8825 0.36031 4.4875 0.005179 **
## Residuals 16 1.2847 0.08029
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## $method
## [1] "Residual (restricted) maximum likelihood"
##
## $parameters
## test name.t treatments blockSize blocks r alpha
## PBIB-lsd trt 9 3 3 4 0.05
##
## $statistics
## Efficiency Mean CV
## 0.75 1.593056 17.78701
##
## $model
## Linear mixed-effects model fit by REML
## Data: NULL
## Log-restricted-likelihood: -13.2648
## Fixed: y ~ trt.adj
## (Intercept) trt.adj2 trt.adj3 trt.adj4 trt.adj5 trt.adj6
## 1.782311621 0.002973456 0.197463644 -0.097167285 -0.839311838 0.081938789
## trt.adj7 trt.adj8 trt.adj9
## -0.403450507 -0.356258149 -0.289492696
##
## Random effects:
## Formula: ~1 | replication
## (Intercept)
## StdDev: 4.464384e-06
##
## Formula: ~1 | block.adj %in% replication
## (Intercept) Residual
## StdDev: 0.1463836 0.2833569
##
## Number of Observations: 36
## Number of Groups:
## replication block.adj %in% replication
## 4 12
##
## $Fstat
## Fit Statistics
## AIC 50.52961
## BIC 66.07965
## -2 Res Log Likelihood -13.26480
##
## $comparison
## Difference stderr pvalue
## 1 - 2 -0.002973456 0.2125236 0.9890
## 1 - 3 -0.197463644 0.2125236 0.3666
## 1 - 4 0.097167285 0.2125236 0.6536
## 1 - 5 0.839311838 0.2125236 0.0012
## 1 - 6 -0.081938789 0.2125236 0.7050
## 1 - 7 0.403450507 0.2125236 0.0758
## 1 - 8 0.356258149 0.2125236 0.1132
## 1 - 9 0.289492696 0.2125236 0.1920
## 2 - 3 -0.194490188 0.2125236 0.3738
## 2 - 4 0.100140740 0.2125236 0.6438
## 2 - 5 0.842285294 0.2125236 0.0012
## 2 - 6 -0.078965333 0.2125236 0.7150
## 2 - 7 0.406423962 0.2125236 0.0740
## 2 - 8 0.359231604 0.2125236 0.1104
## 2 - 9 0.292466151 0.2125236 0.1878
## 3 - 4 0.294630929 0.2125236 0.1846
## 3 - 5 1.036775482 0.2125236 0.0002
## 3 - 6 0.115524855 0.2125236 0.5942
## 3 - 7 0.600914151 0.2125236 0.0122
## 3 - 8 0.553721793 0.2125236 0.0192
## 3 - 9 0.486956340 0.2125236 0.0358
## 4 - 5 0.742144553 0.2125236 0.0030
## 4 - 6 -0.179106073 0.2125236 0.4118
## 4 - 7 0.306283222 0.2125236 0.1688
## 4 - 8 0.259090864 0.2125236 0.2404
## 4 - 9 0.192325411 0.2125236 0.3790
## 5 - 6 -0.921250627 0.2125236 0.0006
## 5 - 7 -0.435861332 0.2125236 0.0570
## 5 - 8 -0.483053690 0.2125236 0.0372
## 5 - 9 -0.549819143 0.2125236 0.0198
## 6 - 7 0.485389295 0.2125236 0.0364
## 6 - 8 0.438196937 0.2125236 0.0558
## 6 - 9 0.371431484 0.2125236 0.0996
## 7 - 8 -0.047192358 0.2125236 0.8270
## 7 - 9 -0.113957811 0.2125236 0.5992
## 8 - 9 -0.066765453 0.2125236 0.7574
##
## $means
## gain.wt gain.wt.adj SE r std Min Max Q25 Q50 Q75
## 1 1.7425 1.7823116 0.1552092 4 0.4162832 1.19 2.20 1.6250 1.790 1.9075
## 2 1.8400 1.7852851 0.1552092 4 0.3153834 1.50 2.26 1.6950 1.800 1.9450
## 3 2.0125 1.9797753 0.1552092 4 0.2096624 1.71 2.18 1.9575 2.080 2.1350
## 4 1.6050 1.6851443 0.1552092 4 0.3479943 1.20 2.05 1.4775 1.585 1.7125
## 5 0.9850 0.9429998 0.1552092 4 0.1317826 0.85 1.16 0.9100 0.965 1.0400
## 6 1.9050 1.8642504 0.1552092 4 0.2548856 1.57 2.16 1.7875 1.945 2.0625
## 7 1.3650 1.3788611 0.1552092 4 0.5199038 0.73 1.80 1.0450 1.465 1.7850
## 8 1.4025 1.4260535 0.1552092 4 0.1968714 1.13 1.60 1.3550 1.440 1.4875
## 9 1.4800 1.4928189 0.1552092 4 0.2836665 1.11 1.76 1.3425 1.525 1.6625
##
## $groups
## gain.wt.adj groups
## 3 1.9797753 a
## 6 1.8642504 ab
## 2 1.7852851 abc
## 1 1.7823116 abc
## 4 1.6851443 abc
## 9 1.4928189 bc
## 8 1.4260535 bc
## 7 1.3788611 cd
## 5 0.9429998 d
##
## $vartau
## trt.adj1 trt.adj2 trt.adj3 trt.adj4 trt.adj5
## trt.adj1 0.024089896 0.001506751 0.001506751 0.001506751 0.001506751
## trt.adj2 0.001506751 0.024089896 0.001506751 0.001506751 0.001506751
## trt.adj3 0.001506751 0.001506751 0.024089896 0.001506751 0.001506751
## trt.adj4 0.001506751 0.001506751 0.001506751 0.024089896 0.001506751
## trt.adj5 0.001506751 0.001506751 0.001506751 0.001506751 0.024089896
## trt.adj6 0.001506751 0.001506751 0.001506751 0.001506751 0.001506751
## trt.adj7 0.001506751 0.001506751 0.001506751 0.001506751 0.001506751
## trt.adj8 0.001506751 0.001506751 0.001506751 0.001506751 0.001506751
## trt.adj9 0.001506751 0.001506751 0.001506751 0.001506751 0.001506751
## trt.adj6 trt.adj7 trt.adj8 trt.adj9
## trt.adj1 0.001506751 0.001506751 0.001506751 0.001506751
## trt.adj2 0.001506751 0.001506751 0.001506751 0.001506751
## trt.adj3 0.001506751 0.001506751 0.001506751 0.001506751
## trt.adj4 0.001506751 0.001506751 0.001506751 0.001506751
## trt.adj5 0.001506751 0.001506751 0.001506751 0.001506751
## trt.adj6 0.024089896 0.001506751 0.001506751 0.001506751
## trt.adj7 0.001506751 0.024089896 0.001506751 0.001506751
## trt.adj8 0.001506751 0.001506751 0.024089896 0.001506751
## trt.adj9 0.001506751 0.001506751 0.001506751 0.024089896
##
## attr(,"class")
## [1] "group"Punto 9
Strip-Plot desing, con la función Strip.plot()
Strip Plot
Factorial completo, sin anidamiento, totalmente aleatorizado sin bloqueo
\[y_{ijk}=\mu+\tau_i+\beta_j+(\tau\beta)_{ij}+\gamma_k+(\tau\gamma)_{ik}+(\beta\gamma)_{jk}+\epsilon_{ijk}\]
StripPlotdata <- read_excel("D:/Kevin/Trabajos/Diseno de Experimentos/StripPlotdata.xlsx")
#View(StripPlotdata)
str(StripPlotdata)## tibble [48 x 4] (S3: tbl_df/tbl/data.frame)
## $ block : num [1:48] 1 1 1 1 1 1 1 1 1 1 ...
## $ Varieties : chr [1:48] "V1" "V1" "V1" "V1" ...
## $ Fertilizer: chr [1:48] "F1" "F2" "F3" "F4" ...
## $ yield : num [1:48] 10.2 11.1 6.8 5.3 8 9.7 8.6 3.4 2 10.9 ...StripPlotdata$Varieties <- as.factor(StripPlotdata$Varieties)
StripPlotdata$Fertilizer <- as.factor(StripPlotdata$Fertilizer)
str(StripPlotdata)## tibble [48 x 4] (S3: tbl_df/tbl/data.frame)
## $ block : num [1:48] 1 1 1 1 1 1 1 1 1 1 ...
## $ Varieties : Factor w/ 3 levels "V1","V2","V3": 1 1 1 1 2 2 2 2 3 3 ...
## $ Fertilizer: Factor w/ 4 levels "F1","F2","F3",..: 1 2 3 4 1 2 3 4 1 2 ...
## $ yield : num [1:48] 10.2 11.1 6.8 5.3 8 9.7 8.6 3.4 2 10.9 ...attach(StripPlotdata)## The following objects are masked _by_ .GlobalEnv:
##
## block, yieldVariedades <- StripPlotdata$Varieties
Fertilizante <- StripPlotdata$Fertilizer
Bloque <- StripPlotdata$block
Rendimiento <- StripPlotdata$yield
modelSP = strip.plot(BLOCK = Bloque,
COL = Variedades,
ROW = Fertilizante,
Y = Rendimiento)##
## ANALYSIS STRIP PLOT: Rendimiento
## Class level information
##
## Variedades : V1 V2 V3
## Fertilizante : F1 F2 F3 F4
## Bloque : 1 2 3 4
##
## Number of observations: 48
##
## model Y: Rendimiento ~ Bloque + Variedades + Ea + Fertilizante + Eb + Fertilizante:Variedades + Ec
##
## Analysis of Variance Table
##
## Response: Rendimiento
## Df Sum Sq Mean Sq F value Pr(>F)
## Bloque 3 13.692 4.564 2.4086 0.1007122
## Variedades 2 163.007 81.503 57.0397 0.0001248 ***
## Ea 6 8.573 1.429 0.7541 0.6144958
## Fertilizante 3 152.685 50.895 17.1086 0.0004638 ***
## Eb 9 26.773 2.975 1.5700 0.1983665
## Fertilizante:Variedades 6 40.320 6.720 3.5465 0.0170071 *
## Ec 18 34.107 1.895
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## cv(a) = 16 %, cv(b) = 23 %, cv(c) = 18.4 %, Mean = 7.491667
Presentado por los empresaurios