Problem 5.4
An engineer suspects that the surface finish of a metal part is influenced by the feed rate and the depth of cut. He selects three feed rates and four depths of cut. He then conducts a factorial experiment and obtains the following data:
Entering the data
feedrate<-c(rep(0.2,12),rep(0.25,12),rep(0.3,12))
a<-c(0.15,0.18,0.20,0.25)
depth<-c(rep(a,9))
obs<-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)
dat1<-cbind(feedrate,depth,obs)
dat1<-as.data.frame(dat1)
Part A
Analyze the data and draw conclusions. Use alpha 0.05.
Model Equation
\(Y_{ijk} = \mu + \alpha _{i} + \beta _{j} + \alpha \beta _{ij} + \epsilon _{ijk}\)
Null Hypothesis: \(\alpha \beta _{ij} = 0\) for all ij
Alternate Hypothesis: \(\alpha \beta _{ij} \neq 0\) for some ij
Analysis
library(GAD)
## Loading required package: matrixStats
## Loading required package: R.methodsS3
## R.methodsS3 v1.8.2 (2022-06-13 22:00:14 UTC) successfully loaded. See ?R.methodsS3 for help.
dat1$feedrate<-as.fixed(dat1$feedrate)
dat1$depth<-as.fixed(dat1$depth)
model1<-aov(obs~depth+feedrate+depth*feedrate,data = dat1)
gad(model1)
## Analysis of Variance Table
##
## Response: obs
## Df Sum Sq Mean Sq F value Pr(>F)
## depth 3 2125.11 708.37 24.6628 1.652e-07 ***
## feedrate 2 3160.50 1580.25 55.0184 1.086e-09 ***
## depth:feedrate 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
Comments
At alpha equals 0.05, when we test backwards we see that the interaction between the two factors is significant because the values are less than alpha specified.
Also we reject the null hypothesis because p value of interaction of 0.01797 is less than 0.05.
interaction.plot(feedrate,depth,obs)
Part B
Prepare appropriate residual plots and comment on the model’s adequacy.
plot(model1)
Part C
Obtain point estimates of the mean surface finish at each feed rate.
mean(dat1$obs[1:12])
## [1] 81.58333
var(dat1$obs[1:12])
## [1] 205.5379
mean(dat1$obs[13:24])
## [1] 97.58333
var(dat1$obs[13:24])
## [1] 64.08333
mean(dat1$obs[25:36])
## [1] 103.8333
var(dat1$obs[25:36])
## [1] 36.87879
Part D
Find the P-values for the tests in part (a).
P values are as follows:
For Depth = 1.652e-07
For Feed Rate = 1.086e-09
For Interaction = 0.01797
Problem 5.34
Reconsider the experiment in Problem 5.4. Suppose that this experiment had been conducted in three blocks, with each replicate a block. Assume that the observations in the data table are given in order, that is, the first observation in each cell comes from the first replicate, and so on. Reanalyze the data as a factorial experiment in blocks and estimate the variance component for blocks. Does it appear that blocking was useful in this experiment?
Entering the data
feedrate<-c(rep(0.2,12),rep(0.25,12),rep(0.3,12))
a<-c(0.15,0.18,0.20,0.25)
depth<-c(rep(a,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))
obs<-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)
dat2<-cbind(feedrate,depth,block,obs)
dat2<-as.data.frame(dat2)
Analysis
library(GAD)
dat2$feedrate<-as.fixed(dat2$feedrate)
dat2$depth<-as.fixed(dat2$depth)
dat2$block<-as.fixed(dat2$block)
model2<-aov(obs~feedrate+depth+block+depth*feedrate,data = dat2)
gad(model2)
## Analysis of Variance Table
##
## Response: obs
## Df Sum Sq Mean Sq F value Pr(>F)
## feedrate 2 3160.50 1580.25 68.3463 3.635e-10 ***
## depth 3 2125.11 708.37 30.6373 4.893e-08 ***
## block 2 180.67 90.33 3.9069 0.035322 *
## feedrate:depth 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
We can see that the interaction between feedrate and depth is 0.007258 which is less than alpha 0.05 which implies that there is interaction between the two factors.
The p value for the block is 0.035322 which is less than alpha 0.05 which shows that blocking was effective as it has significant effect on our model. Also the sum squared error gets reduced after adding the block which in turn increases our F value.
VarBlock <- c((90.3 - 23.1)/(3*4))
VarBlock
## [1] 5.6
Question 13.5
Suppose that in Problem 5.13 the furnace positions were randomly selected, resulting in a mixed model experiment. Reanalyze the data from this experiment under this new assumption. Estimate the appropriate model components using the ANOVA method.
Data Entry:
Position <- c(rep(1,9), rep(2,9))
Temperature <- rep(seq(1,3),6)
Response <- c(570, 1063, 565, 565, 1080, 510, 583, 1043, 590, 528, 988, 526, 547, 1026,
538, 521, 1004, 532)
Data1 <- data.frame(Position, Temperature, Response)
Analysis:
library(GAD)
Position <- as.random(Position)
Temperature <- as.fixed(Temperature)
Model <- aov(Response~Position+Temperature+Position*Temperature)
GAD::gad(Model)
## Analysis of Variance Table
##
## Response: Response
## Df Sum Sq Mean Sq F value Pr(>F)
## Position 1 7160 7160 15.998 0.0017624 **
## Temperature 2 945342 472671 1155.518 0.0008647 ***
## Position:Temperature 2 818 409 0.914 0.4271101
## Residual 12 5371 448
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Comments:
Position: P value for part is 0.0017624 , which is < 0.05 , which implies , position has significant effect on our model. Temperature: P value for part is 00.0008647 , which is < 0.05 , which implies , Temperature has significant effect on our model.
Position: Temperature Intrection: P value for part is 0.4271101 , which is > 0.05 , which implies , interaction do not have significant effect on our model.
Question 13.6
Reanalyze the measurement systems experiment in Problem 13.1, assuming that operators are a fixed factor.Estimate the appropriate model components using the ANOVA method.
Data Entry:
Part <- 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))
Readings <- 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 <- data.frame(Part, Operator, Readings)
Analysis:
library(GAD)
Part <- as.random(Part)
Operator <- as.fixed(Operator)
Model <- aov(Readings~Part+Operator+Part*Operator)
GAD::gad(Model)
## Analysis of Variance Table
##
## Response: Readings
## Df Sum Sq Mean Sq F value Pr(>F)
## Part 9 99.017 11.0019 7.3346 3.216e-06 ***
## Operator 1 0.417 0.4167 0.6923 0.4269
## Part:Operator 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
Comment:
Part: P value for part is 3.216e-06 , which is < 0.05 , which implies , part has significant effect on our model.
Part and Operator interaction: P value is 0.927 > 0.05 , which implies that there is no significant interaction between part and operator.
Operator: P value for operator is 0.4269 , which is > 0.05 , which implies it does not have significant effect on our model.