Homework - Week 12
Harshitha
Saad Mirza
Last compiled on November 20, 2022 at 7:55 PM - CST
1 Question 7.12
1.1 Solution:
Factor A: Length of Putt
10 ft = -1, 30 ft = 1
Factor B: Type of Putter
mallet = 1, cavity-back = -1
Factor C: Break of Putter
straight = -1, breaking = 1
Factor D: Slope of Putter
level = -1, downhill = 1
Reading the Data:
library(GAD)
length<-c(-1,1,-1,1,-1,1,-1,1,-1,1,-1,1,-1,1,-1,1)
type<-c(-1,-1,1,1,-1,-1,1,1,-1,-1,1,1,-1,-1,1,1)
brk<-c(-1,-1,-1,-1,1,1,1,1,-1,-1,-1,-1,1,1,1,1)
sp<-c(-1,-1,-1,-1,-1,-1,-1,-1,1,1,1,1,1,1,1,1)
I<-c(10,0,4,0,0,5,6.5,16.5,4.5,19.5,15,41.5,8,21.5,0,18)
II<-c(18,16.5,6,10,0,20.5,18.5,4.5,18,18,16,39,4.5,10.5,0,5)
III<-c(14,4.5,1,34,18.5,18,7.5,0,14.5,16,8.5,6.5,6.5,6.5,0,7)
IV<-c(12.5,17.5,14.5,11,19.5,20,6,23.5,10,5.5,0,3.5,10,0,4.5,10)
V<-c(19,20.5,12,25.5,16,29.5,0,8,0,10,0.5,7,13,15.5,1,32.5)
VI<-c(16,17.5,14,21.5,15,19,10,8,17.5,7,9,8.5,41,24,4,18.5)
VII<-c(18.5,33,5,0,11,10,0,8,6,36,3,36,14,16,6.5,8)
Obs<-c(I,II,III,IV,V,VI,VII)
Blk <- c(rep(1,16),rep(2,16),rep(3,16),rep(4,16),rep(5,16),rep(6,16),rep(7,16))
block<-as.fixed(Blk)
length<-as.fixed(length)
type<-as.fixed(type)
brk<-as.fixed(brk)
sp<-as.fixed(sp)
data<-data.frame(length,type,brk,sp,Obs,block)
data## length type brk sp Obs block
## 1 -1 -1 -1 -1 10.0 1
## 2 1 -1 -1 -1 0.0 1
## 3 -1 1 -1 -1 4.0 1
## 4 1 1 -1 -1 0.0 1
## 5 -1 -1 1 -1 0.0 1
## 6 1 -1 1 -1 5.0 1
## 7 -1 1 1 -1 6.5 1
## 8 1 1 1 -1 16.5 1
## 9 -1 -1 -1 1 4.5 1
## 10 1 -1 -1 1 19.5 1
## 11 -1 1 -1 1 15.0 1
## 12 1 1 -1 1 41.5 1
## 13 -1 -1 1 1 8.0 1
## 14 1 -1 1 1 21.5 1
## 15 -1 1 1 1 0.0 1
## 16 1 1 1 1 18.0 1
## 17 -1 -1 -1 -1 18.0 2
## 18 1 -1 -1 -1 16.5 2
## 19 -1 1 -1 -1 6.0 2
## 20 1 1 -1 -1 10.0 2
## 21 -1 -1 1 -1 0.0 2
## 22 1 -1 1 -1 20.5 2
## 23 -1 1 1 -1 18.5 2
## 24 1 1 1 -1 4.5 2
## 25 -1 -1 -1 1 18.0 2
## 26 1 -1 -1 1 18.0 2
## 27 -1 1 -1 1 16.0 2
## 28 1 1 -1 1 39.0 2
## 29 -1 -1 1 1 4.5 2
## 30 1 -1 1 1 10.5 2
## 31 -1 1 1 1 0.0 2
## 32 1 1 1 1 5.0 2
## 33 -1 -1 -1 -1 14.0 3
## 34 1 -1 -1 -1 4.5 3
## 35 -1 1 -1 -1 1.0 3
## 36 1 1 -1 -1 34.0 3
## 37 -1 -1 1 -1 18.5 3
## 38 1 -1 1 -1 18.0 3
## 39 -1 1 1 -1 7.5 3
## 40 1 1 1 -1 0.0 3
## 41 -1 -1 -1 1 14.5 3
## 42 1 -1 -1 1 16.0 3
## 43 -1 1 -1 1 8.5 3
## 44 1 1 -1 1 6.5 3
## 45 -1 -1 1 1 6.5 3
## 46 1 -1 1 1 6.5 3
## 47 -1 1 1 1 0.0 3
## 48 1 1 1 1 7.0 3
## 49 -1 -1 -1 -1 12.5 4
## 50 1 -1 -1 -1 17.5 4
## 51 -1 1 -1 -1 14.5 4
## 52 1 1 -1 -1 11.0 4
## 53 -1 -1 1 -1 19.5 4
## 54 1 -1 1 -1 20.0 4
## 55 -1 1 1 -1 6.0 4
## 56 1 1 1 -1 23.5 4
## 57 -1 -1 -1 1 10.0 4
## 58 1 -1 -1 1 5.5 4
## 59 -1 1 -1 1 0.0 4
## 60 1 1 -1 1 3.5 4
## 61 -1 -1 1 1 10.0 4
## 62 1 -1 1 1 0.0 4
## 63 -1 1 1 1 4.5 4
## 64 1 1 1 1 10.0 4
## 65 -1 -1 -1 -1 19.0 5
## 66 1 -1 -1 -1 20.5 5
## 67 -1 1 -1 -1 12.0 5
## 68 1 1 -1 -1 25.5 5
## 69 -1 -1 1 -1 16.0 5
## 70 1 -1 1 -1 29.5 5
## 71 -1 1 1 -1 0.0 5
## 72 1 1 1 -1 8.0 5
## 73 -1 -1 -1 1 0.0 5
## 74 1 -1 -1 1 10.0 5
## 75 -1 1 -1 1 0.5 5
## 76 1 1 -1 1 7.0 5
## 77 -1 -1 1 1 13.0 5
## 78 1 -1 1 1 15.5 5
## 79 -1 1 1 1 1.0 5
## 80 1 1 1 1 32.5 5
## 81 -1 -1 -1 -1 16.0 6
## 82 1 -1 -1 -1 17.5 6
## 83 -1 1 -1 -1 14.0 6
## 84 1 1 -1 -1 21.5 6
## 85 -1 -1 1 -1 15.0 6
## 86 1 -1 1 -1 19.0 6
## 87 -1 1 1 -1 10.0 6
## 88 1 1 1 -1 8.0 6
## 89 -1 -1 -1 1 17.5 6
## 90 1 -1 -1 1 7.0 6
## 91 -1 1 -1 1 9.0 6
## 92 1 1 -1 1 8.5 6
## 93 -1 -1 1 1 41.0 6
## 94 1 -1 1 1 24.0 6
## 95 -1 1 1 1 4.0 6
## 96 1 1 1 1 18.5 6
## 97 -1 -1 -1 -1 18.5 7
## 98 1 -1 -1 -1 33.0 7
## 99 -1 1 -1 -1 5.0 7
## 100 1 1 -1 -1 0.0 7
## 101 -1 -1 1 -1 11.0 7
## 102 1 -1 1 -1 10.0 7
## 103 -1 1 1 -1 0.0 7
## 104 1 1 1 -1 8.0 7
## 105 -1 -1 -1 1 6.0 7
## 106 1 -1 -1 1 36.0 7
## 107 -1 1 -1 1 3.0 7
## 108 1 1 -1 1 36.0 7
## 109 -1 -1 1 1 14.0 7
## 110 1 -1 1 1 16.0 7
## 111 -1 1 1 1 6.5 7
## 112 1 1 1 1 8.0 7Hypothesis:
To identify which factors are significant we perform an iterative approach i.e. perform hypothesis testing starting from testing for 4 factor interactions to testing for 2 factor interactions and then main effects
Null: \[H_o: (\tau\beta\gamma\lambda)_ijkl =0\]
Alternate:\[Ha:(\tau\beta\gamma\lambda)_ijkl\neq0\]
Analyzing it considering each replicate as Block:
model<-lm(Obs~length+type+brk+sp+block+length*type+length*brk+type*brk+length*sp+type*sp+brk*sp+length*type*brk+length*type*sp+length*brk*sp+type*brk*sp+length*type*brk*sp,data = data)
GAD::gad(model)## Analysis of Variance Table
##
## Response: Obs
## Df Sum Sq Mean Sq F value Pr(>F)
## length 1 917.1 917.15 10.3962 0.00176 **
## type 1 388.1 388.15 4.3998 0.03875 *
## brk 1 145.1 145.15 1.6453 0.20290
## sp 1 1.4 1.40 0.0158 0.90021
## block 6 376.1 62.68 0.7105 0.64202
## length:type 1 218.7 218.68 2.4788 0.11890
## length:brk 1 11.9 11.90 0.1348 0.71433
## type:brk 1 115.0 115.02 1.3038 0.25655
## length:sp 1 93.8 93.81 1.0633 0.30522
## type:sp 1 56.4 56.43 0.6397 0.42594
## brk:sp 1 1.6 1.63 0.0184 0.89227
## length:type:brk 1 7.3 7.25 0.0822 0.77499
## length:type:sp 1 113.0 113.00 1.2809 0.26073
## length:brk:sp 1 39.5 39.48 0.4476 0.50520
## type:brk:sp 1 33.8 33.77 0.3828 0.53767
## length:type:brk:sp 1 95.6 95.65 1.0842 0.30055
## Residual 90 7939.7 88.22
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1model1<-lm(Obs~length+type+brk+sp+block+length*type+length*brk+type*brk+length*sp+type*sp+brk*sp+length*type*brk+length*type*sp+length*brk*sp+type*brk*sp,data = data)
GAD::gad(model1)## Analysis of Variance Table
##
## Response: Obs
## Df Sum Sq Mean Sq F value Pr(>F)
## length 1 917.1 917.15 10.3866 0.001762 **
## type 1 388.1 388.15 4.3957 0.038804 *
## brk 1 145.1 145.15 1.6438 0.203067
## sp 1 1.4 1.40 0.0158 0.900250
## block 6 376.1 62.68 0.7098 0.642528
## length:type 1 218.7 218.68 2.4765 0.119026
## length:brk 1 11.9 11.90 0.1347 0.714449
## type:brk 1 115.0 115.02 1.3026 0.256734
## length:sp 1 93.8 93.81 1.0623 0.305413
## type:sp 1 56.4 56.43 0.6391 0.426128
## brk:sp 1 1.6 1.63 0.0184 0.892318
## length:type:brk 1 7.3 7.25 0.0821 0.775082
## length:type:sp 1 113.0 113.00 1.2797 0.260920
## length:brk:sp 1 39.5 39.48 0.4472 0.505381
## type:brk:sp 1 33.8 33.77 0.3824 0.537843
## Residual 91 8035.4 88.30
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1model2<-lm(Obs~length+type+brk+sp+block+length*type+length*brk+type*brk+length*sp+type*sp+brk*sp,data = data)
GAD::gad(model2)## Analysis of Variance Table
##
## Response: Obs
## Df Sum Sq Mean Sq F value Pr(>F)
## length 1 917.1 917.15 10.5882 0.001577 **
## type 1 388.1 388.15 4.4810 0.036886 *
## brk 1 145.1 145.15 1.6757 0.198640
## sp 1 1.4 1.40 0.0161 0.899281
## block 6 376.1 62.68 0.7236 0.631626
## length:type 1 218.7 218.68 2.5246 0.115406
## length:brk 1 11.9 11.90 0.1373 0.711780
## type:brk 1 115.0 115.02 1.3279 0.252075
## length:sp 1 93.8 93.81 1.0830 0.300678
## type:sp 1 56.4 56.43 0.6515 0.421601
## brk:sp 1 1.6 1.63 0.0188 0.891272
## Residual 95 8228.9 86.62
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Lastly, Running the model with main effects and Block:
model3<-lm(Obs~length+type+brk+sp+block,data = data)
GAD::gad(model3)## Analysis of Variance Table
##
## Response: Obs
## Df Sum Sq Mean Sq F value Pr(>F)
## length 1 917.1 917.15 10.6152 0.001528 **
## type 1 388.1 388.15 4.4925 0.036496 *
## brk 1 145.1 145.15 1.6799 0.197888
## sp 1 1.4 1.40 0.0161 0.899137
## block 6 376.1 62.68 0.7254 0.630108
## Residual 101 8726.3 86.40
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1length <- rep(rep(c(-1,1),8),7)
type <- rep(rep(c(1,1,-1,-1),4),7)
interaction.plot(length,type,Obs,col=c("blue","red"))
Since Block and other main effects are insignificant, Checking Model Adequacy with Putt Length and Putt Type as main effects:
model3<-lm(Obs~length+type,data = data)
library(ggplot2)
library(ggfortify)
autoplot(model3)
2 Question 7.20
2.1 Solution:
#To confound on ABCE and ABDF,CDEF creating,
Block1 <- c('a','b','cd','abcd','ace','bce','de','abde','cf','abcf','adf','bdf','ef','abef','acdef','bcdef')
Block2 <- c('c','abc','ad','bd','e','abe','acde','bcde','af','bf','cdf','abcdf','acef','bcef','def','abdef')
Block3 <- c('ac','bc','d','abd','ae','be','cde','abcde','f','abf','acdf','bcdf','cef','abcef','adef','bdef')
Block4 <- c('(1)','ab','acd','bcd','ce','abce','ade','bde','acf','bcf','df','abdf','aef','bef','cdef','abcdef')
confounding_scheme<-cbind(Block1,Block2,Block3,Block4)
confounding_scheme## Block1 Block2 Block3 Block4
## [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"3 Question 7.21
3.1 Solution:
#An eight block design confounded on ABCD,ACE, ABEF:
block1 <- c('b','acd','ce','abde','abcf','df','aef','bcdef')
block2 <- c('abc','d','ae','bcde','bf','acdf','cef','abdef')
block3 <- c('a','bcd','abce','de','cf','abdf','bef','acdef')
block4 <- c('c','abd','be','acde','af','bcdf','abcef','def')
block5 <- c('ac','bd','abe','cde','f','abcdf','bcef','adef')
block6 <- c('-1','abcd','bce','ade','acf','bdf','abef','cdef')
block7 <- c('bc','ad','e','abcde','abf','cdf','acef','bdef')
block8 <- c('ab','cd','ace','bde','bcf','adf','ef','abcdef')
confounding_scheme2<-cbind(block1,block2,block3,block4,block5,block6,block7,block8)
confounding_scheme2## block1 block2 block3 block4 block5 block6 block7 block8
## [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,] "df" "acdf" "abdf" "bcdf" "abcdf" "bdf" "cdf" "adf"
## [7,] "aef" "cef" "bef" "abcef" "bcef" "abef" "acef" "ef"
## [8,] "bcdef" "abdef" "acdef" "def" "adef" "cdef" "bdef" "abcdef"