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:
feedrate <- c(rep(.2,12),rep(.25,12),rep(.30,12))
depth <- rep(c(.15,.18,.2,.25),9)
results <- 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)
Analyze the data and draw conclusions. Use a=0.05. We will perform ANOVA analysis.
Null:\(\alpha_{i}=0\) vs Alternative:\(\alpha_{i}\neq0\)
Null:\(\beta_{j}=0\) vs Alternative:\(\beta_{j}\neq0\)
Null:\(\alpha\beta_{ij}=0\) vs Alternative:\(\alpha\beta_{ij}\neq0\)
summary(aov(results~feedrate+depth+feedrate*depth))
## Df Sum Sq Mean Sq F value Pr(>F)
## feedrate 1 2970.4 2970.4 85.93 1.40e-10 ***
## depth 1 2042.3 2042.3 59.08 9.22e-09 ***
## feedrate:depth 1 413.2 413.2 11.96 0.00156 **
## Residuals 32 1106.1 34.6
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
We can see that everything is significant, since it all has a pvalue below our alpha. Since our interaction is significant, we cannot tell precisely how much our two base factors are significant, since their final pvalues have been influenced by the effect of the interaction between them. ### (b) Prepare appropriate residual plots and comment on the model’s adequacy.
plot(aov(results~feedrate+depth+feedrate*depth))
Residual plots and normality plot appear to be non patterned, we can state that our model is accurate.
Obtain point estimates of the mean surface finish at each feed rate.
dafr <- data.frame(feedrate,results)
mean(subset(dafr$results,dafr$feedrate==.2))
## [1] 81.58333
mean(subset(dafr$results,dafr$feedrate==.25))
## [1] 97.58333
mean(subset(dafr$results,dafr$feedrate==.3))
## [1] 103.8333
Find the P-values for the tests in part (a). Our pvalues were reported as
feedrate: 1.40e-10
depth: 9.22e-09
feedrate*depth: 0.00156
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?
If we take each replication as a block:
block <- rep(c(rep(1,4),rep(2,4),rep(3,4)),3)
summary(aov(results~feedrate+depth+block+feedrate*depth))
## Df Sum Sq Mean Sq F value Pr(>F)
## feedrate 1 2970.4 2970.4 95.328 5.66e-11 ***
## depth 1 2042.3 2042.3 65.543 3.84e-09 ***
## block 1 140.2 140.2 4.498 0.042029 *
## feedrate:depth 1 413.2 413.2 13.262 0.000978 ***
## Residuals 31 965.9 31.2
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
It would seem all of these are significant. Since that is the case, it would seem that blocking does matter. Our residual sum of squares and mean sqaured value has decreased as well, implying that the block does explain some variation in the model.
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.
The data from 5.13:
position <- c(rep(1,9),rep(2,9))
temp <- rep(c(rep(800,3),rep(825,3),rep(850,3)),2)
run <- rep(seq(1,3),6)
density <- c(570,565,583,1063,1080,1046,565,510,590,528,547,521,988,1026,1004,526,538,532)
Anova Test using postions as random:
library(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.
position <- as.random(position)
temp <- as.fixed(temp)
model <- aov(density~position+temp+position*temp)
GAD::gad(model)
## Analysis of Variance Table
##
## Response: density
## Df Sum Sq Mean Sq F value Pr(>F)
## position 1 7280 7280 16.601 0.0015415 **
## temp 2 947287 473644 1092.044 0.0009149 ***
## position:temp 2 867 434 0.989 0.4003364
## Residual 12 5263 439
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Both temp and position are significant.
position: 760.1111111
postion&temp: -1.6666667
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
partnum <- c(rep(1,9),rep(2,9),rep(3,9),rep(4,9),rep(5,9),rep(6,9),rep(7,9),rep(8,9),rep(9,9),rep(10,9))
inspector <- rep(c(rep(1,3),rep(2,3),rep(3,3)),10)
test <- rep(seq(1,3),30)
results <- c(37, 38, 37, 41, 41, 40, 41, 42, 41, 42, 41, 43, 42, 42, 42, 43, 42 ,43, 30, 31, 31, 31, 31, 31, 29, 30, 28, 42, 43, 42, 43, 43, 43 ,42, 42, 42, 28, 30, 29, 29, 30, 29, 31, 29, 29, 42, 42, 43, 45 ,45, 45, 44, 46, 45, 25, 26, 27, 28, 28, 30, 29, 27, 27, 40, 40, 40, 43, 42, 42, 43, 43, 41, 25, 25, 25, 27, 29, 28, 26, 26, 26 ,35, 34, 34, 35, 35, 34, 35, 34, 35
)
partnum <- as.random(partnum)
summary(aov(results~partnum+inspector+partnum*inspector))
## Df Sum Sq Mean Sq F value Pr(>F)
## partnum 9 3936 437.3 477.499 < 2e-16 ***
## inspector 1 19 19.3 21.036 1.92e-05 ***
## partnum:inspector 9 35 3.9 4.254 2e-04 ***
## Residuals 70 64 0.9
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
partnum:72.7333333
partnum&inspector:1
feedrate <- c(rep(.2,12),rep(.25,12),rep(.30,12))
depth <- rep(c(.15,.18,.2,.25),9)
results <- 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)
summary(aov(results~feedrate+depth+feedrate*depth))
plot(aov(results~feedrate+depth+feedrate*depth))
dafr <- data.frame(feedrate,results)
mean(subset(dafr$results,dafr$feedrate==.2))
mean(subset(dafr$results,dafr$feedrate==.25))
mean(subset(dafr$results,dafr$feedrate==.3))
block <- rep(c(rep(1,4),rep(2,4),rep(3,4)),3)
summary(aov(results~feedrate+depth+block+feedrate*depth))
position <- c(rep(1,9),rep(2,9))
temp <- rep(c(rep(800,3),rep(825,3),rep(850,3)),2)
run <- rep(seq(1,3),6)
density <- c(570,565,583,1063,1080,1046,565,510,590,528,547,521,988,1026,1004,526,538,532)
position: `r (7280-439)/9`
postion&temp: `r (434-439)/3`
partnum <- c(rep(1,9),rep(2,9),rep(3,9),rep(4,9),rep(5,9),rep(6,9),rep(7,9),rep(8,9),rep(9,9),rep(10,9))
inspector <- rep(c(rep(1,3),rep(2,3),rep(3,3)),10)
test <- rep(seq(1,3),30)
results <- c(37, 38, 37, 41, 41, 40, 41, 42, 41, 42, 41, 43, 42, 42, 42, 43, 42 ,43, 30, 31, 31, 31, 31, 31, 29, 30, 28, 42, 43, 42, 43, 43, 43 ,42, 42, 42, 28, 30, 29, 29, 30, 29, 31, 29, 29, 42, 42, 43, 45 ,45, 45, 44, 46, 45, 25, 26, 27, 28, 28, 30, 29, 27, 27, 40, 40, 40, 43, 42, 42, 43, 43, 41, 25, 25, 25, 27, 29, 28, 26, 26, 26 ,35, 34, 34, 35, 35, 34, 35, 34, 35
)
partnum <- as.random(partnum)
summary(aov(results~partnum+inspector+partnum*inspector))
partnum:`r (437.3-.9)/(2*3)`
partnum&inspector:`r (3.9-.9)/(3)`