Homework 4 - Module 5
Jairo Rodriguez (R11925123)
Last compiled on October 25, 2024 at 1:17 PM
1 Question 5.2
The following output was obtained from a computer program that performed a two-factor ANOVA on a factorial experiment.
(a) Fill in the blanks in the ANOVA table. You can
use bounds on the P-values.
(b) How many levels were used for factor B?
(c) How many replicates of the experiment were
performed?
(d) What conclusions would you draw about this
experiment?
1.1 Solution - Question 5.2
Data from the table:
# Degrees of freedom
df_A <- 1
df_AB <- 3
df_error <- 8
df_total <- 15
# Sum of squares
SSB <- 180.378
SSAB <- 8.479
SSE <- 158.797
SST <- 347.653
# Mean Squares
MSA <- 0.0002
# P-values
p_value_AB <- 0.9321.1.1 Section (a)
(a) Fill in the blanks in the ANOVA table. You can use bounds on the P-values.
Calculating missing values
# Degrees of freedom: Calculating missing values
df_B <- df_total - (df_A + df_AB + df_error)
df <- c(df_A, df_B, df_AB, df_error, df_total)
# Sum of squares: Calculating missing values
SSA <- MSA/df_A
SS <- c(SSA,SSB,SSAB,SSE,SST)
# Mean Squares: Calculating missing values
MSB <- SSB/df_B
MSAB <- SSAB/df_AB
MSE <- SSE/df_error
MS <- c(MSA,MSB,MSAB,MSE,NA)
# F-statistic
fa <- MSA/MSE
fb <- MSB/MSE
fab <- MSAB/MSE
f <- c(fa,fb,fab,NA,NA)
# P-values: Calculating missing values
p_value_A <- pf(fa,df_A,df_error, lower.tail = FALSE)
p_value_B <- pf(fb,df_B,df_error, lower.tail = FALSE)
p_values <- c(p_value_A, p_value_B, p_value_AB,NA,NA)
source <- c("A","B","Interaction","Error", "Total")
anova_table <- data.frame(source, df,SS,MS,f,p_values)
rmarkdown::paged_table(anova_table)1.1.2 Section (b)
(b) How many levels were used for factor B?.
Considering “J-1 = Degrees of freedom of Factor B”:
# Levels of Factor B
Lvl_B <- df_B + 1
print(Lvl_B)## [1] 4There are 4 levels of factor B
1.1.3 Section (c)
(c) How many replicates of the experiment were performed?.
Considering “IJK - 1 = Total degrees of freedom”
# Levels of Factor B
I <- df_A + 1
J <- df_B + 1
K <- (df_total + 1)/(I*J)
print(K)## [1] 2There are 2 replicates
1.1.4 Section (d)
(d) What conclusions would you draw about this experiment?.
Considering the p-values:
# ANOVA Table
rmarkdown::paged_table(anova_table)CONCLUSIONS (Assuming a significance level of 0.05):
- From ANOVA Table: for Main Effect “A” the p-value is 0.99754506, which means we fail to reject the null hypothesis, and there is not a significant effect for A
- From ANOVA Table: for Main Effect “B” the p-value is 0.09334682, which means we fail reject the null hypothesis, and there is not a significant effect for B
- From ANOVA Table: for Interaction Effect “AB” the p-value is 0.93200000, which means we fail to reject the null hypothesis, and there is not a significant effect for AB
- There is not a main or interaction significant effect in the experiment
2 Question 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:
(a) Analyze the data and draw conclusions. Use \(\alpha = 0.05\).
(b) Prepare appropriate residual plots and comment on
the model’s adequacy
(c) Obtain point estimates of the mean surface finish
at each feed rate.
(d) Find the P-values for the tests in part (a)
2.1 Solution - Question 5.4
Creating the Dataframe:
factorA <- c(0.20, 0.25, 0.30)
factorB <- c(0.15, 0.18, 0.20, 0.25)
feed_rate <- c(rep(factorA[1],12), rep(factorA[2],12), rep(factorA[3],12))
depth_cut <- c(rep(factorB,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)
data <- data.frame(feed_rate, depth_cut, obs)
# Assuming that Factors are fixed effects
data$feed_rate <- as.fixed(data$feed_rate)
data$depth_cut <- as.fixed(data$depth_cut)
rmarkdown::paged_table(data)2.1.1 Section (a)
(a) Analyze the data and draw conclusions. Use \(\alpha = 0.05\).
Linear Effect equation:
\[ y_{i,j} = \mu + \alpha_i + \beta_j + (\alpha\beta)_{ij} + \epsilon_{i,j} \] Where:
- \(\mu = \text{Grand Mean}\)
- \(\alpha_i = \text{Main Effect of Feed Rate}\)
- \(\beta_j = \text{Main Effect of Depth of Cut}\)
- \((\alpha\beta)_{ij} = \text{Interaction Effect of Feed Rate and Depth of Cut}\)
- \(\epsilon_{i,j} = \text{Random Error}\)
Hypothesis test for Main Effect A (Feed Rate):
- \(H_0: \alpha_i = 0\)
- \(H_a: \alpha_i \neq 0\)
Hypothesis test for Main Effect B (Depth of Cut):
- \(H_0: \beta_j = 0\)
- \(H_a: \beta_j \neq 0\)
Hypothesis test for Interaction Effect AB (Feed Rate and Depth of Cut):
- \(H_0: (\alpha\beta)_{ij} = 0\)
- \(H_a: (\alpha\beta)_{ij} \neq 0\)
Testing the model
FeedRate <- data$feed_rate
DepthOfCut <- data$depth_cut
response <- data$obs
equation <- response ~ FeedRate + DepthOfCut + FeedRate*DepthOfCut
model <- aov(equation)
GAD::gad(model)## $anova
## Analysis of Variance Table
##
## Response: response
## Df Sum Sq Mean Sq F value Pr(>F)
## FeedRate 2 3160.50 1580.25 55.0184 1.086e-09 ***
## DepthOfCut 3 2125.11 708.37 24.6628 1.652e-07 ***
## FeedRate:DepthOfCut 6 557.06 92.84 3.2324 0.01797 *
## Residuals 24 689.33 28.72
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1CONCLUSIONS:
Since the P-Value (0.000000001086) of Main Effect “A” (Feed Rate) is less than significance level (0.05), We reject the null hypothesis. This indicates that there is a significant effect for A
Since the P-Value (0.0000001652) of Main Effect “B” (Depth of Cut) is less than significance level (0.05), We reject the null hypothesis. This indicates that there is a significant effect for B
Since the P-Value (0.01797) of Interaction Effect “AB” (Feed Rate and Depth of Cut) is less than significance level (0.05), We reject the null hypothesis. This indicates that there is a significant effect for AB (interaction)
Just to confirm the results we plot the “interaction plot”
interaction.plot(x.factor = FeedRate,
trace.factor = DepthOfCut,
response = response,
col=c("red","blue", "green", "black")
)
We can confirm that there is an interaction between factors A and B because there is no parallelism between the lines
2.1.2 Section (b)
(b) Prepare appropriate residual plots and comment on 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. Additionally, the residuals vs fitted values plot shows that the residuals are distributed with roughly equal spread, suggesting that the assumption of constant variance is also met.
We can consider that the model is adequate for the parametric Anova Test
2.1.3 Section (c)
(b) Obtain point estimates of the mean surface finish at each feed rate.
mean_fr1 <- mean(data$obs[1:12])
mean_fr2 <- mean(data$obs[13:24])
mean_fr3 <- mean(data$obs[25:36])
print(paste("Estimate point for Feed Rate 0.20: ", mean_fr1))## [1] "Estimate point for Feed Rate 0.20: 81.5833333333333"print(paste("Estimate point for Feed Rate 0.25: ", mean_fr2))## [1] "Estimate point for Feed Rate 0.25: 97.5833333333333"print(paste("Estimate point for Feed Rate 0.30: ", mean_fr3))## [1] "Estimate point for Feed Rate 0.30: 103.833333333333"2.1.4 Section (d)
(d) Find the P-values for the tests in part (a)
From the ANOVA Table:
GAD::gad(model)## $anova
## Analysis of Variance Table
##
## Response: response
## Df Sum Sq Mean Sq F value Pr(>F)
## FeedRate 2 3160.50 1580.25 55.0184 1.086e-09 ***
## DepthOfCut 3 2125.11 708.37 24.6628 1.652e-07 ***
## FeedRate:DepthOfCut 6 557.06 92.84 3.2324 0.01797 *
## Residuals 24 689.33 28.72
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1CONCLUSIONS:
P-Value of Main Effect “A” (Feed Rate) = 0.000000001086
P-Value of Main Effect “B” (Depth of Cut) = 0.0000001652
P-Value of Interaction Effect “AB” (Feed Rate and Depth of Cut) = 0.01797
3 Question 5.9
A mechanical engineer is studying the thrust force developed by a drill press. He suspects that the drilling speed and the feed rate of the material are the most important factors. He selects four feed rates and uses a high and low drill speed chosen to represent the extreme operating conditions. He obtains the following results. Analyze the data and draw conclusions. Use \(\alpha = 0.05\).
3.1 Solution - Question 5.9
Creating the Dataframe:
factorA <- c(125,200)
factorB <- c(0.015, 0.030, 0.045, 0.060)
drill_speed <- c(rep(factorA[1],8),rep(factorA[2],8))
feed_rate <- c(rep(factorB,4))
obs <- c(2.70, 2.45, 2.60, 2.75,
2.78, 2.49, 2.72, 2.86,
2.83, 2.85, 2.86, 2.94,
2.86, 2.80, 2.87, 2.88)
data <- data.frame(drill_speed, feed_rate,obs)
# Assuming that Factors are fixed effects
data$drill_speed <- as.fixed(data$drill_speed)
data$feed_rate <- as.fixed(data$feed_rate)
rmarkdown::paged_table(data)Linear Effect equation:
\[ y_{i,j} = \mu + \alpha_i + \beta_j + (\alpha\beta)_{ij} + \epsilon_{i,j} \]
Where:
- \(\mu = \text{Grand Mean}\)
- \(\alpha_i = \text{Main Effect of Drill Speed}\)
- \(\beta_j = \text{Main Effect of Feed Rate}\)
- \((\alpha\beta)_{ij} = \text{Interaction Effect of Drill Speed and Feed Rate}\)
- \(\epsilon_{i,j} = \text{Random Error}\)
Hypothesis test for Main Effect A (Drill Speed):
- \(H_0: \alpha_i = 0\)
- \(H_a: \alpha_i \neq 0\)
Hypothesis test for Main Effect B (Feed Rate):
- \(H_0: \beta_j = 0\)
- \(H_a: \beta_j \neq 0\)
Hypothesis test for Interaction Effect AB (Drill Speed and Feed Rate):
- \(H_0: (\alpha\beta)_{ij} = 0\)
- \(H_a: (\alpha\beta)_{ij} \neq 0\)
Testing the model
DrillSpeed <- data$drill_speed
FeedRate <- data$feed_rate
response <- data$obs
equation <- response ~ DrillSpeed + FeedRate + DrillSpeed*FeedRate
model <- aov(equation)
GAD::gad(model)## $anova
## Analysis of Variance Table
##
## Response: response
## Df Sum Sq Mean Sq F value Pr(>F)
## DrillSpeed 1 0.148225 0.148225 57.0096 6.605e-05 ***
## FeedRate 3 0.092500 0.030833 11.8590 0.002582 **
## DrillSpeed:FeedRate 3 0.041875 0.013958 5.3686 0.025567 *
## Residuals 8 0.020800 0.002600
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1CONCLUSIONS:
Since the P-Value (0.00006605) of Main Effect “A” (Drill Speed) is less than significance level (0.05), We reject the null hypothesis. This indicates that there is a significant effect for A
Since the P-Value (0.002582) of Main Effect “B” (Feed Rate) is less than significance level (0.05), We reject the null hypothesis. This indicates that there is a significant effect for B
Since the P-Value (0.025567) of Interaction Effect “AB” (Drill Speed and Feed Rate) is less than significance level (0.05), We reject the null hypothesis. This indicates that there is a significant effect for AB (interaction)
4 Question 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?
4.1 Solution - Question 5.34
Creating the Dataframe:
factorA <- c(0.20, 0.25, 0.30)
factorB <- c(0.15, 0.18, 0.20, 0.25)
block <- c(1,2,3)
blocks <- rep(c(
rep(block[1], 4),
rep(block[2], 4),
rep(block[3], 4)
), 3)
feed_rate <- c(rep(factorA[1],12), rep(factorA[2],12), rep(factorA[3],12))
depth_cut <- c(rep(factorB,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)
data <- data.frame(blocks, feed_rate, depth_cut, obs)
# Assuming that Factors are fixed effects
data$feed_rate <- as.fixed(data$feed_rate)
data$depth_cut <- as.fixed(data$depth_cut)
data$blocks <- as.fixed(data$blocks)
rmarkdown::paged_table(data)Linear Effect equation:
\[ y_{i,j,k} = \mu + \alpha_i + \beta_j + (\alpha\beta)_{ij} + \gamma_k+ \epsilon_{i,j,k} \]
Where:
- \(\mu = \text{Grand Mean}\)
- \(\alpha_i = \text{Main Effect of Drill Speed}\)
- \(\beta_j = \text{Main Effect of Feed Rate}\)
- \((\alpha\beta)_{ij} = \text{Interaction Effect of Drill Speed and Feed Rate}\)
- \(\gamma_k = \text{Effect of Block}\)
- \(\epsilon_{i,j} = \text{Random Error}\)
Hypothesis test for Main Effect A (Drill Speed):
- \(H_0: \alpha_i = 0\)
- \(H_a: \alpha_i \neq 0\)
Hypothesis test for Main Effect B (Feed Rate):
- \(H_0: \beta_j = 0\)
- \(H_a: \beta_j \neq 0\)
Hypothesis test for Interaction Effect AB (Drill Speed and Feed Rate):
- \(H_0: (\alpha\beta)_{ij} = 0\)
- \(H_a: (\alpha\beta)_{ij} \neq 0\)
Testing the model
FeedRate <- data$feed_rate
DepthOfCut <- data$depth_cut
blocks <- data$blocks
response <- data$obs
equation <- response ~ FeedRate + DepthOfCut + FeedRate*DepthOfCut + blocks
model <- aov(equation)
GAD::gad(model)## $anova
## Analysis of Variance Table
##
## Response: response
## Df Sum Sq Mean Sq F value Pr(>F)
## FeedRate 2 3160.50 1580.25 68.3463 3.635e-10 ***
## DepthOfCut 3 2125.11 708.37 30.6373 4.893e-08 ***
## blocks 2 180.67 90.33 3.9069 0.035322 *
## FeedRate:DepthOfCut 6 557.06 92.84 4.0155 0.007258 **
## Residuals 22 508.67 23.12
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1CONCLUSIONS:
Effect of Blocking: Adding the block to the model increases the interaction effect between feed rate and depth of cut. The p-value for the interaction term drops from 0.01797 (before blocking) to 0.007258 (after blocking), indicating stronger evidence that the interaction is significant. Blocking has thus revealed a stronger interaction effect.
Impact on Main Effects: The p-values for the main effects (feed rate and depth of cut) were already very small without blocking, indicating their significance. However, after adding the block, the p-values decreased further. For feed rate, the p-value decreases from 1.086e-09 to 3.635e-10, and for depth of cut, it decreases from 1.652e-07 to 4.893e-08. While blocking has made the main effects even more statistically significant
Residuals: The residual variance is significantly reduced after adding the block. The sum of squares for the residuals decreases from 689.33 to 508.67, and the mean square error reduces from 28.72 to 23.12. This reduction in residual error means that the model with blocking leads to a better fit.
5 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.
Information from problem 5.13: An experiment was conducted to determine whether either firing temperature or furnace position affects the baked density of a carbon anode.
Note: Suppose 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?
Creating the Dataframe:
factorA <- c(1, 2)
factorB <- c(800, 825, 850)
position <- c(rep(factorA[1],9), rep(factorA[2],9))
temperature <- c(rep(factorB,6))
obs <- c(570,1063,565,
565,1080,510,
583,1043,590,
528,988,526,
547,1026,538,
521,1004,532)
data <- data.frame(position, temperature, obs)
# Setting fixed and random effects
data$position <- as.random(data$position)
data$temperature <- as.fixed(data$temperature)
rmarkdown::paged_table(data)5.1 Solution - Question 13.5
Linear Effect equation:
\[ y_{i,j} = \mu + \alpha_i + \beta_j + (\alpha\beta)_{ij} + \epsilon_{i,j} \]
Where:
- \(\mu = \text{Grand Mean}\)
- \(\alpha_i = \text{Main Effect of Position}\)
- \(\beta_j = \text{Main Effect of Temperature}\)
- \((\alpha\beta)_{ij} = \text{Interaction Effect of Position and Temperature}\)
- \(\epsilon_{i,j} = \text{Random Error}\)
Hypothesis test for Main Effect A (Position):
- \(H_0: \alpha_i = 0\)
- \(H_a: \alpha_i \neq 0\)
Hypothesis test for Main Effect B (Temperature):
- \(H_0: \beta_j = 0\)
- \(H_a: \beta_j \neq 0\)
Hypothesis test for Interaction Effect AB (Position and Temperature):
- \(H_0: (\alpha\beta)_{ij} = 0\)
- \(H_a: (\alpha\beta)_{ij} \neq 0\)
Testing the model
position <- data$position
temperature <- data$temperature
response <- data$obs
equation <- response ~ position + temperature + position*temperature
model <- aov(equation)
GAD::gad(model)## $anova
## 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
## Residuals 12 5371 448
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1CONCLUSIONS:
Since the P-Value (0.0017624) of Main Effect “A” (Position) is less than significance level (0.05), We reject the null hypothesis. This indicates that there is a significant effect for A
Since the P-Value (0.0008647) of Main Effect “B” (Temperature) is less than significance level (0.05), We reject the null hypothesis. This indicates that there is a significant effect for B
Since the P-Value (0.4271101) of Interaction Effect “AB” (Position and temperature) is greater than significance level (0.05), We fail to reject the null hypothesis. This indicates that there is not a significant effect for AB (interaction)
6 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.
Information from problem 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 following Table:
Creating the Dataframe:
factorA <- seq(1,10)
factorB <- c(1,2)
parts <- c(rep(factorA[1],6), rep(factorA[2],6), rep(factorA[3],6), rep(factorA[4],6), rep(factorA[5],6),
rep(factorA[6],6), rep(factorA[7],6), rep(factorA[8],6), rep(factorA[9],6), rep(factorA[10],6))
operator <- rep(c(
rep(factorB[1], 3),
rep(factorB[2], 3)
), 10)
obs <- 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(parts, operator, obs)
# Setting fixed and random effects
data$parts <- as.random(data$parts)
data$operator <- as.fixed(data$operator)
rmarkdown::paged_table(data)6.1 Solution - Question 13.6
Linear Effect equation:
\[ y_{i,j} = \mu + \alpha_i + \beta_j + (\alpha\beta)_{ij} + \epsilon_{i,j} \]
Where:
- \(\mu = \text{Grand Mean}\)
- \(\alpha_i = \text{Main Effect of Parts}\)
- \(\beta_j = \text{Main Effect of Operator}\)
- \((\alpha\beta)_{ij} = \text{Interaction Effect of Parts and Operator}\)
- \(\epsilon_{i,j} = \text{Random Error}\)
Hypothesis test for Main Effect A (Parts):
- \(H_0: \alpha_i = 0\)
- \(H_a: \alpha_i \neq 0\)
Hypothesis test for Main Effect B (Operator):
- \(H_0: \beta_j = 0\)
- \(H_a: \beta_j \neq 0\)
Hypothesis test for Interaction Effect AB (Parts and Operator):
- \(H_0: (\alpha\beta)_{ij} = 0\)
- \(H_a: (\alpha\beta)_{ij} \neq 0\)
Testing the model
parts <- data$parts
operators <- data$operator
response <- data$obs
equation <- response ~ parts + operators + parts*operators
model <- aov(equation)
GAD::gad(model)## $anova
## Analysis of Variance Table
##
## Response: response
## Df Sum Sq Mean Sq F value Pr(>F)
## parts 9 99.017 11.0019 7.3346 3.216e-06 ***
## operators 1 0.417 0.4167 0.6923 0.4269
## parts:operators 9 5.417 0.6019 0.4012 0.9270
## Residuals 40 60.000 1.5000
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1CONCLUSIONS:
Since the P-Value (0.000003216) of Main Effect “A” (Parts) is less than significance level (0.05), We reject the null hypothesis. This indicates that there is a significant effect for A
Since the P-Value (0.4269) of Main Effect “B” (Operators) 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
Since the P-Value (0.9270) of Interaction Effect “AB” (Parts and operator) is greater than significance level (0.05), We fail to reject the null hypothesis. This indicates that there is not a significant effect for AB (interaction)
7 Complete R-Code
# Libraries
library(dplyr)
library(tidyr)
library(GAD)
# QUESTION 5.2 #######################################################################################
# Data from table
# Degrees of freedom
df_A <- 1
df_AB <- 3
df_error <- 8
df_total <- 15
# Sum of squares
SSB <- 180.378
SSAB <- 8.479
SSE <- 158.797
SST <- 347.653
# Mean Squares
MSA <- 0.0002
# P-values
p_value_AB <- 0.932
# Section A
# Degrees of freedom: Calculating missing values
df_B <- df_total - (df_A + df_AB + df_error)
df <- c(df_A, df_B, df_AB, df_error, df_total)
# Sum of squares: Calculating missing values
SSA <- MSA/df_A
SS <- c(SSA,SSB,SSAB,SSE,SST)
# Mean Squares: Calculating missing values
MSB <- SSB/df_B
MSAB <- SSAB/df_AB
MSE <- SSE/df_error
MS <- c(MSA,MSB,MSAB,MSE,NA)
# F-statistic
fa <- MSA/MSE
fb <- MSB/MSE
fab <- MSAB/MSE
f <- c(fa,fb,fab,NA,NA)
# P-values: Calculating missing values
p_value_A <- pf(fa,df_A,df_error, lower.tail = FALSE)
p_value_B <- pf(fb,df_B,df_error, lower.tail = FALSE)
p_values <- c(p_value_A, p_value_B, p_value_AB,NA,NA)
source <- c("A","B","Interaction","Error", "Total")
anova_table <- data.frame(source, df,SS,MS,f,p_values)
rmarkdown::paged_table(anova_table)
# Section B
# Levels of Factor B
Lvl_B <- df_B + 1
print(Lvl_B)
# Section C
# Levels of Factor B
I <- df_A + 1
J <- df_B + 1
K <- (df_total + 1)/(I*J)
print(K)
# Section D
# ANOVA Table
rmarkdown::paged_table(anova_table)
# QUESTION 5.4 #######################################################################################
# Creating the dataframe
factorA <- c(0.20, 0.25, 0.30)
factorB <- c(0.15, 0.18, 0.20, 0.25)
feed_rate <- c(rep(factorA[1],12), rep(factorA[2],12), rep(factorA[3],12))
depth_cut <- c(rep(factorB,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)
data <- data.frame(feed_rate, depth_cut, obs)
# Assuming that Factors are fixed effects
data$feed_rate <- as.fixed(data$feed_rate)
data$depth_cut <- as.fixed(data$depth_cut)
rmarkdown::paged_table(data)
# Section A
FeedRate <- data$feed_rate
DepthOfCut <- data$depth_cut
response <- data$obs
equation <- response ~ FeedRate + DepthOfCut + FeedRate*DepthOfCut
model <- aov(equation)
GAD::gad(model)
# Section B
# Plotting Residuals vs Fitted
plot(model, 1)
# Plotting QQ Normal
plot(model, 2)
# Section C
mean_fr1 <- mean(data$obs[1:12])
mean_fr2 <- mean(data$obs[13:24])
mean_fr3 <- mean(data$obs[25:36])
print(paste("Estimate point for Feed Rate 0.20: ", mean_fr1))
print(paste("Estimate point for Feed Rate 0.25: ", mean_fr2))
print(paste("Estimate point for Feed Rate 0.30: ", mean_fr3))
# Section D
GAD::gad(model)
# QUESTION 5.9 #######################################################################################
# Creating the dataframe
factorA <- c(125,200)
factorB <- c(0.015, 0.030, 0.045, 0.060)
drill_speed <- c(rep(factorA[1],8),rep(factorA[2],8))
feed_rate <- c(rep(factorB,4))
obs <- c(2.70, 2.45, 2.60, 2.75,
2.78, 2.49, 2.72, 2.86,
2.83, 2.85, 2.86, 2.94,
2.86, 2.80, 2.87, 2.88)
data <- data.frame(drill_speed, feed_rate,obs)
# Assuming that Factors are fixed effects
data$drill_speed <- as.fixed(data$drill_speed)
data$feed_rate <- as.fixed(data$feed_rate)
rmarkdown::paged_table(data)
# Testing the model
DrillSpeed <- data$drill_speed
FeedRate <- data$feed_rate
response <- data$obs
equation <- response ~ DrillSpeed + FeedRate + DrillSpeed*FeedRate
model <- aov(equation)
GAD::gad(model)
# QUESTION 5.34 ######################################################################################
# Creating the dataframe
factorA <- c(0.20, 0.25, 0.30)
factorB <- c(0.15, 0.18, 0.20, 0.25)
block <- c(1,2,3)
blocks <- rep(c(
rep(block[1], 4),
rep(block[2], 4),
rep(block[3], 4)
), 3)
feed_rate <- c(rep(factorA[1],12), rep(factorA[2],12), rep(factorA[3],12))
depth_cut <- c(rep(factorB,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)
data <- data.frame(blocks, feed_rate, depth_cut, obs)
# Assuming that Factors are fixed effects
data$feed_rate <- as.fixed(data$feed_rate)
data$depth_cut <- as.fixed(data$depth_cut)
data$blocks <- as.fixed(data$)
rmarkdown::paged_table(data)
# Testing the model
FeedRate <- data$feed_rate
DepthOfCut <- data$depth_cut
blocks <- data$blocks
response <- data$obs
equation <- response ~ FeedRate + DepthOfCut + FeedRate*DepthOfCut + blocks
model <- aov(equation)
GAD::gad(model)
# QUESTION 13.5 ######################################################################################
# Creating the dataframe
factorA <- c(1, 2)
factorB <- c(800, 825, 850)
position <- c(rep(factorA[1],9), rep(factorA[2],9))
temperature <- c(rep(factorB,6))
obs <- c(570,1063,565,
565,1080,510,
583,1043,590,
528,988,526,
547,1026,538,
521,1004,532)
data <- data.frame(position, temperature, obs)
# Setting fixed and random effects
data$position <- as.random(data$position)
data$temperature <- as.fixed(data$temperature)
rmarkdown::paged_table(data)
# Testing the model
position <- data$position
temperature <- data$temperature
response <- data$obs
equation <- response ~ position + temperature + position*temperature
model <- aov(equation)
GAD::gad(model)
# QUESTION 13.6 ######################################################################################
# Creating the dataframe
factorA <- seq(1,10)
factorB <- c(1,2)
parts <- c(rep(factorA[1],6), rep(factorA[2],6), rep(factorA[3],6), rep(factorA[4],6), rep(factorA[5],6),
rep(factorA[6],6), rep(factorA[7],6), rep(factorA[8],6), rep(factorA[9],6), rep(factorA[10],6))
operator <- rep(c(
rep(factorB[1], 3),
rep(factorB[2], 3)
), 10)
obs <- 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(parts, operator, obs)
# Setting fixed and random effects
data$parts <- as.random(data$parts)
data$operator <- as.fixed(data$operator)
rmarkdown::paged_table(data)
# Testing the model
parts <- data$parts
operators <- data$operator
response <- data$obs
equation <- response ~ parts + operators + parts*operators
model <- aov(equation)
GAD::gad(model)