Problem 7.12

\(H_{0}\): (\(\tau \beta_{ij}\)) = 0
\(H_{1}\): At least one (\(\tau \beta_{ij}\)) \(\neq\) 0
library(GAD)
## Warning: package 'GAD' was built under R version 4.0.5
## Loading required package: matrixStats
## Warning: package 'matrixStats' was built under R version 4.0.5
## Loading required package: R.methodsS3
## Warning: package 'R.methodsS3' was built under R version 4.0.3
## R.methodsS3 v1.8.1 (2020-08-26 16:20:06 UTC) successfully loaded. See ?R.methodsS3 for help.
A <- rep(rep(c(-1,1),8),7) # Factor A
B <- rep(rep(c(1,1,-1,-1),4),7) # Factor B
C <- rep(rep(c(rep(1,4),rep(-1,4)),2),7) # Factor C
D <- rep(c(rep(1,8),rep(-1,8)),7) # Factor D
I <- c(10.0,0.0,4.0,0.0,0.0,5.0,6.5,16.5,4.5,19.5,15.0,41.5,8.0,21.5,0.0,18.0)
II <- c(18.0,16.5,6.0,10.0,0.0,20.5,18.5,4.5,18.0,18.0,16.0,39.0,4.5,10.5,0.0,5.0)
III <- c(14.0,4.5,1.0,34.0,18.5,18.0,7.5,0.0,14.5,16.0,8.5,6.5,6.5,6.5,0.0,7.0)
IV <- c(12.5,17.5,14.5,11.0,19.5,20.0,6.0,23.5,10.0,5.5,0.0,3.5,10.0,0.0,4.5,10.0)
V <- c(19.0,20.5,12.0,25.5,16.0,29.5,0.0,8.0,0.0,10.0,0.5,7.0,13.0,15.5,1.0,32.5)
VI <- c(16.0,17.5,14.0,21.5,15.0,19.0,10.0,8.0,17.5,7.0,9.0,8.5,41.0,24.0,4.0,18.5)
VII <- c(18.5,33.0,5.0,0.0,11.0,10.0,0.0,8.0,6.0,36.0,3.0,36.0,14.0,16.0,6.5,8.0)
response <- c(I,II,III,IV,V,VI,VII)
dat <- as.data.frame(cbind(A,B,C,D,response))
model <- aov(response~A*B*C*D,data=dat)
summary(model)
##             Df Sum Sq Mean Sq F value  Pr(>F)   
## A            1    917   917.1  10.588 0.00157 **
## B            1    388   388.1   4.481 0.03686 * 
## C            1    145   145.1   1.676 0.19862   
## D            1      1     1.4   0.016 0.89928   
## A:B          1    219   218.7   2.525 0.11538   
## A:C          1     12    11.9   0.137 0.71178   
## B:C          1    115   115.0   1.328 0.25205   
## A:D          1     94    93.8   1.083 0.30066   
## B:D          1     56    56.4   0.651 0.42159   
## C:D          1      2     1.6   0.019 0.89127   
## A:B:C        1      7     7.3   0.084 0.77294   
## A:B:D        1    113   113.0   1.305 0.25623   
## A:C:D        1     39    39.5   0.456 0.50121   
## B:C:D        1     34    33.8   0.390 0.53386   
## A:B:C:D      1     96    95.6   1.104 0.29599   
## Residuals   96   8316    86.6                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
interaction.plot(A,B,response)

interaction.plot(A,C,response)

interaction.plot(A,D,response)

interaction.plot(B,C,response)

interaction.plot(B,D,response)

interaction.plot(C,D,response)

block <- as.fixed(rep(seq(1,7),16))
A <- as.fixed(A)
B <- as.fixed(B)
C <- as.fixed(C)
D <- as.fixed(D)
model <- lm(response~block+A*B*C*D)
gad(model)
## Analysis of Variance Table
## 
## Response: response
##          Df Sum Sq Mean Sq F value   Pr(>F)   
## block     6  397.2   66.21  0.7525 0.609049   
## A         1  917.1  917.15 10.4240 0.001736 **
## B         1  388.1  388.15  4.4116 0.038494 * 
## C         1  145.1  145.15  1.6497 0.202299   
## D         1    1.4    1.40  0.0159 0.900075   
## A:B       1  218.7  218.68  2.4855 0.118411   
## A:C       1   11.9   11.90  0.1352 0.713967   
## B:C       1  115.0  115.02  1.3073 0.255919   
## A:D       1   93.8   93.81  1.0662 0.304579   
## B:D       1   56.4   56.43  0.6414 0.425322   
## C:D       1    1.6    1.63  0.0185 0.892129   
## A:B:C     1    7.3    7.25  0.0824 0.774695   
## A:B:D     1  113.0  113.00  1.2844 0.260101   
## A:C:D     1   39.5   39.48  0.4488 0.504635   
## B:C:D     1   33.8   33.77  0.3838 0.537130   
## A:B:C:D   1   95.6   95.65  1.0871 0.299912   
## Residual 90 7918.5   87.98                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
interaction.plot(A,B,response)

