Homework, week 10 - IE 5342
Forest Kingfisher
2021-11-06
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:
# Read in the data table for 5.4
dat54<-read.csv("https://raw.githubusercontent.com/forestwhite/RStatistics/main/54Table.csv")
dat54 <- subset (dat54, select = -c(X,X.1,X.2))
names(dat54) <- sub('ï..', '', names(dat54))
dat54## feed.rate depth finish
## 1 0.20 0.15 74
## 2 0.20 0.15 64
## 3 0.20 0.15 60
## 4 0.25 0.15 92
## 5 0.25 0.15 86
## 6 0.25 0.15 88
## 7 0.30 0.15 99
## 8 0.30 0.15 98
## 9 0.30 0.15 102
## 10 0.20 0.18 79
## 11 0.20 0.18 68
## 12 0.20 0.18 73
## 13 0.25 0.18 98
## 14 0.25 0.18 104
## 15 0.25 0.18 88
## 16 0.30 0.18 104
## 17 0.30 0.18 99
## 18 0.30 0.18 95
## 19 0.20 0.20 82
## 20 0.20 0.20 88
## 21 0.20 0.20 92
## 22 0.25 0.20 99
## 23 0.25 0.20 108
## 24 0.25 0.20 95
## 25 0.30 0.20 108
## 26 0.30 0.20 110
## 27 0.30 0.20 99
## 28 0.20 0.25 99
## 29 0.20 0.25 104
## 30 0.20 0.25 96
## 31 0.25 0.25 104
## 32 0.25 0.25 110
## 33 0.25 0.25 99
## 34 0.30 0.25 114
## 35 0.30 0.25 111
## 36 0.30 0.25 107(a) Analyze the data and draw conclusions. Use α = 0.05.
Feed rate and Cut Depth are significant (99% conficence). However, the interaction of the feed rate and cut depths is significant (95% confident) so we must look at an interaction plot. In this case, there is an increase in finish as both feed rate and cut depth increase, but the net effect/variance on the finish of cut depth is greater at feed rate 0.2 than it is for feed rate 0.25 and 0.3. At feed rate 0.3, there is no net effect/variance difference for cut depths 0.15 and 0.18.
# designate fixed factors as fixed
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.Feedrate <- as.fixed(dat54$feed.rate)
Feedrate## [1] 0.2 0.2 0.2 0.25 0.25 0.25 0.3 0.3 0.3 0.2 0.2 0.2 0.25 0.25 0.25
## [16] 0.3 0.3 0.3 0.2 0.2 0.2 0.25 0.25 0.25 0.3 0.3 0.3 0.2 0.2 0.2
## [31] 0.25 0.25 0.25 0.3 0.3 0.3
## Levels: 0.2 0.25 0.3Depth <- as.fixed(dat54$depth)
Depth## [1] 0.15 0.15 0.15 0.15 0.15 0.15 0.15 0.15 0.15 0.18 0.18 0.18 0.18 0.18 0.18
## [16] 0.18 0.18 0.18 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.25 0.25 0.25
## [31] 0.25 0.25 0.25 0.25 0.25 0.25
## Levels: 0.15 0.18 0.2 0.25# Apply analysis of variance model
model <- lm(dat54$finish ~ Feedrate+Depth+Feedrate*Depth)
gad(model)## Analysis of Variance Table
##
## Response: dat54$finish
## Df Sum Sq Mean Sq F value Pr(>F)
## Feedrate 2 3160.50 1580.25 55.0184 1.086e-09 ***
## Depth 3 2125.11 708.37 24.6628 1.652e-07 ***
## Feedrate:Depth 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# Produce an interaction plot
interaction.plot(x.factor = Feedrate,
trace.factor = Depth,
response = dat54$finish,
fun = mean,
type="b", ### Show plot points as symbols
col=c("steelblue","firebrick2", "forestgreen", "orange"), ### Colors for levels of trace var.
pch=c(19, 17, 15, 13), ### Symbols for levels of trace var.
fixed=TRUE, ### Order by factor order in data
leg.bty = "o") ### Legend box
(b) Prepare appropriate residual plots and comment on the model’s adequacy.
The data is generally normally distributed with a few outliers. We should consider discounting observations 1 and 15.
# AOV normal Q-Q plots of the data
plot(model,2)
The data sets for each treatment generally have uniform variance. The model is adequate without transformation or non-parametric tests.
# AOV residuals vs fitted comparison the data
plot(model,1)
(c) Obtain point estimates of the mean surface finish at each feed rate.
- Feed Rate = 0.20: Avg(Finish) = 81.583
- Feed Rate = 0.25: Avg(Finish) = 97.583
- Feed Rate = 0.30: Avg(Finish) = 103.83
(d) Find the P-values for the tests in part (a).
The P-values for the factors and their interaction are:
- Feed rate: 1.086e-09
- Cut Depth: 1.652e-07
- Feed rate*Cut Depth: 0.01797
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.
# Read in the data table for 5.34
dat534<-read.csv("https://raw.githubusercontent.com/forestwhite/RStatistics/main/534Table.csv")
dat534 <- subset (dat534, select = -c(X,X.1,X.2))
names(dat534) <- sub('ï..', '', names(dat534))
dat534$finish## [1] 74 64 60 92 86 88 99 98 102 79 68 73 98 104 88 104 99 95 82
## [20] 88 92 99 108 95 108 110 99 99 104 96 104 110 99 114 111 107Reanalyze 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?
No. With fixed effects such as these, blocking influences the sum of squares error we compare the treatment sum of sqaures with, so there is evidence that the replicate values are significant. However, there is little change in the conclusion for the significance of feed rate, cut depth, and the interaction of feed rate and cut depth, so blocking did not provide additional insight already established in non-blocked experimental design.
# designate fixed factors as fixed
library(GAD)
Replicate <- as.fixed(dat534$replicate)
Replicate## [1] 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3
## Levels: 1 2 3Feedrate <- as.fixed(dat534$feed.rate)
Feedrate## [1] 0.2 0.2 0.2 0.25 0.25 0.25 0.3 0.3 0.3 0.2 0.2 0.2 0.25 0.25 0.25
## [16] 0.3 0.3 0.3 0.2 0.2 0.2 0.25 0.25 0.25 0.3 0.3 0.3 0.2 0.2 0.2
## [31] 0.25 0.25 0.25 0.3 0.3 0.3
## Levels: 0.2 0.25 0.3Depth <- as.fixed(dat534$depth)
Depth## [1] 0.15 0.15 0.15 0.15 0.15 0.15 0.15 0.15 0.15 0.18 0.18 0.18 0.18 0.18 0.18
## [16] 0.18 0.18 0.18 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.25 0.25 0.25
## [31] 0.25 0.25 0.25 0.25 0.25 0.25
## Levels: 0.15 0.18 0.2 0.25# Apply analysis of variance model
model <- lm(dat534$finish ~ Replicate+Feedrate+Depth+Feedrate*Depth)
gad(model)## Analysis of Variance Table
##
## Response: dat534$finish
## Df Sum Sq Mean Sq F value Pr(>F)
## Replicate 2 180.67 90.33 3.9069 0.035322 *
## Feedrate 2 3160.50 1580.25 68.3463 3.635e-10 ***
## Depth 3 2125.11 708.37 30.6373 4.893e-08 ***
## 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# Produce an interaction plot
interaction.plot(x.factor = Feedrate,
trace.factor = Depth,
response = dat534$finish,
fun = mean,
type="b", ### Show plot points as symbols
col=c("steelblue","firebrick2", "forestgreen", "orange"), ### Colors for levels of trace var.
pch=c(19, 17, 15, 13), ### Symbols for levels of trace var.
fixed=TRUE, ### Order by factor order in data
leg.bty = "o") ### Legend box
13.5
Suppose that in Problem 5.13 the furnace positions were randomly selected, resulting in a mixed model experiment.
5.13. An experiment was conducted to determine whether either firing temperature or furnace position affects the baked density of a carbon anode. The data are shown below:
# Read in the data table for 5.13
dat513<-read.csv("https://raw.githubusercontent.com/forestwhite/RStatistics/main/513Table.csv")
names(dat513) <- sub('ï..', '', names(dat513))
dat513## position temperature density
## 1 1 800 570
## 2 1 800 565
## 3 1 800 583
## 4 2 800 528
## 5 2 800 547
## 6 2 800 521
## 7 1 825 1063
## 8 1 825 1080
## 9 1 825 1043
## 10 2 825 988
## 11 2 825 1026
## 12 2 825 1004
## 13 1 850 565
## 14 1 850 510
## 15 1 850 590
## 16 2 850 526
## 17 2 850 538
## 18 2 850 532Suppose we assume that no interaction exists. Write down the statistical model. Conduct the analysis of variance and test hypotheses on the main effects. What conclusions can be drawn? Comment on the model’s adequacy.
Reanalyze the data from this experiment under this new assumption. Estimate the appropriate model components using the ANOVA method.
The Temperature and Position are significant factors in determining the resulting density, but they are independent factors as their interaction is not significant.
- Estimate σ2 = MSError = 448
- Estimate position σ2 = (MSB-MSError)/bn = (7160 - 448)/(2 * 3) = 1118.67
- Estimate interaction σ2 = (MSAB-MSError)/n = (409 - 448)/3 = -0.299 < 0 -> interaction variance = 0
# designate fixed factors as fixed
library(GAD)
Temperature <- as.fixed(dat513$temperature)
Temperature## [1] 800 800 800 800 800 800 825 825 825 825 825 825 850 850 850 850 850 850
## Levels: 800 825 850# designate random factors as random
Position <- as.random(dat513$position)
Position## [1] 1 1 1 2 2 2 1 1 1 2 2 2 1 1 1 2 2 2
## Levels: 1 2# Apply analysis of variance model
model <- lm(dat513$density ~ Temperature+Position+Temperature*Position)
gad(model)## Analysis of Variance Table
##
## Response: dat513$density
## Df Sum Sq Mean Sq F value Pr(>F)
## Temperature 2 945342 472671 1155.518 0.0008647 ***
## Position 1 7160 7160 15.998 0.0017624 **
## Temperature:Position 2 818 409 0.914 0.4271101
## Residual 12 5371 448
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 113.6
Reanalyze the measurement systems experiment in Problem 13.1, assuming that operators are a fixed factor.
13.1. An experiment was performed to investigate the capability of a measurement system. Ten parts were randomly selected, and two randomly selected operators measured each part three times. The tests were made in random order, and the data are shown in Table P13.1.
# Read in the data table for 13.6
dat136<-read.csv("https://raw.githubusercontent.com/forestwhite/RStatistics/main/136Table.csv")
dat136 <- subset (dat136, select = -c(X,X.1,X.2,X.3,X.4))
names(dat136) <- sub('ï..', '', names(dat136))
dat136## replicate operator part measurement
## 1 1 1 1 50
## 2 1 1 2 52
## 3 1 1 3 53
## 4 1 1 4 49
## 5 1 1 5 48
## 6 1 1 6 52
## 7 1 1 7 51
## 8 1 1 8 52
## 9 1 1 9 50
## 10 1 1 10 47
## 11 2 1 1 49
## 12 2 1 2 52
## 13 2 1 3 50
## 14 2 1 4 51
## 15 2 1 5 49
## 16 2 1 6 50
## 17 2 1 7 51
## 18 2 1 8 50
## 19 2 1 9 51
## 20 2 1 10 46
## 21 3 1 1 50
## 22 3 1 2 51
## 23 3 1 3 50
## 24 3 1 4 50
## 25 3 1 5 48
## 26 3 1 6 50
## 27 3 1 7 51
## 28 3 1 8 49
## 29 3 1 9 50
## 30 3 1 10 49
## 31 1 2 1 50
## 32 1 2 2 51
## 33 1 2 3 54
## 34 1 2 4 48
## 35 1 2 5 48
## 36 1 2 6 52
## 37 1 2 7 51
## 38 1 2 8 53
## 39 1 2 9 51
## 40 1 2 10 46
## 41 2 2 1 48
## 42 2 2 2 51
## 43 2 2 3 52
## 44 2 2 4 50
## 45 2 2 5 49
## 46 2 2 6 50
## 47 2 2 7 50
## 48 2 2 8 48
## 49 2 2 9 48
## 50 2 2 10 47
## 51 3 2 1 51
## 52 3 2 2 51
## 53 3 2 3 51
## 54 3 2 4 51
## 55 3 2 5 48
## 56 3 2 6 50
## 57 3 2 7 50
## 58 3 2 8 50
## 59 3 2 9 49
## 60 3 2 10 48- Analyze the data from this experiment.
- Estimate the variance components using the ANOVA method.
Estimate the appropriate model components using the ANOVA method.
- Estimate σ2 = MSError = 1.500
- Estimate operator σ2 = (MSA-MSError)/an = (0.4167 - 1.5000)/(2*3) = -0.18055 < 0 -> operator variance = 0
- Estimate interaction σ2 = (MSAB-MSError)/n = (0.6019 - 1.5000)/3 = -0.299 < 0 -> interaction variance = 0
# designate fixed factors as fixed
library(GAD)
Operator <- as.fixed(dat136$operator)
Operator## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2
## [39] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## Levels: 1 2# designate random factors as random
Part <- as.random(dat136$part)
Part## [1] 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5
## [26] 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10
## [51] 1 2 3 4 5 6 7 8 9 10
## Levels: 1 2 3 4 5 6 7 8 9 10# Apply analysis of variance model
model <- lm(dat136$measurement ~ Operator+Part+Operator*Part)
gad(model)## Analysis of Variance Table
##
## Response: dat136$measurement
## Df Sum Sq Mean Sq F value Pr(>F)
## Operator 1 0.417 0.4167 0.6923 0.4269
## Part 9 99.017 11.0019 7.3346 3.216e-06 ***
## Operator:Part 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 ' ' 1Complete Code
Here we display the complete R code used in this analysis.
# Read in the data table for 5.4
dat54<-read.csv("https://raw.githubusercontent.com/forestwhite/RStatistics/main/54Table.csv")
dat54 <- subset (dat54, select = -c(X,X.1,X.2))
names(dat54) <- sub('ï..', '', names(dat54))
dat54
# designate fixed factors as fixed
library(GAD)
Feedrate <- as.fixed(dat54$feed.rate)
Feedrate
Depth <- as.fixed(dat54$depth)
Depth
# Apply analysis of variance model
model <- lm(dat54$finish ~ Feedrate+Depth+Feedrate*Depth)
gad(model)
# Produce an interaction plot
interaction.plot(x.factor = Feedrate,
trace.factor = Depth,
response = dat54$finish,
fun = mean,
type="b", ### Show plot points as symbols
col=c("steelblue","firebrick2", "forestgreen", "orange"), ### Colors for levels of trace var.
pch=c(19, 17, 15, 13), ### Symbols for levels of trace var.
fixed=TRUE, ### Order by factor order in data
leg.bty = "o") ### Legend box
# AOV normal Q-Q plots of the data
plot(model,2)
# AOV residuals vs fitted comparison the data
plot(model,1)
# Read in the data table for 5.34
dat534<-read.csv("https://raw.githubusercontent.com/forestwhite/RStatistics/main/534Table.csv")
dat534 <- subset (dat534, select = -c(X,X.1,X.2))
names(dat534) <- sub('ï..', '', names(dat534))
dat534$finish
# designate fixed factors as fixed
library(GAD)
Replicate <- as.fixed(dat534$replicate)
Replicate
Feedrate <- as.fixed(dat534$feed.rate)
Feedrate
Depth <- as.fixed(dat534$depth)
Depth
# Apply analysis of variance model
model <- lm(dat534$finish ~ Replicate+Feedrate+Depth+Feedrate*Depth)
gad(model)
# Produce an interaction plot
interaction.plot(x.factor = Feedrate,
trace.factor = Depth,
response = dat534$finish,
fun = mean,
type="b", ### Show plot points as symbols
col=c("steelblue","firebrick2", "forestgreen", "orange"), ### Colors for levels of trace var.
pch=c(19, 17, 15, 13), ### Symbols for levels of trace var.
fixed=TRUE, ### Order by factor order in data
leg.bty = "o") ### Legend box
# Read in the data table for 5.13
dat513<-read.csv("https://raw.githubusercontent.com/forestwhite/RStatistics/main/513Table.csv")
names(dat513) <- sub('ï..', '', names(dat513))
dat513
# designate fixed factors as fixed
library(GAD)
Temperature <- as.fixed(dat513$temperature)
Temperature
# designate random factors as random
Position <- as.random(dat513$position)
Position
# Apply analysis of variance model
model <- lm(dat513$density ~ Temperature+Position+Temperature*Position)
gad(model)
# Read in the data table for 13.6
dat136<-read.csv("https://raw.githubusercontent.com/forestwhite/RStatistics/main/136Table.csv")
dat136 <- subset (dat136, select = -c(X,X.1,X.2,X.3,X.4))
names(dat136) <- sub('ï..', '', names(dat136))
dat136
# designate fixed factors as fixed
library(GAD)
Operator <- as.fixed(dat136$operator)
Operator
# designate random factors as random
Part <- as.random(dat136$part)
Part
# Apply analysis of variance model
model <- lm(dat136$measurement ~ Operator+Part+Operator*Part)
gad(model)