Homework 5 - Module 6
Jairo Rodriguez (R11925123)
Last compiled on November 22, 2024 at 5:08 PM
1 Question 6.8
A bacteriologist is interested in the effects of two different culture media and two different times on the growth of a particular virus. He or she performs six replicates of a \(2^2\) design, making the runs in random order. Analyze the bacterial growth data that follow and draw appropriate conclusions. Analyze the residuals and comment on the model’s adequacy.
1.1 Solution - Question 6.8
Create the dataframe
# Create the dataframe
time <- c(rep(12,12), rep(18,12))
culture <- rep(c(rep(1,2), rep(2,2)), 6)
obs <- c(21, 22, 25, 26,
23, 28, 24, 25,
20, 26, 29, 27,
37, 39, 31, 34,
38, 38, 29, 33,
35, 36, 30, 35)
data <- data.frame(time,culture,obs)
data$time <- as.fixed(data$time)
data$culture <- as.fixed(data$culture)
rmarkdown::paged_table(data)Linear Effect equation:
\[ y_{i,j,k} = \mu + \alpha_i + \beta_j + (\alpha\beta)_{ij} + \epsilon_{i,j,k} \]
Where:
- \(\mu = \text{Grand Mean}\)
- \(\alpha_i = \text{Main Effect of Time}\)
- \(\beta_j = \text{Main Effect of Culture Medium}\)
- \((\alpha\beta)_{ij} = \text{Interaction Effect of Time and Culture Medium}\)
- \(\epsilon_{i,j,k} = \text{Random Error}\)
Hypothesis test for Main Effect A (Time):
- \(H_0: \alpha_i = 0\)
- \(H_a: \alpha_i \neq 0\)
Hypothesis test for Main Effect B (Culture Medium):
- \(H_0: \beta_j = 0\)
- \(H_a: \beta_j \neq 0\)
Hypothesis test for Interaction Effect AB (Time and Culture Medium):
- \(H_0: (\alpha\beta)_{ij} = 0\)
- \(H_a: (\alpha\beta)_{ij} \neq 0\)
Testing the model
# Testing the model
time <- data$time
culture <- data$culture
response <- data$obs
equation <- response ~ time + culture + time*culture
model <- aov(equation)
GAD::gad(model)## $anova
## Analysis of Variance Table
##
## Response: response
## Df Sum Sq Mean Sq F value Pr(>F)
## time 1 590.04 590.04 115.5057 9.291e-10 ***
## culture 1 9.38 9.38 1.8352 0.1906172
## time:culture 1 92.04 92.04 18.0179 0.0003969 ***
## Residuals 20 102.17 5.11
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Checking the model’s adequacy
# Plotting Residuals vs Fitted
plot(model, 1)
# Plotting QQ Normal
plot(model, 2)
CONCLUSIONS (Assuming a significance level of 0.05):
- From ANOVA Table: for Interaction Effect “AB” the p-value is 0.0003969, which means we reject the null hypothesis, and there is a significant effect for AB
- From the ANOVA plots, we observe that the residuals follow a linear trend (with some outliers) in the Q-Q plot, indicating that the assumption of normality is satisfied. However, the residuals vs fitted values plot shows that the residuals are not distributed with equal spread, suggesting that the assumption of constant variance is not met.
- We can consider that the model is not adequate because the variance assumption is not met.
2 Question 6.12
An article in the AT&T Technical Journal (March/April 1986, Vol. 65, pp. 39–50) describes the application of two-level factorial designs to integrated circuit manufacturing. A basic processing step is to grow an epitaxial layer on polished silicon wafers. The wafers mounted on a susceptor are positioned inside a bell jar, and chemical vapors are introduced. The susceptor is rotated, and heat is applied until the epitaxial layer is thick enough. An experiment was run using two factors: arsenic flow rate (A) and deposition time (B). Four replicates were run, and the epitaxial layer thickness was measured ( m). The data are shown in Table P6.1
(a) Estimate the factor effects.
(b) Conduct an analysis of variance. Which factors are
important?
(c) Write down a regression equation that could be used
to predict epitaxial layer thickness over the region of arsenic flow
rate and deposition time used in this experiment.
(d) Analyze the residuals. Are there any residuals that
should cause concern?
(e) Discuss how you might deal with the potential
outlier found in part (d).
2.1 Solution - Question 6.12
Creating the Dataframe:
# Creating the Dataframe:
A_0 <- c(-1,1,-1,1)
B_0 <- c(-1,-1,1,1)
A <- rep(A_0, rep(4,4))
B <- rep(B_0, rep(4,4))
obs <- c(14.037, 16.165, 13.972, 13.907,
13.880, 13.860, 14.032, 13.914,
14.821, 14.757, 14.843, 14.878,
14.888, 14.921, 14.415, 14.932)
data <- data.frame(A, B, obs)
data$A <- as.fixed(data$A)
data$B <- as.fixed(data$B)
rmarkdown::paged_table(data)2.1.1 Section (a)
(a) Estimate the factor effects.
A <- data$A
B <- data$B
response <- data$obs
equation <- response ~ A + B + A*B
model <- lm(equation)
coef(model)## (Intercept) A1 B1 A1:B1
## 14.52025 -0.59875 0.30450 0.56300CONCLUSIONS:
- The estimate effect A: -0.59875
- The estimate effect B: 0.30450
- The estimate effect AB: 0.56300
2.1.2 Section (b)
(b) Conduct an analysis of variance. Which factors are important?
Testing the model
A <- data$A
B <- data$B
response <- data$obs
equation <- response ~ A + B + A*B
model <- aov(equation)
GAD::gad(model)## $anova
## Analysis of Variance Table
##
## Response: response
## Df Sum Sq Mean Sq F value Pr(>F)
## A 1 0.4026 0.40259 1.2619 0.28327
## B 1 1.3736 1.37358 4.3054 0.06016 .
## A:B 1 0.3170 0.31697 0.9935 0.33856
## Residuals 12 3.8285 0.31904
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1CONCLUSIONS (Assuming a significance level of 0.05):
- From ANOVA Table: for Interaction Effect “AB” the p-value is 0.33856 is greater than significance level (0.05), which means we fail to reject the null hypothesis, and there is a not significant effect for AB
- Since the P-Value (0.28327) of Main Effect “A” is greater than significance level (0.05), We fail to reject the null hypothesis. This indicates that there is not a significant effect for A
- Since the P-Value (0.06016) of Main Effect “B” is greater than significance level (0.05), We fail to reject the null hypothesis. This indicates that there is not a significant effect for B
2.1.3 Section (c)
(c) Write down a regression equation that could be used to predict epitaxial layer thickness over the region of arsenic flow rate and deposition time used in this experiment.
equation <- response ~ A + B + A*B
model <- lm(equation)
coef(model)## (Intercept) A1 B1 A1:B1
## 14.52025 -0.59875 0.30450 0.56300Linear Effect equation:
\[ y_{i,j,k} = \mu + \alpha_i + \beta_j + (\alpha\beta)_{ij} + \epsilon_{i,j,k} \]
Using the coefficients:
\[ y_{i,j,k} = 14.52025 + -0.59875\alpha_i + 0.30450\beta_j + 0.56300(\alpha\beta)_{ij} + \epsilon_{i,j,k} \]
2.1.4 Section (d)
(d) Analyze the residuals. Are there any residuals that should cause concern?
plot(model)
CONCLUSIONS:
- From the ANOVA plots, we observe that the residuals not follow a linear trend in the Q-Q plot, indicating that the assumption of normality is not satisfied. Additionally, the residuals vs fitted values plot shows that the residuals are not distributed with equal spread, suggesting that the assumption of constant variance is not met.
- We can consider that the model is not adequate because the assumptions are not met.
2.1.5 Section (e)
(e) Discuss how you might deal with the potential outlier found in part (d).
We can apply a Box-Cox transformation to the data to identify the optimal lambda value, followed by conducting ANOVA on the transformed data. Alternatively, we can use a non-parametric test, which does not assume a normal distribution.
3 Question 6.21
I am always interested in improving my golf scores. Since a typical golfer uses the putter for about 35–45 percent of his or her strokes, it seems reasonable that improving one’s putting is a logical and perhaps simple way to improve a golf score (“The man who can putt is a match for any man.”— Willie Parks, 1864–1925, two time winner of the British Open). An experiment was conducted to study the effects of four factors on putting accuracy. The design factors are length of putt, type of putter, breaking putt versus straight putt, and level versus downhill putt. The response variable is distance from the ball to the center of the cup after the ball comes to rest. One golfer performs the experiment, a 24 factorial design with seven replicates was used, and all putts are made in random order. The results are shown in Table P6.4
(a) Analyze the data from this experiment. Which
factors significantly affect putting performance?
(b) Analyze the residuals from this experiment. Are
there any indications of model inadequacy?
3.1 Solution - Question 6.21
Creating the Dataframe:
# Creating the Dataframe:
factorA <- c(10, 30)
factorB <- c("Mallet", "Cavity back")
factorC <- c("Straight", "Breaking")
factorD <- c("Level", "Downhill")
obs <- c(10,18,14,12.5,19,16,18.5,
0,16.5,4.5,17.5,20.5,17.5,33,
4,6,1,14.5,12,14,5,
0,10,34,11,25.5,21.5,0,
0,0,18.5,19.5,16,15,11,
5,20.5,18,20,29.5,19,10,
6.5,18.5,7.5,6,0,10,0,
16.5,4.5,0,23.5,8,8,8,
4.5,18,14.5,10,0,17.5,6,
19.5,18,16,5.5,10,7,36,
15,16,8.5,0,0.5,9,3,
41.5,39,6.5,3.5,7,8.5,36,
8,4.5,6.5,10,13,41,14,
21.5,10.5,6.5,0,15.5,24,16,
0,0,0,4.5,1,4,6.5,
18,5,7,10,32.5,18.5,8)
length_putt <- rep(rep(factorA, each = 7), 8)
type_putt <- rep(rep(factorB, each = 7*2), 4)
break_putt <- rep(rep(factorC, each = 7*4), 2)
slope_putt <- rep(factorD, each = 7*8)
data <- data.frame(length_putt,type_putt,break_putt,slope_putt,obs)
data$length_putt <- as.fixed(data$length_putt)
data$type_putt <- as.fixed(data$type_putt)
data$break_putt <- as.fixed(data$break_putt)
data$slope_putt <- as.fixed(data$slope_putt)
rmarkdown::paged_table(data)3.1.1 Section (a)
(a) Analyze the data from this experiment. Which factors significantly affect putting performance?
Testing the model
# Testing the model
length_putt <- data$length_putt
type_putt <- data$type_putt
break_putt <- data$break_putt
slope_putt <- data$slope_putt
response <- data$obs
equation <- response ~ length_putt + type_putt + break_putt + slope_putt +
length_putt*type_putt + length_putt*break_putt + length_putt*slope_putt +
type_putt*break_putt + type_putt*slope_putt + break_putt*slope_putt +
length_putt*type_putt*break_putt + length_putt*type_putt*slope_putt +
length_putt*break_putt*slope_putt + type_putt*break_putt*slope_putt +
length_putt*type_putt*break_putt*slope_putt
model <- aov(equation)
GAD::gad(model)## $anova
## Analysis of Variance Table
##
## Response: response
## Df Sum Sq Mean Sq F value Pr(>F)
## length_putt 1 917.1 917.15 10.5878 0.001572
## type_putt 1 388.1 388.15 4.4809 0.036862
## break_putt 1 145.1 145.15 1.6756 0.198615
## slope_putt 1 1.4 1.40 0.0161 0.899280
## length_putt:type_putt 1 218.7 218.68 2.5245 0.115377
## length_putt:break_putt 1 11.9 11.90 0.1373 0.711776
## length_putt:slope_putt 1 93.8 93.81 1.0829 0.300658
## type_putt:break_putt 1 115.0 115.02 1.3278 0.252054
## type_putt:slope_putt 1 56.4 56.43 0.6515 0.421588
## break_putt:slope_putt 1 1.6 1.63 0.0188 0.891271
## length_putt:type_putt:break_putt 1 7.3 7.25 0.0837 0.772939
## length_putt:type_putt:slope_putt 1 113.0 113.00 1.3045 0.256228
## length_putt:break_putt:slope_putt 1 39.5 39.48 0.4558 0.501207
## type_putt:break_putt:slope_putt 1 33.8 33.77 0.3899 0.533858
## length_putt:type_putt:break_putt:slope_putt 1 95.6 95.65 1.1042 0.295994
## Residuals 96 8315.8 86.62
##
## length_putt **
## type_putt *
## break_putt
## slope_putt
## length_putt:type_putt
## length_putt:break_putt
## length_putt:slope_putt
## type_putt:break_putt
## type_putt:slope_putt
## break_putt:slope_putt
## length_putt:type_putt:break_putt
## length_putt:type_putt:slope_putt
## length_putt:break_putt:slope_putt
## type_putt:break_putt:slope_putt
## length_putt:type_putt:break_putt:slope_putt
## Residuals
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1CONCLUSIONS (Assuming a significance level of 0.05):
- From ANOVA Table: The only factors with a significant effect are the “length_putt” (p-value: 0.001572) and “type_putt” (p-value: 0.036862), Due to both p-values are less than 0.05.
3.1.2 Section (b)
(b) Analyze the residuals from this experiment. Are there any indications of model inadequacy?
Checking the model’s adequacy
# Plotting Residuals vs Fitted
plot(model, 1)
# Plotting QQ Normal
plot(model, 2)
CONCLUSIONS:
- From the ANOVA plots, we observe that the residuals follow a linear trend (with some outliers) in the Q-Q plot, indicating that the assumption of normality is satisfied. However, the residuals vs fitted values plot shows that the residuals are not distributed with equal spread, suggesting that the assumption of constant variance is not met.
- We can consider that the model is not adequate because the variance assumption is not met.
4 Question 6.36
Resistivity on a silicon wafer is influenced by several factors. The results of a 24 factorial experiment performed during a critical processing step is shown in Table P6.10
(a) Estimate the factor effects. Plot the effect
estimates on a normal probability plot and select a tentative
model.
(b) Fit the model identified in part (a) and analyze
the residuals. Is there any indication of model inadequacy?
(c) Repeat the analysis from parts (a) and (b) using ln
(y) as the response variable. Is there an indication that the
transformation has been useful?
(d) Fit a model in terms of the coded variables that
can be used to predict the resistivity.
4.1 Solution - Question 6.36
Creating the Dataframe:
# Creating the Dataframe:
A<-rep(c(-1,1), 8)
B<-rep(rep(c(-1,1), each = 2),4)
C<-rep(rep(c(-1,1), each = 4),2)
D<-rep(c(-1,1), each = 8)
obs <- c(1.92,11.28,1.09,5.75,2.13,9.53,1.03,5.35,1.60,11.73,1.16,4.68,2.16,9.11,1.07,5.30)
data <- data.frame(A,B,C,D, obs)
rmarkdown::paged_table(data)4.1.1 Section (a)
(a) Estimate the factor effects. Plot the effect estimates on a normal probability plot and select a tentative model
Testing the model
# Testing the model
equation <- obs ~ A + B + C + D +
A*B + A*C + A*D + B*C + B*D + C*D +
A*B*C + A*B*D + A*C*D + B*C*D +
A*B*C*D
model <- lm(equation, data = data)
# Estimate the factor effects
coef(model)## (Intercept) A B C D A:B
## 4.680625 3.160625 -1.501875 -0.220625 -0.079375 -1.069375
## A:C A:D B:C B:D C:D A:B:C
## -0.298125 -0.056875 0.229375 -0.046875 0.029375 0.344375
## A:B:D A:C:D B:C:D A:B:C:D
## -0.096875 -0.010625 0.094375 0.141875- The estimate effect A: 3.160625
- The estimate effect B: -1.501875
- The estimate effect C: -0.220625
- The estimate effect D: -0.079375
- The estimate effect AB: -1.069375
- The estimate effect AC: -0.298125
- The estimate effect AD: -0.056875
- The estimate effect BC: 0.229375
- The estimate effect BD: -0.046875
- The estimate effect CD: 0.029375
- The estimate effect ABC: 0.344375
- The estimate effect ABD: -0.096875
- The estimate effect ACD: -0.010625
- The estimate effect BCD: 0.094375
- The estimate effect ABCD: 0.141875
Now applying the Half Normal Plot:
halfnormal(model)
From the “Half Normal Plot”, We can find the factor e interactions with significant effects: - A - B - AB - ABC
Now the tentative model is:
\[ y = 4.680625 + 3.160625(A) - 1.501875(B) - 1.069375(AB) + 0.344375(ABC) + \epsilon \]
4.1.2 Section (b)
(b) Fit the model identified in part (a) and analyze the residuals. Is there any indication of model inadequacy?
Testing the model
# Testing the model
data$A <- as.fixed(data$A)
data$B <- as.fixed(data$B)
data$C <- as.fixed(data$C)
data$D <- as.fixed(data$D)
equation <- obs ~ A + B + A*B + A*B*C
model <- aov(equation,data=data)
GAD::gad(model)## $anova
## Analysis of Variance Table
##
## Response: obs
## Df Sum Sq Mean Sq F value Pr(>F)
## A 1 159.833 159.833 1563.0615 1.842e-10 ***
## B 1 36.090 36.090 352.9374 6.659e-08 ***
## C 1 0.779 0.779 7.6162 0.024684 *
## A:B 1 18.297 18.297 178.9329 9.334e-07 ***
## A:C 1 1.422 1.422 13.9068 0.005795 **
## B:C 1 0.842 0.842 8.2323 0.020854 *
## A:B:C 1 1.898 1.898 18.5564 0.002589 **
## Residuals 8 0.818 0.102
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Checking the model’s adequacy
# Plotting Residuals vs Fitted
plot(model, 1)
# Plotting QQ Normal
plot(model, 2)
CONCLUSIONS:
- From the ANOVA plots, we observe that the residuals not follow a linear trend (with some outliers) in the Q-Q plot, indicating that the assumption of normality is not satisfied. However, the residuals vs fitted values plot shows that the residuals are not distributed with equal spread, suggesting that the assumption of constant variance is not met.
- We can consider that the model is not adequate because the assumptions are not met.
4.1.3 Section (c)
(c) Repeat the analysis from parts (a) and (b) using ln (y) as the response variable. Is there an indication that the transformation has been useful?
A<-rep(c(-1,1), 8)
B<-rep(rep(c(-1,1), each = 2),4)
C<-rep(rep(c(-1,1), each = 4),2)
D<-rep(c(-1,1), each = 8)
obs <- c(1.92,11.28,1.09,5.75,2.13,9.53,1.03,5.35,1.60,11.73,1.16,4.68,2.16,9.11,1.07,5.30)
log_obs <- log(obs)
data2 <- data.frame(A,B,C,D, log_obs)
equation2 <- log_obs ~ A + B + C + D +
A*B + A*C + A*D + B*C + B*D + C*D +
A*B*C + A*B*D + A*C*D + B*C*D +
A*B*C*D
model2 <- lm(equation2, data = data2)
# Estimate the factor effects
coef(model2)## (Intercept) A B C D A:B
## 1.185417116 0.812870345 -0.314277554 -0.006408558 -0.018077390 -0.024684570
## A:C A:D B:C B:D C:D A:B:C
## -0.039723700 -0.009578245 -0.004225796 0.003708723 0.017780432 0.063434408
## A:B:D A:C:D B:C:D A:B:C:D
## -0.029875960 -0.003740235 0.003765760 0.031322043# Half normal plot
halfnormal(model2)
From the “Half Normal Plot”, We can find the factor e interactions with significant effects: - A - B - ABC
Testing the model
equation2 <- log_obs ~ A + B + A*B*C
model2 <- aov(equation2,data=data2)
summary(model2)## Df Sum Sq Mean Sq F value Pr(>F)
## A 1 10.572 10.572 1994.556 6.98e-11 ***
## B 1 1.580 1.580 298.147 1.29e-07 ***
## C 1 0.001 0.001 0.124 0.73386
## A:B 1 0.010 0.010 1.839 0.21207
## A:C 1 0.025 0.025 4.763 0.06063 .
## B:C 1 0.000 0.000 0.054 0.82223
## A:B:C 1 0.064 0.064 12.147 0.00826 **
## Residuals 8 0.042 0.005
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Checking the model’s adequacy
# Plotting Residuals vs Fitted
plot(model2, 1)
# Plotting QQ Normal
plot(model2, 2)
CONCLUSIONS:
- After the transformation, the ANOVA plots show an improvement in the residuals vs. fitted values plot. However, the residuals still exhibit unequal spread, indicating that the assumption of constant variance has not yet been met.
4.1.4 Section (d)
(d) Fit a model in terms of the coded variables that can be used to predict the resistivity.
# Testing the model
equation2 <- log_obs ~ A + B + A*B + A*B*C
model2 <- lm(equation2,data=data2)
summary(model2)##
## Call:
## lm.default(formula = equation2, data = data2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.1030 -0.0203 0.0000 0.0203 0.1030
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.185417 0.018201 65.129 3.44e-12 ***
## A 0.812870 0.018201 44.660 6.98e-11 ***
## B -0.314278 0.018201 -17.267 1.29e-07 ***
## C -0.006409 0.018201 -0.352 0.73386
## A:B -0.024685 0.018201 -1.356 0.21207
## A:C -0.039724 0.018201 -2.182 0.06063 .
## B:C -0.004226 0.018201 -0.232 0.82223
## A:B:C 0.063434 0.018201 3.485 0.00826 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.0728 on 8 degrees of freedom
## Multiple R-squared: 0.9966, Adjusted R-squared: 0.9935
## F-statistic: 330.2 on 7 and 8 DF, p-value: 3.296e-09Now the tentative model is:
\[ y = 1.185417 + 0.812870(A) - 0.314278(B) - 0.024685(AB) + 0.063434(ABC) + \epsilon \]
5 Question 6.39
An article in Quality and Reliability Engineering International (2010, Vol. 26, pp. 223–233) presents a 25 factorial design. The experiment is shown in Table P6.12
(a) Analyze the data from this experiment. Identify
the significant factors and interactions.
(b) Analyze the residuals from this experiment. Are
there any indications of model inadequacy or violations of the
assumptions?
(c) One of the factors from this experiment does not
seem to be important. If you drop this factor, what type of design
remains? Analyze the data using the full factorial model for only the
four active factors. Compare your results with those obtained in part
(a).
(d) Find settings of the active factors that maximize
the predicted response
5.1 Solution - Question 6.39
Creating the Dataframe:
# Creating the Dataframe:
A<-rep(c(-1,1), 16)
B<-rep(rep(c(-1,1), each = 2),8)
C<-rep(rep(c(-1,1), each = 4),4)
D<-rep(rep(c(-1,1), each = 8),2)
E<-rep(c(-1,1), each = 16)
obs <- c(8.11,5.56,5.77,5.82,9.17,7.8,3.23,5.69,8.82,14.23,9.2,8.94,8.68,11.49,6.25,9.12,7.93,5,7.47,12,9.86,3.65,6.4,11.61,12.43,17.55,8.87,25.38,13.06,18.85,11.78,26.05)
data <- data.frame(A,B,C,D,E, obs)
rmarkdown::paged_table(data)5.1.1 Section (a)
**(a) Analyze the data from this experiment. Identify the significant factors and interactions.**
Testing the model
# Testing the model
equation <- obs ~ A + B + C + D + E +
A*B + A*C + A*D + A*E + B*C + B*D + B*E + C*D + C*E + D*E +
A*B*C + A*B*D + A*B*E + A*C*D + A*C*E + A*D*E +
B*C*D + B*C*E + B*D*E + C*D*E +
A*B*C*D + A*B*C*E + A*B*D*E + A*C*D*E + B*C*D*E +
A*B*C*D*E
model <- lm(equation, data = data)
# Estimate the factor effects
coef(model)## (Intercept) A B C D E
## 10.1803125 1.6159375 0.0434375 -0.0121875 2.9884375 2.1878125
## A:B A:C A:D A:E B:C B:D
## 1.2365625 -0.0015625 1.6665625 1.0271875 -0.1953125 -0.0134375
## B:E C:D C:E D:E A:B:C A:B:D
## 1.2834375 0.0034375 0.3015625 1.3896875 0.2503125 -0.3453125
## A:B:E A:C:D A:C:E A:D:E B:C:D B:C:E
## 1.1853125 -0.0634375 -0.2590625 0.9015625 0.3053125 0.1709375
## B:D:E C:D:E A:B:C:D A:B:C:E A:B:D:E A:C:D:E
## -0.0396875 0.3959375 -0.0740625 -0.1846875 0.4071875 0.1278125
## B:C:D:E A:B:C:D:E
## -0.0746875 -0.3553125Now applying the Half Normal Plot:
halfnormal(model)
Using the significant effects: D, E, AD, A, DE, BE, AB, ABE, AE, ADE
equation2 <- obs ~ A + D + E + A*D + D*E + B*E + A*B + A*E + A*B*E + A*D*E
model2 <- aov(equation2, data = data)
summary(model2)## Df Sum Sq Mean Sq F value Pr(>F)
## A 1 83.56 83.56 51.362 6.10e-07 ***
## D 1 285.78 285.78 175.664 2.30e-11 ***
## E 1 153.17 153.17 94.149 5.24e-09 ***
## B 1 0.06 0.06 0.037 0.849178
## A:D 1 88.88 88.88 54.631 3.87e-07 ***
## D:E 1 61.80 61.80 37.986 5.07e-06 ***
## E:B 1 52.71 52.71 32.400 1.43e-05 ***
## A:B 1 48.93 48.93 30.076 2.28e-05 ***
## A:E 1 33.76 33.76 20.754 0.000192 ***
## A:E:B 1 44.96 44.96 27.635 3.82e-05 ***
## A:D:E 1 26.01 26.01 15.988 0.000706 ***
## Residuals 20 32.54 1.63
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1CONCLUSIONS:
- From the Half Normal Plot, the following main and interaction effects are identified as significant: D, E, AD, A, DE, BE, AB, ABE, AE, and ADE.
- From the ANOVA table, and considering the significant effects identified in the Half Normal Plot, the following are also significant: D, E, AD, A, DE, BE, AB, ABE, AE, and ADE.
5.1.2 Section (b)
(b) Analyze the residuals from this experiment. Are there any indications of model inadequacy or violations of the assumptions?
equation2 <- obs ~ A + D + E + A*D + D*E + B*E + A*B + A*E + A*B*E + A*D*E
model2 <- aov(equation2, data = data)
# Plotting Residuals vs Fitted
plot(model2, 1)
# Plotting QQ Normal
plot(model2, 2)
CONCLUSIONS:
- From the ANOVA plots, we observe that the residuals follow a linear trend in the Q-Q plot, indicating that the assumption of normality is satisfied. Additionally, the residuals vs fitted values plot shows that the residuals are not distributed with equal spread, suggesting that the assumption of constant variance is not met.
- We can consider that the model is not adequate because the variance assumption is not met.
5.1.3 Section (c)
(c) One of the factors from this experiment does not seem to be important. If you drop this factor, what type of design remains? Analyze the data using the full factorial model for only the four active factors. Compare your results with those obtained in part (a).
Creating the Dataframe:
A<-rep(c(-1,1), 16)
B<-rep(rep(c(-1,1), each = 2),8)
D<-rep(rep(c(-1,1), each = 8),2)
E<-rep(c(-1,1), each = 16)
obs <- c(8.11,5.56,5.77,5.82,9.17,7.8,3.23,5.69,8.82,14.23,9.2,8.94,8.68,11.49,6.25,9.12,7.93,5,7.47,12,9.86,3.65,6.4,11.61,12.43,17.55,8.87,25.38,13.06,18.85,11.78,26.05)
data2 <- data.frame(A,B,D,E, obs)
rmarkdown::paged_table(data2)Testing the model
# Testing the model
equation <- obs ~ A + B + D + E +
A*B + A*D + A*E + B*D + B*E + D*E +
A*B*D + A*B*E + A*D*E + B*D*E +
A*B*D*E
model3 <- lm(equation, data = data2)
# Half Normal plot
halfnormal(model3)
Using the significant effects: D, E, AD, A, DE, BE, AB, ABE, AE, ADE
equation2 <- obs ~ A + D + E + A*D + D*E + B*E + A*B + A*E + A*B*E + A*D*E
model4 <- aov(equation2, data = data2)
# Plotting Residuals vs Fitted
plot(model4, 1)
# Plotting QQ Normal
plot(model4, 2)
CONCLUSIONS:
- From the Half Normal Plot, the following main and interaction effects are identified as significant: D, E, AD, A, DE, BE, AB, ABE, AE, and ADE. These significant effects align with those obtained in part (a), although factor C is excluded in this analysis.
- From the ANOVA plots, we observe that the residuals follow a linear trend in the Q-Q plot, indicating that the assumption of normality is satisfied. However, the residuals vs. fitted values plot shows that the residuals do not display a constant spread, suggesting that the assumption of constant variance is not met. This behavior is also consistent with part (a), despite the exclusion of factor C in this analysis.
- We can conclude that the model remains inadequate due to the violation of the constant variance assumption.
5.1.4 Section (d)
(d) Find settings of the active factors that maximize the predicted response
equation2 <- obs ~ A + D + E + A*D + D*E + B*E + A*B + A*E + A*B*E + A*D*E
model2 <- aov(equation2, data = data)
summary(model2)## Df Sum Sq Mean Sq F value Pr(>F)
## A 1 83.56 83.56 51.362 6.10e-07 ***
## D 1 285.78 285.78 175.664 2.30e-11 ***
## E 1 153.17 153.17 94.149 5.24e-09 ***
## B 1 0.06 0.06 0.037 0.849178
## A:D 1 88.88 88.88 54.631 3.87e-07 ***
## D:E 1 61.80 61.80 37.986 5.07e-06 ***
## E:B 1 52.71 52.71 32.400 1.43e-05 ***
## A:B 1 48.93 48.93 30.076 2.28e-05 ***
## A:E 1 33.76 33.76 20.754 0.000192 ***
## A:E:B 1 44.96 44.96 27.635 3.82e-05 ***
## A:D:E 1 26.01 26.01 15.988 0.000706 ***
## Residuals 20 32.54 1.63
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1coef(model2)## (Intercept) A D E B A:D
## 10.1803125 1.6159375 2.9884375 2.1878125 0.0434375 1.6665625
## D:E E:B A:B A:E A:E:B A:D:E
## 1.3896875 1.2834375 1.2365625 1.0271875 1.1853125 0.9015625To maximize the predicted response, we focus on the positive coefficients.
Now the tentative model is:
\[ y = 10.1803125 + 1.6159375(A) + 2.9884375(D) + 2.1878125(E) + 0.0434375(B) + \\ 1.6665625(AD) + 1.3896875(DE) + 1.2834375(EB) + 1.2365625(AB) + 1.0271875(AE) + \\ 1.1853125(AEB) + 0.9015625(ADE) + \epsilon \]
6 Question 7.12
Consider the potting experiment in Problem 6.21. Analyze the data considering each replicate as a block
## Solution - Question 7.12
Creating the Dataframe:
# Creating the Dataframe:
factorA <- c(10, 30)
factorB <- c("Mallet", "Cavity back")
factorC <- c("Straight", "Breaking")
factorD <- c("Level", "Downhill")
obs <- c(10,18,14,12.5,19,16,18.5,
0,16.5,4.5,17.5,20.5,17.5,33,
4,6,1,14.5,12,14,5,
0,10,34,11,25.5,21.5,0,
0,0,18.5,19.5,16,15,11,
5,20.5,18,20,29.5,19,10,
6.5,18.5,7.5,6,0,10,0,
16.5,4.5,0,23.5,8,8,8,
4.5,18,14.5,10,0,17.5,6,
19.5,18,16,5.5,10,7,36,
15,16,8.5,0,0.5,9,3,
41.5,39,6.5,3.5,7,8.5,36,
8,4.5,6.5,10,13,41,14,
21.5,10.5,6.5,0,15.5,24,16,
0,0,0,4.5,1,4,6.5,
18,5,7,10,32.5,18.5,8)
length_putt <- rep(rep(factorA, each = 7), 8)
type_putt <- rep(rep(factorB, each = 7*2), 4)
break_putt <- rep(rep(factorC, each = 7*4), 2)
slope_putt <- rep(factorD, each = 7*8)
data0 <- data.frame(length_putt,type_putt,break_putt,slope_putt,obs)
data0$length_putt <- as.fixed(data0$length_putt)
data0$type_putt <- as.fixed(data0$type_putt)
data0$break_putt <- as.fixed(data0$break_putt)
data0$slope_putt <- as.fixed(data0$slope_putt)
rmarkdown::paged_table(data0)factorA <- c(-1, 1)
factorB <- c(-1, 1)
factorC <- c(-1, 1)
factorD <- c(-1, 1)
obs <- c(10,18,14,12.5,19,16,18.5,
0,16.5,4.5,17.5,20.5,17.5,33,
4,6,1,14.5,12,14,5,
0,10,34,11,25.5,21.5,0,
0,0,18.5,19.5,16,15,11,
5,20.5,18,20,29.5,19,10,
6.5,18.5,7.5,6,0,10,0,
16.5,4.5,0,23.5,8,8,8,
4.5,18,14.5,10,0,17.5,6,
19.5,18,16,5.5,10,7,36,
15,16,8.5,0,0.5,9,3,
41.5,39,6.5,3.5,7,8.5,36,
8,4.5,6.5,10,13,41,14,
21.5,10.5,6.5,0,15.5,24,16,
0,0,0,4.5,1,4,6.5,
18,5,7,10,32.5,18.5,8)
length_putt <- rep(rep(factorA, each = 7), 8)
type_putt <- rep(rep(factorB, each = 7*2), 4)
break_putt <- rep(rep(factorC, each = 7*4), 2)
slope_putt <- rep(factorD, each = 7*8)
block <- rep(rep(seq(1,7)),16)
data <- data.frame(length_putt,type_putt,break_putt,slope_putt,block, obs)
data$length_putt <- as.fixed(data$length_putt)
data$type_putt <- as.fixed(data$type_putt)
data$break_putt <- as.fixed(data$break_putt)
data$slope_putt <- as.fixed(data$slope_putt)
data$block <- as.fixed(data$block)
rmarkdown::paged_table(data)model <- lm(obs ~ length_putt + type_putt + break_putt + slope_putt + block +
length_putt*type_putt + length_putt*break_putt + type_putt*break_putt +
length_putt*slope_putt + type_putt*slope_putt + break_putt*slope_putt +
length_putt*type_putt*break_putt + length_putt*type_putt*slope_putt + length_putt*break_putt*slope_putt + type_putt*break_putt*slope_putt +
length_putt*type_putt*break_putt*slope_putt,
data = data)
GAD::gad(model)## $anova
## Analysis of Variance Table
##
## Response: obs
## Df Sum Sq Mean Sq F value Pr(>F)
## length_putt 1 917.1 917.15 10.3962 0.00176
## type_putt 1 388.1 388.15 4.3998 0.03875
## break_putt 1 145.1 145.15 1.6453 0.20290
## slope_putt 1 1.4 1.40 0.0158 0.90021
## block 6 376.1 62.68 0.7105 0.64202
## length_putt:type_putt 1 218.7 218.68 2.4788 0.11890
## length_putt:break_putt 1 11.9 11.90 0.1348 0.71433
## type_putt:break_putt 1 115.0 115.02 1.3038 0.25655
## length_putt:slope_putt 1 93.8 93.81 1.0633 0.30522
## type_putt:slope_putt 1 56.4 56.43 0.6397 0.42594
## break_putt:slope_putt 1 1.6 1.63 0.0184 0.89227
## length_putt:type_putt:break_putt 1 7.3 7.25 0.0822 0.77499
## length_putt:type_putt:slope_putt 1 113.0 113.00 1.2809 0.26073
## length_putt:break_putt:slope_putt 1 39.5 39.48 0.4476 0.50520
## type_putt:break_putt:slope_putt 1 33.8 33.77 0.3828 0.53767
## length_putt:type_putt:break_putt:slope_putt 1 95.6 95.65 1.0842 0.30055
## Residuals 90 7939.7 88.22
##
## length_putt **
## type_putt *
## break_putt
## slope_putt
## block
## length_putt:type_putt
## length_putt:break_putt
## type_putt:break_putt
## length_putt:slope_putt
## type_putt:slope_putt
## break_putt:slope_putt
## length_putt:type_putt:break_putt
## length_putt:type_putt:slope_putt
## length_putt:break_putt:slope_putt
## type_putt:break_putt:slope_putt
## length_putt:type_putt:break_putt:slope_putt
## Residuals
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1CONCLUSIONS:
- At a significance level of 0.05, the main effects of ‘length_putt’ and ‘type_putt’ are significant, with p-values below 0.05.
- Comparing the blocked and unblocked designs, the p-values of the main effects and interactions remain consistent. Additionally, blocking has no impact on the interactions, as the interaction plots are similar between the two designs..
7 Question 7.20
Design an experiment for confounding a \(2^6\) factorial in four blocks. Suggest an appropriate confounding scheme, different from the one shown in Table 7.8.
7.1 Solution - Question 7.20
Interactions Confounded with Blocks: ABCF, CDEF, ABDE
Considering: - Block 1: ABCF = +1, CDEF = +1, ABDE = +1 - Block 2: ABCF = +1, CDEF = -1, ABDE = -1 - Block 3: ABCF = -1, CDEF = +1, ABDE = -1 - Block 4: ABCF = -1, CDEF = -1, ABDE = +1
Block1 <- c('(1)', 'a', 'b', 'ab', 'c', 'ac', 'bc', 'abc', 'f', 'af', 'bf', 'abf', 'cf', 'acf', 'bcf', 'abcf')
Block2 <- c('d', 'ad', 'bd', 'abd', 'cd', 'acd', 'bcd', 'abcd', 'df', 'adf', 'bdf', 'abdf', 'cdf', 'acdf', 'bcdf', 'abcdf')
Block3 <- c('e', 'ae', 'be', 'abe', 'ce', 'ace', 'bce', 'abce', 'ef', 'aef', 'bef', 'abef', 'cef', 'acef', 'bcef', 'abcef')
Block4 <- c('de', 'ade', 'bde', 'abde', 'cde', 'acde', 'bcde', 'abcde', 'def', 'adef', 'bdef', 'abdef', 'cdef', 'acdef', 'bcdef', 'abcdef')
confound <- cbind(Block1, Block2, Block3, Block4)
confound## Block1 Block2 Block3 Block4
## [1,] "(1)" "d" "e" "de"
## [2,] "a" "ad" "ae" "ade"
## [3,] "b" "bd" "be" "bde"
## [4,] "ab" "abd" "abe" "abde"
## [5,] "c" "cd" "ce" "cde"
## [6,] "ac" "acd" "ace" "acde"
## [7,] "bc" "bcd" "bce" "bcde"
## [8,] "abc" "abcd" "abce" "abcde"
## [9,] "f" "df" "ef" "def"
## [10,] "af" "adf" "aef" "adef"
## [11,] "bf" "bdf" "bef" "bdef"
## [12,] "abf" "abdf" "abef" "abdef"
## [13,] "cf" "cdf" "cef" "cdef"
## [14,] "acf" "acdf" "acef" "acdef"
## [15,] "bcf" "bcdf" "bcef" "bcdef"
## [16,] "abcf" "abcdf" "abcef" "abcdef"8 Question 7.21
Consider the \(2^6\) design in eight blocks of eight runs each with ABCD, ACE, and ABEF as the independent effects chosen to be confounded with blocks. Generate the design. Find the other effects confounded with blocks.
8.1 Solution - Question 7.21
Creating the Dataframe:
# Define blocks based on confounded effects ABCD, ACE, and ABEF
block1 <- c('(1)', 'a', 'bc', 'abc', 'de', 'ade', 'bde', 'abde')
block2 <- c('b', 'acd', 'ce', 'abde', 'abcf', 'df', 'aef', 'bcdef')
block3 <- c('ac', 'be', 'cf', 'abcde', 'abcdef', 'd', 'a', 'f')
block4 <- c('c', 'ae', 'ef', 'b', 'ab', 'bcf', 'de', 'abde')
block5 <- c('d', 'ab', 'bcd', 'cdf', 'ade', 'f', 'aef', 'bc')
block6 <- c('e', 'bce', 'abcf', 'a', 'abc', 'df', 'cdef', 'abcdef')
block7 <- c('ad', 'be', 'ce', 'af', 'abc', 'bcde', 'bdf', 'ef')
block8 <- c('abcd', 'abef', 'abcdef', 'bce', 'f', 'cdf', 'd', 'ace')
# Combine blocks
confound <- cbind(block1,block2,block3,block4,block5,block6,block7,block8)
confound## block1 block2 block3 block4 block5 block6 block7 block8
## [1,] "(1)" "b" "ac" "c" "d" "e" "ad" "abcd"
## [2,] "a" "acd" "be" "ae" "ab" "bce" "be" "abef"
## [3,] "bc" "ce" "cf" "ef" "bcd" "abcf" "ce" "abcdef"
## [4,] "abc" "abde" "abcde" "b" "cdf" "a" "af" "bce"
## [5,] "de" "abcf" "abcdef" "ab" "ade" "abc" "abc" "f"
## [6,] "ade" "df" "d" "bcf" "f" "df" "bcde" "cdf"
## [7,] "bde" "aef" "a" "de" "aef" "cdef" "bdf" "d"
## [8,] "abde" "bcdef" "f" "abde" "bc" "abcdef" "ef" "ace"Interaction Confounded with blocks: ABEF, ABCD, ACE, BCF, BDE, CDEF, ADF
9 Question 8.2
Suppose that in Problem 6.15, only a one-half fraction of the \(2^4\) design could be run. Construct the design and perform the analysis, using the data from replicate I.
Information from problem 6.15: A nickel–titanium alloy is used to make components for jet turbine aircraft engines. Cracking is a potentially serious problem in the final part because it can lead to nonrecoverable failure. A test is run at the parts producer to determine the effect of four factors on cracks. The four factors are pouring temperature (A), titanium content (B), heat treatment method (C), and amount of grain refiner used (D). Two replicates of a 2^4 design are run, and the length of crack (in mm x 10^-2) induced in a sample coupon subjected to a standard test is measured. The data are shown in Table P6.2
## Solution - Question 8.2
# Set-up a resolution IV design with 4 factors
des.res4<- FrF2(nfactors=4,resolution=4,randomize=FALSE)
# Aliased relationships
aliasprint(des.res4)## $legend
## [1] A=A B=B C=C D=D
##
## $main
## character(0)
##
## $fi2
## [1] AB=CD AC=BD AD=BC# Add Response
response <- c(7.037, 16.867, 13.876, 17.273, 11.846, 4.368, 9.36, 15.653)
des.resp <- add.response(des.res4,response)
summary(des.resp)## Call:
## FrF2(nfactors = 4, resolution = 4, randomize = FALSE)
##
## Experimental design of type FrF2
## 8 runs
##
## Factor settings (scale ends):
## A B C D
## 1 -1 -1 -1 -1
## 2 1 1 1 1
##
## Responses:
## [1] response
##
## Design generating information:
## $legend
## [1] A=A B=B C=C D=D
##
## $generators
## [1] D=ABC
##
##
## Alias structure:
## $fi2
## [1] AB=CD AC=BD AD=BC
##
##
## The design itself:
## A B C D response
## 1 -1 -1 -1 -1 7.037
## 2 1 -1 -1 1 16.867
## 3 -1 1 -1 1 13.876
## 4 1 1 -1 -1 17.273
## 5 -1 -1 1 1 11.846
## 6 1 -1 1 -1 4.368
## 7 -1 1 1 -1 9.360
## 8 1 1 1 1 15.653
## class=design, type= FrF2Half normal Plot
DanielPlot(des.resp,half = TRUE)
Main Effect Plot
MEPlot(des.resp, show.alias = TRUE)
CONCLUSIONS:
- Significant Effects: There are not significant main o interaction effects
- Two-Factor Interaction Aliasing: While main effects are not aliased, two-factor interactions are aliased with each other due to the Resolution IV design, though this does not impact the results since no significant effects were found.
10 Question 8.24
Construct a \(2^{5-1}\) design. Show how the design may be run in two blocks of eight observations each. Are any main effects or two-factor interactions confounded with blocks?
10.1 Solution - Question 8.24
# Set-up a resolution V design with 5 factors
des.res5<- FrF2(nfactors=5,resolution=5,randomize=FALSE)
# Aliased relationships
aliasprint(des.res5)## $legend
## [1] A=A B=B C=C D=D E=E
##
## [[2]]
## [1] no aliasing among main effects and 2fissummary(des.res5)## Call:
## FrF2(nfactors = 5, resolution = 5, randomize = FALSE)
##
## Experimental design of type FrF2
## 16 runs
##
## Factor settings (scale ends):
## A B C D E
## 1 -1 -1 -1 -1 -1
## 2 1 1 1 1 1
##
## Design generating information:
## $legend
## [1] A=A B=B C=C D=D E=E
##
## $generators
## [1] E=ABCD
##
##
## Alias structure:
## [[1]]
## [1] no aliasing among main effects and 2fis
##
##
## The design itself:
## A B C D E
## 1 -1 -1 -1 -1 1
## 2 1 -1 -1 -1 -1
## 3 -1 1 -1 -1 -1
## 4 1 1 -1 -1 1
## 5 -1 -1 1 -1 -1
## 6 1 -1 1 -1 1
## 7 -1 1 1 -1 1
## 8 1 1 1 -1 -1
## 9 -1 -1 -1 1 -1
## 10 1 -1 -1 1 1
## 11 -1 1 -1 1 1
## 12 1 1 -1 1 -1
## 13 -1 -1 1 1 1
## 14 1 -1 1 1 -1
## 15 -1 1 1 1 -1
## 16 1 1 1 1 1
## class=design, type= FrF2CONCLUSIONS:
- Main Effects: No main effect is confounded with the blocks.
- Two-Factor Interactions (2fis): No two-factor interaction is confounded with the blocks
11 Question 8.25
Construct a \(2^{7-2}\) design. Show how the design may be run in four blocks of eight observations each. Are any main effects or two-factor interactions confounded with blocks?
11.1 Solution - Question 8.25
# Set up a resolution IV design with 7 factors, divided into 4 blocks
design <- FrF2(nfactor = 7, blocks =4, nruns = 32, randomize=FALSE)
# Aliased relationships
aliasprint(design)## $legend
## [1] A=A B=B C=C D=D E=E F=F G=G
##
## $main
## character(0)
##
## $fi2
## [1] AB=CF=DG AC=BF AD=BG AF=BC AG=BD CD=FG CG=DFsummary(design)## Call:
## FrF2(nfactor = 7, blocks = 4, nruns = 32, randomize = FALSE)
##
## Experimental design of type FrF2.blocked
## 32 runs
## blocked design with 4 blocks of size 8
##
## Factor settings (scale ends):
## A B C D E F G
## 1 -1 -1 -1 -1 -1 -1 -1
## 2 1 1 1 1 1 1 1
##
## Design generating information:
## $legend
## [1] A=A B=B C=C D=D E=E F=F G=G
##
## $`generators for design itself`
## [1] F=ABC G=ABD
##
## $`block generators`
## [1] ACD ABE
##
##
## Alias structure:
## $fi2
## [1] AB=CF=DG AC=BF AD=BG AF=BC AG=BD CD=FG CG=DF
##
## Aliased with block main effects:
## [1] none
##
## The design itself:
## run.no run.no.std.rp Blocks A B C D E F G
## 1 1 1.1.1 1 -1 -1 -1 -1 -1 -1 -1
## 2 2 7.1.2 1 -1 -1 1 1 -1 1 1
## 3 3 10.1.3 1 -1 1 -1 -1 1 1 1
## 4 4 16.1.4 1 -1 1 1 1 1 -1 -1
## 5 5 20.1.5 1 1 -1 -1 1 1 1 -1
## 6 6 22.1.6 1 1 -1 1 -1 1 -1 1
## 7 7 27.1.7 1 1 1 -1 1 -1 -1 1
## 8 8 29.1.8 1 1 1 1 -1 -1 1 -1
## run.no run.no.std.rp Blocks A B C D E F G
## 9 9 2.2.1 2 -1 -1 -1 -1 1 -1 -1
## 10 10 8.2.2 2 -1 -1 1 1 1 1 1
## 11 11 9.2.3 2 -1 1 -1 -1 -1 1 1
## 12 12 15.2.4 2 -1 1 1 1 -1 -1 -1
## 13 13 19.2.5 2 1 -1 -1 1 -1 1 -1
## 14 14 21.2.6 2 1 -1 1 -1 -1 -1 1
## 15 15 28.2.7 2 1 1 -1 1 1 -1 1
## 16 16 30.2.8 2 1 1 1 -1 1 1 -1
## run.no run.no.std.rp Blocks A B C D E F G
## 17 17 3.3.1 3 -1 -1 -1 1 -1 -1 1
## 18 18 5.3.2 3 -1 -1 1 -1 -1 1 -1
## 19 19 12.3.3 3 -1 1 -1 1 1 1 -1
## 20 20 14.3.4 3 -1 1 1 -1 1 -1 1
## 21 21 18.3.5 3 1 -1 -1 -1 1 1 1
## 22 22 24.3.6 3 1 -1 1 1 1 -1 -1
## 23 23 25.3.7 3 1 1 -1 -1 -1 -1 -1
## 24 24 31.3.8 3 1 1 1 1 -1 1 1
## run.no run.no.std.rp Blocks A B C D E F G
## 25 25 4.4.1 4 -1 -1 -1 1 1 -1 1
## 26 26 6.4.2 4 -1 -1 1 -1 1 1 -1
## 27 27 11.4.3 4 -1 1 -1 1 -1 1 -1
## 28 28 13.4.4 4 -1 1 1 -1 -1 -1 1
## 29 29 17.4.5 4 1 -1 -1 -1 -1 1 1
## 30 30 23.4.6 4 1 -1 1 1 -1 -1 -1
## 31 31 26.4.7 4 1 1 -1 -1 1 -1 -1
## 32 32 32.4.8 4 1 1 1 1 1 1 1
## class=design, type= FrF2.blocked
## NOTE: columns run.no and run.no.std.rp are annotation,
## not part of the data frameCONCLUSIONS:
- Main Effects: No main effect is confounded with other effects or with the blocks.
- Two-Factor Interactions: Some two-factor interactions are aliased with each other.
- Blocks: There is no direct confounding between the blocks and main effects or two-factor interactions.
12 Question 8.28
A 16-run experiment was performed in a semiconductor manufacturing plant to study the effects of six factors on the curvature or camber of the substrate devices produced. The six variables and their levels are shown in Table P8.2. Each run was replicated four times, and a camber measurement was taken on the substrate. The data are shown in Table P8.3.
(a) What type of design did the experimenters
use?
(b) What are the alias relationships in this
design?
(c) Do any of the process variables affect average
camber?
(d) Do any of the process variables affect the
variability in camber measurements?
(e) If it is important to reduce camber as much as
possible, what recommendations would you make?
12.1 Solution - Question 8.28
Create the dataframe:
# Create the dataframe:
f_A <- c(-1,1,-1,1,-1,1,-1,1,-1,1,-1,1,-1,1,-1,1)
f_B <- c(-1,-1,1,1,-1,-1,1,1,-1,-1,1,1,-1,-1,1,1)
f_C <- c(-1,-1,-1,-1,1,1,1,1,-1,-1,-1,-1,1,1,1,1)
f_D <- c(-1,-1,-1,-1,-1,-1,-1,-1,1,1,1,1,1,1,1,1)
f_E <- c(-1,1,1,-1,1,-1,-1,1,-1,1,1,-1,1,-1,-1,1)
f_F <- c(-1,1,-1,1,1,-1,1,-1,1,-1,1,-1,-1,1,-1,1)
obs <- c(0.0167,0.0062,0.0041,0.0073,0.0047,0.0219,0.0121,0.0255,0.0032,0.0078,0.0043,0.0186,0.0110,0.0065,0.0155,0.0093,0.0128,0.0066,0.0043,0.0081,0.0047,0.0258,0.0090,0.0250,0.0023,0.0158,0.0027,0.0137,0.0086,0.0109,0.0158,0.0124,0.0149,0.0044,0.0042,0.0039,0.0040,0.0147,0.0092,0.0226,0.0077,0.0060,0.0028,0.0158,0.0101,0.0126,0.0145,0.0110,0.0185,0.0020,0.0050,0.0030,0.0089,0.0296,0.0086,0.0169,0.0069,0.0045,0.0028,0.0159,0.0158,0.0071,0.0145,0.0133)
data <- data.frame(f_A,f_B,f_C,f_D,f_E,f_F,obs)
data$f_A <- as.factor(data$f_A)
data$f_B <- as.factor(data$f_B)
data$f_C <- as.factor(data$f_C)
data$f_D <- as.factor(data$f_D)
data$f_E <- as.factor(data$f_E)
data$f_F <- as.factor(data$f_F)
rmarkdown::paged_table(data)12.1.1 Section (a)
**(a) What type of design did the experimenters use?**
Considering: - Factors (k): 6 - Runs: 16
The fraction is: \(2_{IV}^{6-2}\)
Where: - Design Generators: $E = ABC $, $F = BCD $ - I = ABCE - I = BCDF - I = (ABCE)(BCDF) = ADEF
12.1.2 Section (b)
(b) What are the alias relationships in this design?
Alias relationships:
design <- FrF2(nfactors = 6,resolution = 4 , randomize = FALSE)
aliasprint(design)## $legend
## [1] A=A B=B C=C D=D E=E F=F
##
## $main
## character(0)
##
## $fi2
## [1] AB=CE=DF AC=BE AD=BF AE=BC AF=BD CD=EF CF=DE12.1.3 Section (c)
(c) Do any of the process variables affect average camber?
Test the model:
model <- aov(obs~f_A*f_B*f_C*f_D*f_E*f_F,data = data)
summary(model)## Df Sum Sq Mean Sq F value Pr(>F)
## f_A 1 0.0002422 0.0002422 27.793 3.17e-06 ***
## f_B 1 0.0000053 0.0000053 0.614 0.43725
## f_C 1 0.0005023 0.0005023 57.644 9.14e-10 ***
## f_D 1 0.0000323 0.0000323 3.712 0.05995 .
## f_E 1 0.0001901 0.0001901 21.815 2.45e-05 ***
## f_F 1 0.0009602 0.0009602 110.192 5.05e-14 ***
## f_A:f_B 1 0.0000587 0.0000587 6.738 0.01249 *
## f_A:f_C 1 0.0000803 0.0000803 9.218 0.00387 **
## f_B:f_C 1 0.0000527 0.0000527 6.053 0.01754 *
## f_A:f_D 1 0.0000239 0.0000239 2.741 0.10431
## f_B:f_D 1 0.0000849 0.0000849 9.739 0.00305 **
## f_C:f_D 1 0.0000622 0.0000622 7.139 0.01027 *
## f_D:f_E 1 0.0000088 0.0000088 1.007 0.32062
## f_A:f_B:f_D 1 0.0000000 0.0000000 0.005 0.94291
## f_B:f_C:f_D 1 0.0000481 0.0000481 5.523 0.02293 *
## Residuals 48 0.0004183 0.0000087
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1From the anova Table the following factors affect average camber:
Factor A (Lamination Temperature)
Factor C (Lamination Pressure)
Factor E (Firing Cycle Time)
Factor F (Firing Dew Point)
12.1.4 Section (d)
(d) Do any of the process variables affect the variability in camber measurements?
design2 <- FrF2(nfactors = 6,resolution = 4 , randomize = FALSE)
response <- c(24.418,20.976,4.083,25.025,22.41,63.639,16.029,39.42,26.725,50.341,7.681,20.083,31.12,29.51,6.75,17.45)
des.resp <- add.response(design, response)
summary(des.resp)## Call:
## FrF2(nfactors = 6, resolution = 4, randomize = FALSE)
##
## Experimental design of type FrF2
## 16 runs
##
## Factor settings (scale ends):
## A B C D E F
## 1 -1 -1 -1 -1 -1 -1
## 2 1 1 1 1 1 1
##
## Responses:
## [1] response
##
## Design generating information:
## $legend
## [1] A=A B=B C=C D=D E=E F=F
##
## $generators
## [1] E=ABC F=ABD
##
##
## Alias structure:
## $fi2
## [1] AB=CE=DF AC=BE AD=BF AE=BC AF=BD CD=EF CF=DE
##
##
## The design itself:
## A B C D E F response
## 1 -1 -1 -1 -1 -1 -1 24.418
## 2 1 -1 -1 -1 1 1 20.976
## 3 -1 1 -1 -1 1 1 4.083
## 4 1 1 -1 -1 -1 -1 25.025
## 5 -1 -1 1 -1 1 -1 22.410
## 6 1 -1 1 -1 -1 1 63.639
## 7 -1 1 1 -1 -1 1 16.029
## 8 1 1 1 -1 1 -1 39.420
## 9 -1 -1 -1 1 -1 1 26.725
## 10 1 -1 -1 1 1 -1 50.341
## 11 -1 1 -1 1 1 -1 7.681
## 12 1 1 -1 1 -1 1 20.083
## 13 -1 -1 1 1 1 1 31.120
## 14 1 -1 1 1 -1 -1 29.510
## 15 -1 1 1 1 -1 -1 6.750
## 16 1 1 1 1 1 1 17.450
## class=design, type= FrF2DanielPlot(des.resp, half = TRUE)
MEPlot(des.resp, show.alias = TRUE)
CONCLUSIONS:
- Main Effects: Factors A and B have the steepest slopes in the main effects plot, confirming their strong influence on the response.
- Due to the Resolution IV design, two-factor interactions are aliased (e.g., AB = CE = DF), but no strong evidence of significant interactions is observed.
12.1.5 Section (e)
(e) If it is important to reduce camber as much as possible, what recommendations would you make?
model <- lm(obs~f_A*f_B*f_C*f_D*f_E*f_F,data = data)
coef(model)## (Intercept) f_A1
## 0.015725000 0.001009375
## f_B1 f_C1
## -0.007137500 0.001784375
## f_D1 f_E1
## -0.002953125 -0.004187500
## f_F1 f_A1:f_B1
## -0.007746875 0.003725000
## f_A1:f_C1 f_B1:f_C1
## 0.004481250 0.007100000
## f_A1:f_D1 f_B1:f_D1
## -0.002550000 0.007968750
## f_C1:f_D1 f_A1:f_E1
## -0.000475000 NA
## f_B1:f_E1 f_C1:f_E1
## NA NA
## f_D1:f_E1 f_A1:f_F1
## 0.001481250 NA
## f_B1:f_F1 f_C1:f_F1
## NA NA
## f_D1:f_F1 f_E1:f_F1
## NA NA
## f_A1:f_B1:f_C1 f_A1:f_B1:f_D1
## NA 0.000212500
## f_A1:f_C1:f_D1 f_B1:f_C1:f_D1
## NA -0.006937500
## f_A1:f_B1:f_E1 f_A1:f_C1:f_E1
## NA NA
## f_B1:f_C1:f_E1 f_A1:f_D1:f_E1
## NA NA
## f_B1:f_D1:f_E1 f_C1:f_D1:f_E1
## NA NA
## f_A1:f_B1:f_F1 f_A1:f_C1:f_F1
## NA NA
## f_B1:f_C1:f_F1 f_A1:f_D1:f_F1
## NA NA
## f_B1:f_D1:f_F1 f_C1:f_D1:f_F1
## NA NA
## f_A1:f_E1:f_F1 f_B1:f_E1:f_F1
## NA NA
## f_C1:f_E1:f_F1 f_D1:f_E1:f_F1
## NA NA
## f_A1:f_B1:f_C1:f_D1 f_A1:f_B1:f_C1:f_E1
## NA NA
## f_A1:f_B1:f_D1:f_E1 f_A1:f_C1:f_D1:f_E1
## NA NA
## f_B1:f_C1:f_D1:f_E1 f_A1:f_B1:f_C1:f_F1
## NA NA
## f_A1:f_B1:f_D1:f_F1 f_A1:f_C1:f_D1:f_F1
## NA NA
## f_B1:f_C1:f_D1:f_F1 f_A1:f_B1:f_E1:f_F1
## NA NA
## f_A1:f_C1:f_E1:f_F1 f_B1:f_C1:f_E1:f_F1
## NA NA
## f_A1:f_D1:f_E1:f_F1 f_B1:f_D1:f_E1:f_F1
## NA NA
## f_C1:f_D1:f_E1:f_F1 f_A1:f_B1:f_C1:f_D1:f_E1
## NA NA
## f_A1:f_B1:f_C1:f_D1:f_F1 f_A1:f_B1:f_C1:f_E1:f_F1
## NA NA
## f_A1:f_B1:f_D1:f_E1:f_F1 f_A1:f_C1:f_D1:f_E1:f_F1
## NA NA
## f_B1:f_C1:f_D1:f_E1:f_F1 f_A1:f_B1:f_C1:f_D1:f_E1:f_F1
## NA NAsummary(model)##
## Call:
## lm.default(formula = obs ~ f_A * f_B * f_C * f_D * f_E * f_F,
## data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.008300 -0.001350 -0.000350 0.001744 0.007275
##
## Coefficients: (48 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.0157250 0.0014760 10.654 3.06e-14 ***
## f_A1 0.0010094 0.0016502 0.612 0.543644
## f_B1 -0.0071375 0.0018077 -3.948 0.000257 ***
## f_C1 0.0017844 0.0016502 1.081 0.284963
## f_D1 -0.0029531 0.0019525 -1.512 0.136976
## f_E1 -0.0041875 0.0010437 -4.012 0.000210 ***
## f_F1 -0.0077469 0.0007380 -10.497 5.05e-14 ***
## f_A1:f_B1 0.0037250 0.0020874 1.785 0.080655 .
## f_A1:f_C1 0.0044812 0.0014760 3.036 0.003866 **
## f_B1:f_C1 0.0071000 0.0020874 3.401 0.001359 **
## f_A1:f_D1 -0.0025500 0.0020874 -1.222 0.227809
## f_B1:f_D1 0.0079688 0.0025565 3.117 0.003083 **
## f_C1:f_D1 -0.0004750 0.0020874 -0.228 0.820954
## f_A1:f_E1 NA NA NA NA
## f_B1:f_E1 NA NA NA NA
## f_C1:f_E1 NA NA NA NA
## f_D1:f_E1 0.0014812 0.0014760 1.004 0.320619
## f_A1:f_F1 NA NA NA NA
## f_B1:f_F1 NA NA NA NA
## f_C1:f_F1 NA NA NA NA
## f_D1:f_F1 NA NA NA NA
## f_E1:f_F1 NA NA NA NA
## f_A1:f_B1:f_C1 NA NA NA NA
## f_A1:f_B1:f_D1 0.0002125 0.0029520 0.072 0.942912
## f_A1:f_C1:f_D1 NA NA NA NA
## f_B1:f_C1:f_D1 -0.0069375 0.0029520 -2.350 0.022926 *
## f_A1:f_B1:f_E1 NA NA NA NA
## f_A1:f_C1:f_E1 NA NA NA NA
## f_B1:f_C1:f_E1 NA NA NA NA
## f_A1:f_D1:f_E1 NA NA NA NA
## f_B1:f_D1:f_E1 NA NA NA NA
## f_C1:f_D1:f_E1 NA NA NA NA
## f_A1:f_B1:f_F1 NA NA NA NA
## f_A1:f_C1:f_F1 NA NA NA NA
## f_B1:f_C1:f_F1 NA NA NA NA
## f_A1:f_D1:f_F1 NA NA NA NA
## f_B1:f_D1:f_F1 NA NA NA NA
## f_C1:f_D1:f_F1 NA NA NA NA
## f_A1:f_E1:f_F1 NA NA NA NA
## f_B1:f_E1:f_F1 NA NA NA NA
## f_C1:f_E1:f_F1 NA NA NA NA
## f_D1:f_E1:f_F1 NA NA NA NA
## f_A1:f_B1:f_C1:f_D1 NA NA NA NA
## f_A1:f_B1:f_C1:f_E1 NA NA NA NA
## f_A1:f_B1:f_D1:f_E1 NA NA NA NA
## f_A1:f_C1:f_D1:f_E1 NA NA NA NA
## f_B1:f_C1:f_D1:f_E1 NA NA NA NA
## f_A1:f_B1:f_C1:f_F1 NA NA NA NA
## f_A1:f_B1:f_D1:f_F1 NA NA NA NA
## f_A1:f_C1:f_D1:f_F1 NA NA NA NA
## f_B1:f_C1:f_D1:f_F1 NA NA NA NA
## f_A1:f_B1:f_E1:f_F1 NA NA NA NA
## f_A1:f_C1:f_E1:f_F1 NA NA NA NA
## f_B1:f_C1:f_E1:f_F1 NA NA NA NA
## f_A1:f_D1:f_E1:f_F1 NA NA NA NA
## f_B1:f_D1:f_E1:f_F1 NA NA NA NA
## f_C1:f_D1:f_E1:f_F1 NA NA NA NA
## f_A1:f_B1:f_C1:f_D1:f_E1 NA NA NA NA
## f_A1:f_B1:f_C1:f_D1:f_F1 NA NA NA NA
## f_A1:f_B1:f_C1:f_E1:f_F1 NA NA NA NA
## f_A1:f_B1:f_D1:f_E1:f_F1 NA NA NA NA
## f_A1:f_C1:f_D1:f_E1:f_F1 NA NA NA NA
## f_B1:f_C1:f_D1:f_E1:f_F1 NA NA NA NA
## f_A1:f_B1:f_C1:f_D1:f_E1:f_F1 NA NA NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.002952 on 48 degrees of freedom
## Multiple R-squared: 0.849, Adjusted R-squared: 0.8018
## F-statistic: 18 on 15 and 48 DF, p-value: 9.012e-15Recommendations:
- Focus on Significant Factors: In the results, factors A, C, E and F have statistically significant effects (with low p-values), indicating they have a greater influence on camber. Consider adjusting these factors to minimize their impact, as controlling these significant variables may help reduce camber.
- Eliminate Non-Significant Factors: Factors and interactions with high p-values (like B and certain third- and fourth-order interactions) do not have a significant effect on camber. Reducing the variability of these factors could be less of a priority, allowing you to focus on the factors with the most impact.
- Minimize Significant Interactions: Some interactions, such as AB, AC, BC, BD, CD; also showed significance. By controlling or reducing the influence of these interactions, We may reduce camber.
13 Question 8.40
Consider the following experiment:
Answer the following questions about this experiment:
(a) How many factors did this experiment
investigate?
(b) What is the resolution of this design?
(c) Calculate the estimates of the main effects.
(d) What is the complete defining relation for this
design?
13.1 Solution - Question 8.40
13.1.1 Section (a)
(a) How many factors did this experiment investigate?
Answer: Four Factors (a, b, c and d)
13.1.2 Section (b)
(b) What is the resolution of this design?
Answer: The resolution is 4
13.1.3 Section (c)
(c) Calculate the estimates of the main effects.
design <- FrF2(nfactor = 4, nrun = 8, randomize = FALSE)
response <- c(8,10,12,7,13,6,5,11)
des.resp <- add.response(design, response)
coef(lm(des.resp))[-1]*2## A1 B1 C1 D1 A1:B1 A1:C1 A1:D1
## -1.0 -0.5 -0.5 5.0 1.5 0.5 -1.0The effect estimates are:
A = -1
B = - 0.5
C = - 0.5
D = 5
13.1.4 Section (d)
(d) What is the complete defining relation for this design?
generators(design)## $generators
## [1] "D=ABC"Answer: I = ABCD
14 Question 8.48
Consider the following design:
(a) What is the generator for column D?
(b) What is the generator for column E?
(c) If this design were folded over, what is the
resolution of the combined design?
14.1 Solution - Question 8.48
design<- FrF2(nfactors = 5,nruns = 8,generators = c("-ABC","BC"), randomize = FALSE)
summary(design)## Call:
## FrF2(nfactors = 5, nruns = 8, generators = c("-ABC", "BC"), randomize = FALSE)
##
## Experimental design of type FrF2.generators
## 8 runs
##
## Factor settings (scale ends):
## A B C D E
## 1 -1 -1 -1 -1 -1
## 2 1 1 1 1 1
##
## Design generating information:
## $legend
## [1] A=A B=B C=C D=D E=E
##
## $generators
## [1] D=-ABC E=BC
##
##
## Alias structure:
## $main
## [1] A=-DE B=CE C=BE D=-AE E=-AD=BC
##
## $fi2
## [1] AB=-CD AC=-BD
##
##
## The design itself:
## A B C D E
## 1 -1 -1 -1 1 1
## 2 1 -1 -1 -1 1
## 3 -1 1 -1 -1 -1
## 4 1 1 -1 1 -1
## 5 -1 -1 1 -1 -1
## 6 1 -1 1 1 -1
## 7 -1 1 1 1 1
## 8 1 1 1 -1 1
## class=design, type= FrF2.generators14.1.1 Section (a)
**(a) What is the generator for column D?**
Answer: D = -ABC
14.1.2 Section (b)
(b) What is the generator for column E?
Answer: E = BC
14.1.3 Section (c)
(c) If this design were folded over, what is the resolution of the combined design?
Answer: Resolution = 4
15 Question 8.60
Consider a partial fold over for the \(2_{III}^{7-4}\) design. Suppose that the partial fold over of this design is constructed using column A (+ signs only). Determine the alias relationships in the combined design.
15.1 Solution - Question 8.60
design <- FrF2(nfactors = 7, resolution = 3, randomize = FALSE)
summary(design)## Call:
## FrF2(nfactors = 7, resolution = 3, randomize = FALSE)
##
## Experimental design of type FrF2
## 8 runs
##
## Factor settings (scale ends):
## A B C D E F G
## 1 -1 -1 -1 -1 -1 -1 -1
## 2 1 1 1 1 1 1 1
##
## Design generating information:
## $legend
## [1] A=A B=B C=C D=D E=E F=F G=G
##
## $generators
## [1] D=AB E=AC F=BC G=ABC
##
##
## Alias structure:
## $main
## [1] A=BD=CE=FG B=AD=CF=EG C=AE=BF=DG D=AB=CG=EF E=AC=BG=DF F=AG=BC=DE G=AF=BE=CD
##
##
## The design itself:
## A B C D E F G
## 1 -1 -1 -1 1 1 1 -1
## 2 1 -1 -1 -1 -1 1 1
## 3 -1 1 -1 -1 1 -1 1
## 4 1 1 -1 1 -1 -1 -1
## 5 -1 -1 1 1 -1 -1 1
## 6 1 -1 1 -1 1 -1 -1
## 7 -1 1 1 -1 -1 1 -1
## 8 1 1 1 1 1 1 1
## class=design, type= FrF2Partial fold over just the factor A:
design_pfoldover <- fold.design(design, column = 1)
summary(design_pfoldover)## Multi-step-call:
## [[1]]
## FrF2(nfactors = 7, resolution = 3, randomize = FALSE)
##
## $fold
## [1] 1
##
##
## Experimental design of type FrF2.folded
## 16 runs
##
## Factor settings (scale ends):
## A B C fold D E F G
## 1 -1 -1 -1 original -1 -1 -1 -1
## 2 1 1 1 mirror 1 1 1 1
##
## Design generating information:
## $legend
## [1] A=A B=B C=C D=fold E=D F=E G=F H=G
##
##
## Alias structure:
## $main
## [1] B=CG=FH C=BG=EH E=CH=FG F=BH=EG G=BC=EF H=BF=CE
##
## $fi2
## [1] AB=-DE AC=-DF AD=-BE=-CF=-GH AE=-BD AF=-CD
## [6] AG=-DH AH=-DG
##
##
## The design itself:
## A B C fold D E F G
## 1 -1 -1 -1 original 1 1 1 -1
## 2 1 -1 -1 original -1 -1 1 1
## 3 -1 1 -1 original -1 1 -1 1
## 4 1 1 -1 original 1 -1 -1 -1
## 5 -1 -1 1 original 1 -1 -1 1
## 6 1 -1 1 original -1 1 -1 -1
## 7 -1 1 1 original -1 -1 1 -1
## 8 1 1 1 original 1 1 1 1
## 9 1 -1 -1 mirror 1 1 1 -1
## 10 -1 -1 -1 mirror -1 -1 1 1
## 11 1 1 -1 mirror -1 1 -1 1
## 12 -1 1 -1 mirror 1 -1 -1 -1
## 13 1 -1 1 mirror 1 -1 -1 1
## 14 -1 -1 1 mirror -1 1 -1 -1
## 15 1 1 1 mirror -1 -1 1 -1
## 16 -1 1 1 mirror 1 1 1 1
## class=design, type= FrF2.foldedAlias structure:
- B=CG=FH
- C=BG=EH
- E=CH=FG
- F=BH=EG
- G=BC=EF
- H=BF=CE
16 Complete R-Code
# Libraries
library(dplyr)
library(tidyr)
library(GAD)
library(DoE.base)
library(FrF2)
# QUESTION 6.8 #######################################################################################
# Create the dataframe
time <- c(rep(12,12), rep(18,12))
culture <- rep(c(rep(1,2), rep(2,2)), 6)
obs <- c(21, 22, 25, 26,
23, 28, 24, 25,
20, 26, 29, 27,
37, 39, 31, 34,
38, 38, 29, 33,
35, 36, 30, 35)
data <- data.frame(time,culture,obs)
data$time <- as.fixed(data$time)
data$culture <- as.fixed(data$culture)
# Testing the model
time <- data$time
culture <- data$culture
response <- data$obs
equation <- response ~ time + culture + time*culture
model <- aov(equation)
GAD::gad(model)
# Plotting Residuals vs Fitted
plot(model, 1)
# Plotting QQ Normal
plot(model, 2)
# QUESTION 6.12 #######################################################################################
# Creating the Dataframe:
A_0 <- c(-1,1,-1,1)
B_0 <- c(-1,-1,1,1)
A <- rep(A_0, rep(4,4))
B <- rep(B_0, rep(4,4))
obs <- c(14.037, 16.165, 13.972, 13.907,
13.880, 13.860, 14.032, 13.914,
14.821, 14.757, 14.843, 14.878,
14.888, 14.921, 14.415, 14.932)
data <- data.frame(A, B, obs)
data$A <- as.fixed(data$A)
data$B <- as.fixed(data$B)
# Section A:
A <- data$A
B <- data$B
response <- data$obs
equation <- response ~ A + B + A*B
model <- lm(equation)
coef(model)
# Section B:
A <- data$A
B <- data$B
response <- data$obs
equation <- response ~ A + B + A*B
model <- aov(equation)
GAD::gad(model)
# Section C:
equation <- response ~ A + B + A*B
model <- lm(equation)
coef(model)
# Section D:
plot(model)
# QUESTION 6.21 #######################################################################################
# Creating the Dataframe:
factorA <- c(10, 30)
factorB <- c("Mallet", "Cavity back")
factorC <- c("Straight", "Breaking")
factorD <- c("Level", "Downhill")
obs <- c(10,18,14,12.5,19,16,18.5,
0,16.5,4.5,17.5,20.5,17.5,33,
4,6,1,14.5,12,14,5,
0,10,34,11,25.5,21.5,0,
0,0,18.5,19.5,16,15,11,
5,20.5,18,20,29.5,19,10,
6.5,18.5,7.5,6,0,10,0,
16.5,4.5,0,23.5,8,8,8,
4.5,18,14.5,10,0,17.5,6,
19.5,18,16,5.5,10,7,36,
15,16,8.5,0,0.5,9,3,
41.5,39,6.5,3.5,7,8.5,36,
8,4.5,6.5,10,13,41,14,
21.5,10.5,6.5,0,15.5,24,16,
0,0,0,4.5,1,4,6.5,
18,5,7,10,32.5,18.5,8)
length_putt <- rep(rep(factorA, each = 7), 8)
type_putt <- rep(rep(factorB, each = 7*2), 4)
break_putt <- rep(rep(factorC, each = 7*4), 2)
slope_putt <- rep(factorD, each = 7*8)
data <- data.frame(length_putt,type_putt,break_putt,slope_putt,obs)
data$length_putt <- as.fixed(data$length_putt)
data$type_putt <- as.fixed(data$type_putt)
data$break_putt <- as.fixed(data$break_putt)
data$slope_putt <- as.fixed(data$slope_putt)
# Section A:
# Testing the model
length_putt <- data$length_putt
type_putt <- data$type_putt
break_putt <- data$break_putt
slope_putt <- data$slope_putt
response <- data$obs
equation <- response ~ length_putt + type_putt + break_putt + slope_putt +
length_putt*type_putt + length_putt*break_putt + length_putt*slope_putt +
type_putt*break_putt + type_putt*slope_putt + break_putt*slope_putt +
length_putt*type_putt*break_putt + length_putt*type_putt*slope_putt +
length_putt*break_putt*slope_putt + type_putt*break_putt*slope_putt +
length_putt*type_putt*break_putt*slope_putt
model <- aov(equation)
GAD::gad(model)
# Section B:
# Plotting Residuals vs Fitted
plot(model, 1)
# Plotting QQ Normal
plot(model, 2)
# QUESTION 6.36 #######################################################################################
# Creating the Dataframe:
A<-rep(c(-1,1), 8)
B<-rep(rep(c(-1,1), each = 2),4)
C<-rep(rep(c(-1,1), each = 4),2)
D<-rep(c(-1,1), each = 8)
obs <- c(1.92,11.28,1.09,5.75,2.13,9.53,1.03,5.35,1.60,11.73,1.16,4.68,2.16,9.11,1.07,5.30)
data <- data.frame(A,B,C,D, obs)
# Section A:
# Testing the model
equation <- obs ~ A + B + C + D +
A*B + A*C + A*D + B*C + B*D + C*D +
A*B*C + A*B*D + A*C*D + B*C*D +
A*B*C*D
model <- lm(equation, data = data)
# Estimate the factor effects
coef(model)
# Section B:
# Testing the model
data$A <- as.fixed(data$A)
data$B <- as.fixed(data$B)
data$C <- as.fixed(data$C)
data$D <- as.fixed(data$D)
equation <- obs ~ A + B + A*B + A*B*C
model <- aov(equation,data=data)
GAD::gad(model)
# Section C:
A<-rep(c(-1,1), 8)
B<-rep(rep(c(-1,1), each = 2),4)
C<-rep(rep(c(-1,1), each = 4),2)
D<-rep(c(-1,1), each = 8)
obs <- c(1.92,11.28,1.09,5.75,2.13,9.53,1.03,5.35,1.60,11.73,1.16,4.68,2.16,9.11,1.07,5.30)
log_obs <- log(obs)
data2 <- data.frame(A,B,C,D, log_obs)
equation2 <- log_obs ~ A + B + C + D +
A*B + A*C + A*D + B*C + B*D + C*D +
A*B*C + A*B*D + A*C*D + B*C*D +
A*B*C*D
model2 <- lm(equation2, data = data2)
# Estimate the factor effects
coef(model2)
# Half normal plot
halfnormal(model2)
# Section D:
# Testing the model
equation2 <- log_obs ~ A + B + A*B + A*B*C
model2 <- lm(equation2,data=data2)
summary(model2)
# QUESTION 6.39 #######################################################################################
# Creating the Dataframe:
A<-rep(c(-1,1), 16)
B<-rep(rep(c(-1,1), each = 2),8)
C<-rep(rep(c(-1,1), each = 4),4)
D<-rep(rep(c(-1,1), each = 8),2)
E<-rep(c(-1,1), each = 16)
obs <- c(8.11,5.56,5.77,5.82,9.17,7.8,3.23,5.69,8.82,14.23,9.2,8.94,8.68,11.49,6.25,9.12,7.93,5,7.47,12,9.86,3.65,6.4,11.61,12.43,17.55,8.87,25.38,13.06,18.85,11.78,26.05)
data <- data.frame(A,B,C,D,E, obs)
# Section A:
# Testing the model
equation <- obs ~ A + B + C + D + E +
A*B + A*C + A*D + A*E + B*C + B*D + B*E + C*D + C*E + D*E +
A*B*C + A*B*D + A*B*E + A*C*D + A*C*E + A*D*E +
B*C*D + B*C*E + B*D*E + C*D*E +
A*B*C*D + A*B*C*E + A*B*D*E + A*C*D*E + B*C*D*E +
A*B*C*D*E
model <- lm(equation, data = data)
# Estimate the factor effects
coef(model)
# Section B:
equation2 <- obs ~ A + D + E + A*D + D*E + B*E + A*B + A*E + A*B*E + A*D*E
model2 <- aov(equation2, data = data)
# Plotting Residuals vs Fitted
plot(model2, 1)
# Plotting QQ Normal
plot(model2, 2)
# Section C:
A<-rep(c(-1,1), 16)
B<-rep(rep(c(-1,1), each = 2),8)
D<-rep(rep(c(-1,1), each = 8),2)
E<-rep(c(-1,1), each = 16)
obs <- c(8.11,5.56,5.77,5.82,9.17,7.8,3.23,5.69,8.82,14.23,9.2,8.94,8.68,11.49,6.25,9.12,7.93,5,7.47,12,9.86,3.65,6.4,11.61,12.43,17.55,8.87,25.38,13.06,18.85,11.78,26.05)
data2 <- data.frame(A,B,D,E, obs)
rmarkdown::paged_table(data2)
# Testing the model
equation <- obs ~ A + B + D + E +
A*B + A*D + A*E + B*D + B*E + D*E +
A*B*D + A*B*E + A*D*E + B*D*E +
A*B*D*E
model3 <- lm(equation, data = data2)
# Half Normal plot
halfnormal(model3)
# Section D:
equation2 <- obs ~ A + D + E + A*D + D*E + B*E + A*B + A*E + A*B*E + A*D*E
model2 <- aov(equation2, data = data)
summary(model2)
coef(model2)
# QUESTION 7.12 #######################################################################################
# Creating the Dataframe:
factorA <- c(10, 30)
factorB <- c("Mallet", "Cavity back")
factorC <- c("Straight", "Breaking")
factorD <- c("Level", "Downhill")
obs <- c(10,18,14,12.5,19,16,18.5,
0,16.5,4.5,17.5,20.5,17.5,33,
4,6,1,14.5,12,14,5,
0,10,34,11,25.5,21.5,0,
0,0,18.5,19.5,16,15,11,
5,20.5,18,20,29.5,19,10,
6.5,18.5,7.5,6,0,10,0,
16.5,4.5,0,23.5,8,8,8,
4.5,18,14.5,10,0,17.5,6,
19.5,18,16,5.5,10,7,36,
15,16,8.5,0,0.5,9,3,
41.5,39,6.5,3.5,7,8.5,36,
8,4.5,6.5,10,13,41,14,
21.5,10.5,6.5,0,15.5,24,16,
0,0,0,4.5,1,4,6.5,
18,5,7,10,32.5,18.5,8)
length_putt <- rep(rep(factorA, each = 7), 8)
type_putt <- rep(rep(factorB, each = 7*2), 4)
break_putt <- rep(rep(factorC, each = 7*4), 2)
slope_putt <- rep(factorD, each = 7*8)
data0 <- data.frame(length_putt,type_putt,break_putt,slope_putt,obs)
data0$length_putt <- as.fixed(data0$length_putt)
data0$type_putt <- as.fixed(data0$type_putt)
data0$break_putt <- as.fixed(data0$break_putt)
data0$slope_putt <- as.fixed(data0$slope_putt)
model <- lm(obs ~ length_putt + type_putt + break_putt + slope_putt + block +
length_putt*type_putt + length_putt*break_putt + type_putt*break_putt +
length_putt*slope_putt + type_putt*slope_putt + break_putt*slope_putt +
length_putt*type_putt*break_putt + length_putt*type_putt*slope_putt + length_putt*break_putt*slope_putt + type_putt*break_putt*slope_putt +
length_putt*type_putt*break_putt*slope_putt,
data = data)
GAD::gad(model)
# QUESTION 7.20 #######################################################################################
Block1 <- c('(1)', 'a', 'b', 'ab', 'c', 'ac', 'bc', 'abc', 'f', 'af', 'bf', 'abf', 'cf', 'acf', 'bcf', 'abcf')
Block2 <- c('d', 'ad', 'bd', 'abd', 'cd', 'acd', 'bcd', 'abcd', 'df', 'adf', 'bdf', 'abdf', 'cdf', 'acdf', 'bcdf', 'abcdf')
Block3 <- c('e', 'ae', 'be', 'abe', 'ce', 'ace', 'bce', 'abce', 'ef', 'aef', 'bef', 'abef', 'cef', 'acef', 'bcef', 'abcef')
Block4 <- c('de', 'ade', 'bde', 'abde', 'cde', 'acde', 'bcde', 'abcde', 'def', 'adef', 'bdef', 'abdef', 'cdef', 'acdef', 'bcdef', 'abcdef')
confound <- cbind(Block1, Block2, Block3, Block4)
confound
# QUESTION 7.21 #######################################################################################
# Define blocks based on confounded effects ABCD, ACE, and ABEF
block1 <- c('(1)', 'a', 'bc', 'abc', 'de', 'ade', 'bde', 'abde')
block2 <- c('b', 'acd', 'ce', 'abde', 'abcf', 'df', 'aef', 'bcdef')
block3 <- c('ac', 'be', 'cf', 'abcde', 'abcdef', 'd', 'a', 'f')
block4 <- c('c', 'ae', 'ef', 'b', 'ab', 'bcf', 'de', 'abde')
block5 <- c('d', 'ab', 'bcd', 'cdf', 'ade', 'f', 'aef', 'bc')
block6 <- c('e', 'bce', 'abcf', 'a', 'abc', 'df', 'cdef', 'abcdef')
block7 <- c('ad', 'be', 'ce', 'af', 'abc', 'bcde', 'bdf', 'ef')
block8 <- c('abcd', 'abef', 'abcdef', 'bce', 'f', 'cdf', 'd', 'ace')
# Combine blocks
confound <- cbind(block1,block2,block3,block4,block5,block6,block7,block8)
confound
# QUESTION 8.2 ########################################################################################
# Set-up a resolution IV design with 4 factors
des.res4<- FrF2(nfactors=4,resolution=4,randomize=FALSE)
# Aliased relationships
aliasprint(des.res4)
# Add Response
response <- c(7.037, 16.867, 13.876, 17.273, 11.846, 4.368, 9.36, 15.653)
des.resp <- add.response(des.res4,response)
summary(des.resp)
DanielPlot(des.resp,half = TRUE)
MEPlot(des.resp, show.alias = TRUE)
# QUESTION 8.24 #######################################################################################
# Set-up a resolution V design with 5 factors
des.res5<- FrF2(nfactors=5,resolution=5,randomize=FALSE)
# Aliased relationships
aliasprint(des.res5)
summary(des.res5)
# QUESTION 8.25 #######################################################################################
# Set up a resolution IV design with 7 factors, divided into 4 blocks
design <- FrF2(nfactor = 7, blocks =4, nruns = 32, randomize=FALSE)
# Aliased relationships
aliasprint(design)
summary(design)
# QUESTION 8.28 #######################################################################################
# Create the dataframe:
f_A <- c(-1,1,-1,1,-1,1,-1,1,-1,1,-1,1,-1,1,-1,1)
f_B <- c(-1,-1,1,1,-1,-1,1,1,-1,-1,1,1,-1,-1,1,1)
f_C <- c(-1,-1,-1,-1,1,1,1,1,-1,-1,-1,-1,1,1,1,1)
f_D <- c(-1,-1,-1,-1,-1,-1,-1,-1,1,1,1,1,1,1,1,1)
f_E <- c(-1,1,1,-1,1,-1,-1,1,-1,1,1,-1,1,-1,-1,1)
f_F <- c(-1,1,-1,1,1,-1,1,-1,1,-1,1,-1,-1,1,-1,1)
obs <- c(0.0167,0.0062,0.0041,0.0073,0.0047,0.0219,0.0121,0.0255,0.0032,0.0078,0.0043,0.0186,0.0110,0.0065,0.0155,0.0093,0.0128,0.0066,0.0043,0.0081,0.0047,0.0258,0.0090,0.0250,0.0023,0.0158,0.0027,0.0137,0.0086,0.0109,0.0158,0.0124,0.0149,0.0044,0.0042,0.0039,0.0040,0.0147,0.0092,0.0226,0.0077,0.0060,0.0028,0.0158,0.0101,0.0126,0.0145,0.0110,0.0185,0.0020,0.0050,0.0030,0.0089,0.0296,0.0086,0.0169,0.0069,0.0045,0.0028,0.0159,0.0158,0.0071,0.0145,0.0133)
data <- data.frame(f_A,f_B,f_C,f_D,f_E,f_F,obs)
data$f_A <- as.factor(data$f_A)
data$f_B <- as.factor(data$f_B)
data$f_C <- as.factor(data$f_C)
data$f_D <- as.factor(data$f_D)
data$f_E <- as.factor(data$f_E)
data$f_F <- as.factor(data$f_F)
# Section B
design <- FrF2(nfactors = 6,resolution = 4 , randomize = FALSE)
aliasprint(design)
# Section C
model <- aov(obs~f_A*f_B*f_C*f_D*f_E*f_F,data = data)
summary(model)
# Section D
design2 <- FrF2(nfactors = 6,resolution = 4 , randomize = FALSE)
response <- c(24.418,20.976,4.083,25.025,22.41,63.639,16.029,39.42,26.725,50.341,7.681,20.083,31.12,29.51,6.75,17.45)
des.resp <- add.response(design, response)
summary(des.resp)
DanielPlot(des.resp, half = TRUE)
MEPlot(des.resp, show.alias = TRUE)
# Section E
model <- lm(obs~f_A*f_B*f_C*f_D*f_E*f_F,data = data)
coef(model)
summary(model)
# QUESTION 8.40 #######################################################################################
# Section C
design <- FrF2(nfactor = 4, nrun = 8, randomize = FALSE)
response <- c(8,10,12,7,13,6,5,11)
des.resp <- add.response(design, response)
coef(lm(des.resp))[-1]*2
# Section D
generators(design)
# QUESTION 8.48 #######################################################################################
design<- FrF2(nfactors = 5,nruns = 8,generators = c("-ABC","BC"), randomize = FALSE)
summary(design)
# QUESTION 8.60 #######################################################################################
design <- FrF2(nfactors = 7, resolution = 3, randomize = FALSE)
summary(design)
design_pfoldover <- fold.design(design, column = 1)
summary(design_pfoldover)