interaction.plot(A,C,response)

interaction.plot(A,D,response)

interaction.plot(B,C,response)

interaction.plot(B,D,response)

interaction.plot(C,D,response)

Comparing the unblocked design and the blocked design, the p-values of the main effects and interactions do not significantly change. Additionally, the blocking does not affect the interactions, with the interaction plots being unchanged between the unblocked and unblocked design.

Problem 7.20

the effects ABCE and ABDF could be confounded with blocks. Selecting these two effects also confounds CDEF. This is proven in the calculation below:
ABCE * ABDF = \(A{^2}\)\(B{^2}\)CDEF = CDEF
The full design is shown below. The design was generated randomly by self, without a computer program
Block_1 <- c("A","B","CD","ABCD","ACE","BCE","DE","ABDE","CF","ABCF","ADF","BDF","EF","ABEF","ACDEF","BCDEF")
Block_2 <- c("C","ABC","AD","BD","E","ABE","ACDE","BCDE","AF","BF","CDF","ABCDF","ACEF","BCEF","DEF","ABDEF")
Block_3 <- c("AC","BC","D","ABD","AE","BE","CDE","ABCDE","F","ABF","ACDF","BCDF","CEF","ABCEF","ADEF","BDEF")
Block_4 <- c("(1)","AB","ACD","BCD","CE","ABCE","ADE","BDE","ACF","BCF","DF","ABDF","AEF","BEF","CDEF","ABCDEF")
con_dsgn <- cbind(Block_1,Block_2,Block_3,Block_4)
con_dsgn
##       Block_1 Block_2 Block_3 Block_4 
##  [1,] "A"     "C"     "AC"    "(1)"   
##  [2,] "B"     "ABC"   "BC"    "AB"    
##  [3,] "CD"    "AD"    "D"     "ACD"   
##  [4,] "ABCD"  "BD"    "ABD"   "BCD"   
##  [5,] "ACE"   "E"     "AE"    "CE"    
##  [6,] "BCE"   "ABE"   "BE"    "ABCE"  
##  [7,] "DE"    "ACDE"  "CDE"   "ADE"   
##  [8,] "ABDE"  "BCDE"  "ABCDE" "BDE"   
##  [9,] "CF"    "AF"    "F"     "ACF"   
## [10,] "ABCF"  "BF"    "ABF"   "BCF"   
## [11,] "ADF"   "CDF"   "ACDF"  "DF"    
## [12,] "BDF"   "ABCDF" "BCDF"  "ABDF"  
## [13,] "EF"    "ACEF"  "CEF"   "AEF"   
## [14,] "ABEF"  "BCEF"  "ABCEF" "BEF"   
## [15,] "ACDEF" "DEF"   "ADEF"  "CDEF"  
## [16,] "BCDEF" "ABDEF" "BDEF"  "ABCDEF"

Problem 7.21

In addition to the three confounded effects in the problem statement, four other effects are confounded with the design. These additional effects are BDE,CDEF,BCF, and ADF. The design was generated randomly by self, without a computer program
Block_1 <- c("B","ACD","CE","ABDE","ABCF","DE","AEF","BCDEF")
Block_2 <- c("ABC","D","AE","BCDE","BF","ACDF","CEF","ABDEF")
Block_3 <- c("A","BCD","ABCE","DE","CF","ABDF","DEF","ACDEF")
Block_4 <- c("C","ABD","BE","ACDE","AF","BCDF","ABCEF","DEF")
Block_5 <- c("AC","BD","ABE","CDE","F","ABCDF","BCEF","ADEF")
Block_6 <- c("(1)","ABCD","BCE","ADE","ACF","BDF","ABEF","CDEF")
Block_7 <- c("BC","AD","E","ABCDE","ABF","CDF","ACEF","BDEF")
Block_8 <- c("AB","CD","ACE","BDE","BCF","ADF","EF","ABCDEF")
con_dsgn_2 <- cbind(Block_1,Block_2,Block_3,Block_4,Block_5,Block_6,Block_7,Block_8)
con_dsgn_2
##      Block_1 Block_2 Block_3 Block_4 Block_5 Block_6 Block_7 Block_8 
## [1,] "B"     "ABC"   "A"     "C"     "AC"    "(1)"   "BC"    "AB"    
## [2,] "ACD"   "D"     "BCD"   "ABD"   "BD"    "ABCD"  "AD"    "CD"    
## [3,] "CE"    "AE"    "ABCE"  "BE"    "ABE"   "BCE"   "E"     "ACE"   
## [4,] "ABDE"  "BCDE"  "DE"    "ACDE"  "CDE"   "ADE"   "ABCDE" "BDE"   
## [5,] "ABCF"  "BF"    "CF"    "AF"    "F"     "ACF"   "ABF"   "BCF"   
## [6,] "DE"    "ACDF"  "ABDF"  "BCDF"  "ABCDF" "BDF"   "CDF"   "ADF"   
## [7,] "AEF"   "CEF"   "DEF"   "ABCEF" "BCEF"  "ABEF"  "ACEF"  "EF"    
## [8,] "BCDEF" "ABDEF" "ACDEF" "DEF"   "ADEF"  "CDEF"  "BDEF"  "ABCDEF"

