DOE HOME WORK WEEK 10
eswar sainath sirapurapu
11/6/2021
question 5.4
##model equation :
## $Y_{ijK} = \mu + \alpha_i + \beta_j + \alphabeta_ij + ##\epsilon_{ijk}$
## Hypothesis Test
## Ho : αβij = 0 For all ij
## Ha : αβij≠0 for some ij
## Ho : αi = 0 For all i
## Ha: αi≠0 for some i
## Ho: βj = 0 For all j
## Ha : βj≠0 for some j
## level of significance = 0.05
Response<-c(74,79,82,99,64,68,88,104,60,73,92,96,
92,98,99,104,86,104,108,110,88,88,95,99,
99,104,108,114,98,99,110,111,102,95,99,107)
Feedrate<-c(rep(1,12),rep(2,12),rep(3,12))
Doc<-rep(seq(1,4),9)
data.frame(Response,Feedrate,Doc)## Response Feedrate Doc
## 1 74 1 1
## 2 79 1 2
## 3 82 1 3
## 4 99 1 4
## 5 64 1 1
## 6 68 1 2
## 7 88 1 3
## 8 104 1 4
## 9 60 1 1
## 10 73 1 2
## 11 92 1 3
## 12 96 1 4
## 13 92 2 1
## 14 98 2 2
## 15 99 2 3
## 16 104 2 4
## 17 86 2 1
## 18 104 2 2
## 19 108 2 3
## 20 110 2 4
## 21 88 2 1
## 22 88 2 2
## 23 95 2 3
## 24 99 2 4
## 25 99 3 1
## 26 104 3 2
## 27 108 3 3
## 28 114 3 4
## 29 98 3 1
## 30 99 3 2
## 31 110 3 3
## 32 111 3 4
## 33 102 3 1
## 34 95 3 2
## 35 99 3 3
## 36 107 3 4library(GAD)## Loading required package: matrixStats## Loading required package: R.methodsS3## R.methodsS3 v1.8.1 (2020-08-26 16:20:06 UTC) successfully loaded. See ?R.methodsS3 for help.Feedrate<-as.fixed(Feedrate)
Doc<-as.fixed(Doc)
model<-aov(Response~Feedrate+Doc+Feedrate*Doc)
GAD::gad(model)## Analysis of Variance Table
##
## Response: Response
## Df Sum Sq Mean Sq F value Pr(>F)
## Feedrate 2 3160.50 1580.25 55.0184 1.086e-09 ***
## Doc 3 2125.11 708.37 24.6628 1.652e-07 ***
## Feedrate:Doc 6 557.06 92.84 3.2324 0.01797 *
## Residual 24 689.33 28.72
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1###The p-value = 0.017 and < α value of 0.05. So we reject the null hypothesis and we coclude that there is a significant interaction between the two factors.
### b
plot(model)
### c
mean(Response[1:12])## [1] 81.58333mean(Response[13:24])## [1] 97.58333mean(Response[25:36])## [1] 103.8333### d
## p-values for the test:
## p-value for feed rate:1.08e-09
## p-value for depth of cut:1.652e-07
## p-value for interaction:0.01797questin 5.34
### $Y_{ijKl} = \mu + \alpha_i + \beta_j +\gamma_k \alphabeta_ij + \epsilon_{ijkl}$
###Hypothesis interaction test :
## H0: αβij = 0 For all ij
## Ha : αβij≠0 for some ij
## Ho: αi = 0 For all i
## Ha: αi≠0 for some i
## Ho: βj = 0 For all j
## Ha: βj≠0 for some j
response<-c(74,79,82,99,64,68,88,104,60,73,92,96,
92,98,99,104,86,104,108,110,88,88,95,99,
99,104,108,114,98,99,110,111,102,95,99,107)
Feedrate<-c(rep(1,12),rep(2,12),rep(3,12))
Doc<-rep(seq(1,4),9)
block<-c(rep(1,4),rep(2,4),rep(3,4),rep(1,4),rep(2,4),rep(3,4),rep(1,4),rep(2,4),rep(3,4))
Feedrate<-as.fixed(Feedrate)
Doc<-as.fixed(Doc)
block<-as.random(block)
data.frame(response,block,Feedrate,Doc)## response block Feedrate Doc
## 1 74 1 1 1
## 2 79 1 1 2
## 3 82 1 1 3
## 4 99 1 1 4
## 5 64 2 1 1
## 6 68 2 1 2
## 7 88 2 1 3
## 8 104 2 1 4
## 9 60 3 1 1
## 10 73 3 1 2
## 11 92 3 1 3
## 12 96 3 1 4
## 13 92 1 2 1
## 14 98 1 2 2
## 15 99 1 2 3
## 16 104 1 2 4
## 17 86 2 2 1
## 18 104 2 2 2
## 19 108 2 2 3
## 20 110 2 2 4
## 21 88 3 2 1
## 22 88 3 2 2
## 23 95 3 2 3
## 24 99 3 2 4
## 25 99 1 3 1
## 26 104 1 3 2
## 27 108 1 3 3
## 28 114 1 3 4
## 29 98 2 3 1
## 30 99 2 3 2
## 31 110 2 3 3
## 32 111 2 3 4
## 33 102 3 3 1
## 34 95 3 3 2
## 35 99 3 3 3
## 36 107 3 3 4model1<-aov(response~Feedrate+Doc+Feedrate*Doc+block)
GAD::gad(model1)## Analysis of Variance Table
##
## Response: response
## Df Sum Sq Mean Sq F value Pr(>F)
## Feedrate 2 3160.50 1580.25 68.3463 3.635e-10 ***
## Doc 3 2125.11 708.37 30.6373 4.893e-08 ***
## block 2 180.67 90.33 3.9069 0.035322 *
## Feedrate:Doc 6 557.06 92.84 4.0155 0.007258 **
## Residual 22 508.67 23.12
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1###The p-value = 0.007 < α = 0.05. So we reject the null hypothesis and claim that there is a significant interaction between the two factors .
plot(model1)
##The normality of the data appears to be fairly normally distributed and also the variances doesn’t differ significantly by looking at the residual plots. It can be said that the model is adequate.
### variance components for blocks
MSB<-90.33
MSE<-23.12
difference<-MSB-MSE
variance<-difference/(3*4)
variance## [1] 5.600833###The cosiderabilly reduced sum of squares error . The p-value for interaction is 0.007 and without blocking it was 0.017. In both the cases we reject the null hypothesis and say that there is a significant interaction between the factors.Even the p-value for blocks is 0.035 which indicates that blocking has significance. So, blocking reduced SSE and also it has very much significance.
questio 13.5
## model eqaution
### $Y_{ijK} = \mu + \alpha_i + \beta_j +\alphabeta_ij + \epsilon_{ijk}$
## Hypothesis interaction test
## HO: σ2αβ = 0 (mixed efects)
## Ha: σ2αβ≠0
## Ho: σ2α = 0 (Random effects)
## Ha: σ2α≠0
## Ho: βj = 0 For all j (fixed effects)
## Ha: βj≠0 for some j
position<-c(rep(1,9),rep(2,9))
temparature<-rep(seq(1,3),6)
values<-c(570,1063,565,565,1080,510,583,1043,590,
528,988,526,547,1026,538,521,1004,532)
data.frame(values,position,temparature)## values position temparature
## 1 570 1 1
## 2 1063 1 2
## 3 565 1 3
## 4 565 1 1
## 5 1080 1 2
## 6 510 1 3
## 7 583 1 1
## 8 1043 1 2
## 9 590 1 3
## 10 528 2 1
## 11 988 2 2
## 12 526 2 3
## 13 547 2 1
## 14 1026 2 2
## 15 538 2 3
## 16 521 2 1
## 17 1004 2 2
## 18 532 2 3position<-as.random(position)
temparature<-as.fixed(temparature)
model2<-aov(values~position+temparature+position*temparature)
GAD::gad(model2)## Analysis of Variance Table
##
## Response: values
## Df Sum Sq Mean Sq F value Pr(>F)
## position 1 7160 7160 15.998 0.0017624 **
## temparature 2 945342 472671 1155.518 0.0008647 ***
## position:temparature 2 818 409 0.914 0.4271101
## Residual 12 5371 448
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1##The p-value = 0.427 and > α value = 0.05. So we fail to reject the null hypothesis for interaction effects, we need to check the main effects.so this has significant effect
##The p-value for position = 0.0017 and so we reject the null hypothesis
##The p-value for temp = 0.00086 and so we reject the null hypothesis so this has a significant effectquestion 13.6
## model equation
### $Y_{ijK} = \mu + \alpha_i + \beta_j +\alphabeta_ij + \epsilon_{ijk}$
##hypothesis
## Ho: σ2αβ = 0(mixed effects)
## Ha : σ2αβ≠0
## Ho: σ2α = 0(random effects)
## Ha: σ2α≠0
## Ho: βj = 0 For all j(fixed effects)
## Ha: βj≠0 for some j
parts<-c(rep(1,6),rep(2,6),rep(3,6),rep(4,6),rep(5,6),
rep(6,6),rep(7,6),rep(8,6),rep(9,6),rep(10,6))
operator<-c(rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3))
values<-c(50,49,50,50,48,51,
52,52,51,51,51,51,
53,50,50,54,52,51,
49,51,50,48,50,51,
48,49,48,48,49,48,
52,50,50,52,50,50,
51,51,51,51,50,50,
52,50,49,53,48,50,
50,51,50,51,48,49,
47,46,49,46,47,48)
data.frame(values,parts,operator)## values parts operator
## 1 50 1 1
## 2 49 1 1
## 3 50 1 1
## 4 50 1 2
## 5 48 1 2
## 6 51 1 2
## 7 52 2 1
## 8 52 2 1
## 9 51 2 1
## 10 51 2 2
## 11 51 2 2
## 12 51 2 2
## 13 53 3 1
## 14 50 3 1
## 15 50 3 1
## 16 54 3 2
## 17 52 3 2
## 18 51 3 2
## 19 49 4 1
## 20 51 4 1
## 21 50 4 1
## 22 48 4 2
## 23 50 4 2
## 24 51 4 2
## 25 48 5 1
## 26 49 5 1
## 27 48 5 1
## 28 48 5 2
## 29 49 5 2
## 30 48 5 2
## 31 52 6 1
## 32 50 6 1
## 33 50 6 1
## 34 52 6 2
## 35 50 6 2
## 36 50 6 2
## 37 51 7 1
## 38 51 7 1
## 39 51 7 1
## 40 51 7 2
## 41 50 7 2
## 42 50 7 2
## 43 52 8 1
## 44 50 8 1
## 45 49 8 1
## 46 53 8 2
## 47 48 8 2
## 48 50 8 2
## 49 50 9 1
## 50 51 9 1
## 51 50 9 1
## 52 51 9 2
## 53 48 9 2
## 54 49 9 2
## 55 47 10 1
## 56 46 10 1
## 57 49 10 1
## 58 46 10 2
## 59 47 10 2
## 60 48 10 2operator<-as.fixed(operator)
parts<-as.random(parts)
model3<-aov(values~operator+parts+operator*parts)
GAD::gad(model3)## Analysis of Variance Table
##
## Response: values
## Df Sum Sq Mean Sq F value Pr(>F)
## operator 1 0.417 0.4167 0.6923 0.4269
## parts 9 99.017 11.0019 7.3346 3.216e-06 ***
## operator:parts 9 5.417 0.6019 0.4012 0.9270
## Residual 40 60.000 1.5000
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1##The p-value = 0.927 > α = 0.05. So we fail to reject the null hypothesis . so there is no significant effect between the two factors
##The p-value for parts is 3.216e-06 and so we reject the null hypothesis has a significant effect
##The p-value for operator is 0.4269 and so we fail to reject the null hypothesis so does not have a significangt effectSOURCE CODE
question 5.4
Response<-c(74,79,82,99,64,68,88,104,60,73,92,96,
92,98,99,104,86,104,108,110,88,88,95,99,
99,104,108,114,98,99,110,111,102,95,99,107)
Feedrate<-c(rep(1,12),rep(2,12),rep(3,12))
Doc<-rep(seq(1,4),9)
data.frame(Response,Feedrate,Doc)
library(GAD)
Feedrate<-as.fixed(Feedrate)
Doc<-as.fixed(Doc)
model<-aov(Response~Feedrate+Doc+Feedrate*Doc)
GAD::gad(model)
plot(model)
interaction.plot( Response, Feedrate, Doc)
mean(Response[1:12])
mean(Response[13:24])
mean(Response[25:36])
question 5.34
response<-c(74,79,82,99,64,68,88,104,60,73,92,96,
92,98,99,104,86,104,108,110,88,88,95,99,
99,104,108,114,98,99,110,111,102,95,99,107)
Feedrate<-c(rep(1,12),rep(2,12),rep(3,12))
Doc<-rep(seq(1,4),9)
block<-c(rep(1,4),rep(2,4),rep(3,4),rep(1,4),rep(2,4),rep(3,4),rep(1,4),rep(2,4),rep(3,4))
Feedrate<-as.fixed(Feedrate)
Doc<-as.fixed(Doc)
block<-as.random(block)
data.frame(response,block,Feedrate,Doc)
model1<-aov(response~Feedrate+Doc+Feedrate*Doc+block)
GAD::gad(model1)
plot(model1)
MSB<-90.33
MSE<-23.12
difference<-MSB-MSE
variance<-difference/(3*4)
question 13.5
position<-c(rep(1,9),rep(2,9))
temparature<-rep(seq(1,3),6)
values<-c(570,1063,565,565,1080,510,583,1043,590,
528,988,526,547,1026,538,521,1004,532)
data.frame(values,position,temparature)
position<-as.random(position)
temparature<-as.fixed(temparature)
model2<-aov(values~position+temparature+position*temparature)
GAD::gad(model2)
question 13.6
parts<-c(rep(1,6),rep(2,6),rep(3,6),rep(4,6),rep(5,6),
rep(6,6),rep(7,6),rep(8,6),rep(9,6),rep(10,6))
operator<-c(rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3),rep(1,3),rep(2,3))
values<-c(50,49,50,50,48,51,
52,52,51,51,51,51,
53,50,50,54,52,51,
49,51,50,48,50,51,
48,49,48,48,49,48,
52,50,50,52,50,50,
51,51,51,51,50,50,
52,50,49,53,48,50,
50,51,50,51,48,49,
47,46,49,46,47,48)
data.frame(values,parts,operator)
operator<-as.fixed(operator)
parts<-as.random(parts)
model3<-aov(values~operator+parts+operator*parts)
GAD::gad(model3)