R Code

library(GAD)
A <- rep(rep(c(-1,1),8),7) # Factor A
B <- rep(rep(c(1,1,-1,-1),4),7) # Factor B
C <- rep(rep(c(rep(1,4),rep(-1,4)),2),7) # Factor C
D <- rep(c(rep(1,8),rep(-1,8)),7) # Factor D
I <- c(10.0,0.0,4.0,0.0,0.0,5.0,6.5,16.5,4.5,19.5,15.0,41.5,8.0,21.5,0.0,18.0)
II <- c(18.0,16.5,6.0,10.0,0.0,20.5,18.5,4.5,18.0,18.0,16.0,39.0,4.5,10.5,0.0,5.0)
III <- c(14.0,4.5,1.0,34.0,18.5,18.0,7.5,0.0,14.5,16.0,8.5,6.5,6.5,6.5,0.0,7.0)
IV <- c(12.5,17.5,14.5,11.0,19.5,20.0,6.0,23.5,10.0,5.5,0.0,3.5,10.0,0.0,4.5,10.0)
V <- c(19.0,20.5,12.0,25.5,16.0,29.5,0.0,8.0,0.0,10.0,0.5,7.0,13.0,15.5,1.0,32.5)
VI <- c(16.0,17.5,14.0,21.5,15.0,19.0,10.0,8.0,17.5,7.0,9.0,8.5,41.0,24.0,4.0,18.5)
VII <- c(18.5,33.0,5.0,0.0,11.0,10.0,0.0,8.0,6.0,36.0,3.0,36.0,14.0,16.0,6.5,8.0)
response <- c(I,II,III,IV,V,VI,VII)
dat <- as.data.frame(cbind(A,B,C,D,response))
model <- aov(response~A*B*C*D,data=dat)
summary(model)
interaction.plot(A,B,response)
interaction.plot(A,C,response)
interaction.plot(A,D,response)
interaction.plot(B,C,response)
interaction.plot(B,D,response)
interaction.plot(C,D,response)
block <- as.fixed(rep(seq(1,7),16))
A <- as.fixed(A)
B <- as.fixed(B)
C <- as.fixed(C)
D <- as.fixed(D)
model <- lm(response~block+A*B*C*D)
gad(model)
interaction.plot(A,B,response)
interaction.plot(A,C,response)
interaction.plot(A,D,response)
interaction.plot(B,C,response)
interaction.plot(B,D,response)
interaction.plot(C,D,response)

Block_1 <- c("A","B","CD","ABCD","ACE","BCE","DE","ABDE","CF","ABCF","ADF","BDF","EF","ABEF","ACDEF","BCDEF")
Block_2 <- c("C","ABC","AD","BD","E","ABE","ACDE","BCDE","AF","BF","CDF","ABCDF","ACEF","BCEF","DEF","ABDEF")
Block_3 <- c("AC","BC","D","ABD","AE","BE","CDE","ABCDE","F","ABF","ACDF","BCDF","CEF","ABCEF","ADEF","BDEF")
Block_4 <- c("(1)","AB","ACD","BCD","CE","ABCE","ADE","BDE","ACF","BCF","DF","ABDF","AEF","BEF","CDEF","ABCDEF")
con_dsgn <- cbind(Block_1,Block_2,Block_3,Block_4)
con_dsgn


Block_1 <- c("B","ACD","CE","ABDE","ABCF","DE","AEF","BCDEF")
Block_2 <- c("ABC","D","AE","BCDE","BF","ACDF","CEF","ABDEF")
Block_3 <- c("A","BCD","ABCE","DE","CF","ABDF","DEF","ACDEF")
Block_4 <- c("C","ABD","BE","ACDE","AF","BCDF","ABCEF","DEF")
Block_5 <- c("AC","BD","ABE","CDE","F","ABCDF","BCEF","ADEF")
Block_6 <- c("(1)","ABCD","BCE","ADE","ACF","BDF","ABEF","CDEF")
Block_7 <- c("BC","AD","E","ABCDE","ABF","CDF","ACEF","BDEF")
Block_8 <- c("AB","CD","ACE","BDE","BCF","ADF","EF","ABCDEF")
con_dsgn_2 <- cbind(Block_1,Block_2,Block_3,Block_4,Block_5,Block_6,Block_7,Block_8)
con_dsgn_2