Library Used
library(GAD)
library(knitr)
library(dplyr)
library(tidyr)
From the ANOVA Table we have
#Degree of Freedom of Main Factor A
DF_A=1
#Degree of Freedom of Interaction AB
DF_AB=3
#Degree of Freedom of Error
DF_E=8
#Degree of Freedom of Total
DF_T=15
#Sum of Square
SSB = 180.378
SSAB = 8.479
SSE = 158.797
SST = 347.653
#Mean Square
MSA = 0.0002
p-value of Interaction=0.932
We know D.F. of interaction = (I-1)*((J-1)
So (J-1) or the Degree of Freedom main Factor B =3
DF_B= 3
SSA = MSA/DF_A
SSA
## [1] 2e-04
MSB = SSB/DF_B
MSB
## [1] 60.126
MSAB = SSAB/DF_AB
MSAB
## [1] 2.826333
MSE = SSE/DF_E
MSE
## [1] 19.84962
F_A = MSA/MSE
F_A
## [1] 1.007576e-05
F_B = MSB/MSE
F_B
## [1] 3.029075
F_AB = MSAB/MSE
F_AB
## [1] 0.1423872
pvalue_A = (1 - pf(F_A, DF_A, DF_E))
pvalue_B = (1 - pf(F_B, DF_B, DF_E))
pvalue_A
## [1] 0.9975451
pvalue_B
## [1] 0.09334682
| Source | DF | SS | MS | F | P |
|---|---|---|---|---|---|
| A | 1 | 0.0002 | .0002 | 1.00757e-5 | 0.9975 |
| B | 3 | 180.378 | 60.126 | 3.02907 | 0.0933 |
| Interaction | 3 | 8.479 | 2.8263 | 0.14238 | 0.9317 |
| Error | 8 | 158.797 | 19.8496 | ||
| Total | 15 | 347.653 |
Factor B have 4 levels
Here total observations =16
Level of factor A = 2 & factor B = 4
Total number of replicates, K = 16/(2*4) = 2
We can see that, for an \(\alpha\) = 0.05, we fail to reject the null hypothesis.
Hence, we conclude that there is no main or interaction effect present in the provided experiment.
feed_rate54 <-c(rep(0.20,12), rep(0.25,12), rep(0.30,12))
D <- c(0.15,0.18,0.20,0.25)
DoC <-c(rep(D,9))
obs54 <-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)
df54 <-data.frame (feed_rate54,obs54,DoC)
df54$feed_rate54 <-as.fixed(df54$feed_rate54)
df54$DoC <- as.fixed(df54$DoC)
str(df54)
## 'data.frame': 36 obs. of 3 variables:
## $ feed_rate54: Factor w/ 3 levels "0.2","0.25","0.3": 1 1 1 1 1 1 1 1 1 1 ...
## $ obs54 : num 74 79 82 99 64 68 88 104 60 73 ...
## $ DoC : Factor w/ 4 levels "0.15","0.18",..: 1 2 3 4 1 2 3 4 1 2 ...
Model Equation
\(y_{ijk}+\alpha_{i}+\beta_{j}+\alpha\beta_{ij}++\varepsilon_{ijk}\)
Hypotheses
Feed rate
\(H_0 : \alpha_i = 0\) , for all i.
\(H_a : \alpha_i \neq 0\) , for some i
Depth of Cut Effect
\(H_0 : \beta_j = 0\) , for all j.
\(H_a : \beta_j \neq 0\) , for some j
Interaction Effect
\(H_0 : \alpha\beta_{ij} =0\) , for all ij
\(H_a : \alpha\beta_{ij} neq0\) , for some ij
model54 <-aov(obs54~feed_rate54+DoC+feed_rate54*DoC, data=df54)
GAD::gad(model54)
## $anova
## Analysis of Variance Table
##
## Response: obs54
## Df Sum Sq Mean Sq F value Pr(>F)
## feed_rate54 2 3160.50 1580.25 55.0184 1.086e-09 ***
## DoC 3 2125.11 708.37 24.6628 1.652e-07 ***
## feed_rate54:DoC 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 ' ' 1
From the ANOVA table we can see that p-value of interaction effect 0.018 < 0.05.
We reject H_0 for interaction effect.
Lets observe a interaction plot between the two factors to understand the interaction between them
interaction.plot(df54$feed_rate54,df54$DoC,obs54,
xlab = "Feedrate",
ylab = "Surface Finish",
col = c("blue", "red","black","cyan"),
trace.label = "Depth of Cut")
Residual plots and model’s adequacy.
plot(model54,1:2)
From the plot we can observe that the residual are normal-ish (two outliers) and show constant variation.
Point estimates of the mean surface finish at each feed rate
df54 %>% group_by(feed_rate54) %>% summarize(mean_surface_finish = mean(obs54))
## # A tibble: 3 × 2
## feed_rate54 mean_surface_finish
## <fct> <dbl>
## 1 0.2 81.6
## 2 0.25 97.6
## 3 0.3 104.
p-value of the test
GAD::gad(model54)
## $anova
## Analysis of Variance Table
##
## Response: obs54
## Df Sum Sq Mean Sq F value Pr(>F)
## feed_rate54 2 3160.50 1580.25 55.0184 1.086e-09 ***
## DoC 3 2125.11 708.37 24.6628 1.652e-07 ***
## feed_rate54:DoC 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 ' ' 1
p-value of interaction =0.01797
p-value of feed rate = 1.08610e-9
p-value of Depth of cut = 1.65210e-7
drill_speed <- c(rep("125",8), rep("200",8))
f <- c("0.015","0.030","0.045","0.060")
feed_rate <- rep(f,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)
df <- data.frame(drill_speed,feed_rate, obs)
df$drill_speed <- as.fixed(df$drill_speed)
df$feed_rate <- as.fixed(df$feed_rate)
Model Equation
\(y_{ijk}+\alpha_{i}+\beta_{j}+\alpha\beta_{ij}++\varepsilon_{ijk}\)
Hypotheses
Drill Speed
\(H_0 : \alpha_i = 0\) , for all i.
\(H_a : \alpha_i \neq 0\) , for some i
Feed Rate
\(H_0 : \beta_j = 0\) , for all j.
\(H_a : \beta_j \neq 0\) , for some j
Interaction Effect
\(H_0 : \alpha\beta_{ij} =0\) , for all ij
\(H_a : \alpha\beta_{ij} neq0\) , for some ij
model59 <- aov(obs~drill_speed+feed_rate+drill_speed*feed_rate, data = df)
summary(model59)
## Df Sum Sq Mean Sq F value Pr(>F)
## drill_speed 1 0.14822 0.14822 57.010 6.61e-05 ***
## feed_rate 3 0.09250 0.03083 11.859 0.00258 **
## drill_speed:feed_rate 3 0.04187 0.01396 5.369 0.02557 *
## Residuals 8 0.02080 0.00260
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
From the ANOVA table, we see that there is a significant interaction effect ( p < 0.05).
We reject the null hypothesis that \(\alpha\beta_{ij}= 0\)
Lets observe the interaction plot between the two factors to understand the interaction between them
interaction.plot(df$feed_rate,df$drill_speed,obs,
xlab = "Feedrate",
ylab = "Thrust Force",
col = c("blue", "red"),trace.label = "Drill Speed")
From the interaction plot we can see that,
Feed-rate increases from 0.015 to 0.030, the thrust force shows significant negative correlation for a drill speed of 125.
Feed-rate from 0.030 to 0.045 an forward, there is a positive correlation for drill speed of 125, also for drill speed of 200 there is slight positive correlation visible.
For drill speed 200 the change in trust force does not change significantly like drill speed 125, but follows the trend.
It is quite evident that the interaction between the feed-rate and the drill speed is a significant.
b <-c(rep(1,4),rep(2,4),rep(3,4))
block <- c(rep(b,3))
block <- as.fixed(block)
feed_rate534 <- as.fixed(feed_rate54)
DoC534 <- as.fixed(DoC)
obs534 = obs54
df534 <- data.frame(feed_rate534,DoC534,block,obs534)
str(df534)
## 'data.frame': 36 obs. of 4 variables:
## $ feed_rate534: Factor w/ 3 levels "0.2","0.25","0.3": 1 1 1 1 1 1 1 1 1 1 ...
## $ DoC534 : Factor w/ 4 levels "0.15","0.18",..: 1 2 3 4 1 2 3 4 1 2 ...
## $ block : Factor w/ 3 levels "1","2","3": 1 1 1 1 2 2 2 2 3 3 ...
## $ obs534 : num 74 79 82 99 64 68 88 104 60 73 ...
model534 <- aov(obs534~feed_rate534+DoC534+block+feed_rate534*DoC534)
summary(model534)
## Df Sum Sq Mean Sq F value Pr(>F)
## feed_rate534 2 3160.5 1580.2 68.346 3.64e-10 ***
## DoC534 3 2125.1 708.4 30.637 4.89e-08 ***
## block 2 180.7 90.3 3.907 0.03532 *
## feed_rate534:DoC534 6 557.1 92.8 4.015 0.00726 **
## Residuals 22 508.7 23.1
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
MS_block=90.3
MS_E=23.1
I=3
J=4
We know variance component of effect A = (MS_A-MS_E)/JK
Variance component of Block
var_b=(MS_block-MS_E)/(I*J)
var_b
## [1] 5.6
Without blocking, p-value for Feed Rate of 3.635∗10−10<0.05 & p-value for Depth of Cut of 4.893∗10−8<0.05, meaning the Feed Rate & Depth of Cut is significant and we reject \(H_0\)
With blocking, p-value for Feed Rate-Depth of Cut Interaction of 0.007258<0.05.
The Interaction effect is significant and we reject \(H_0\)
Additionally the p-value for the Block is 0.035322<0.05, shows that the block has a significant effect.
In conclusion Blocking did not change any of the conclusions of significance from Problem 5.4, so we can say that it was not very useful in this experiment.
pos <- c(rep(1,9),rep(2,9))
t <- c(800,825,850)
temp <- c(rep(t,6))
den <- c(570,1063,565,565,1080,510,
583,1043,590,528,988,526,
547,1026,538,521,1004,532)
df135 <- data.frame(pos,temp,den)
df135$pos <-as.random(df135$pos)
df135$temp <-as.fixed(df135$temp)
model135 <-aov(den~pos+temp+pos*temp,data=df135)
GAD::gad(model135)
## $anova
## Analysis of Variance Table
##
## Response: den
## Df Sum Sq Mean Sq F value Pr(>F)
## pos 1 7160 7160 15.998 0.0017624 **
## temp 2 945342 472671 1155.518 0.0008647 ***
## pos:temp 2 818 409 0.914 0.4271101
## Residuals 12 5371 448
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
The p-value for Position of 0.0017624<0.05, emplies the Position of furnace have significant effect.
The p-value for Temperature 0.0008647<0.05. So Temperature does have significant effect.
The p-value for Position-Temperature Interaction of 0.4271101>0.05. Hence Position-Temperature Interaction is not significant.
part <- c(rep(1,6),rep(2,6),rep(3,6),rep(4,6),rep(5,6),
rep(6,6),rep(7,6),rep(8,6),rep(9,6),rep(10,6))
o <- c("Op1","Op1","Op1","Op2","Op2","Op2")
op <- c(rep(o,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)
df136 <- data.frame(part,op,obs)
df136$part <- as.random(df136$part)
df136$op <- as.fixed(df136$op)
str(df136)
## 'data.frame': 60 obs. of 3 variables:
## $ part: Factor w/ 10 levels "1","2","3","4",..: 1 1 1 1 1 1 2 2 2 2 ...
## $ op : Factor w/ 2 levels "Op1","Op2": 1 1 1 2 2 2 1 1 1 2 ...
## $ obs : num 50 49 50 50 48 51 52 52 51 51 ...
model136 <-aov(obs~part+op+part*op,data=df136)
GAD::gad(model136)
## $anova
## Analysis of Variance Table
##
## Response: obs
## Df Sum Sq Mean Sq F value Pr(>F)
## part 9 99.017 11.0019 7.3346 3.216e-06 ***
## op 1 0.417 0.4167 0.6923 0.4269
## part:op 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 ' ' 1
The p-value for Part Number 3.216∗10−6<0.05, implies the Part Number have a significant effect.
The p-value for Operator 0.4269>0.05. So Operator does not have a significant effect.
The p-value for Part Number & Operator Interaction 0..9270>0.05. Hence the Interaction effect is not significant.
library(GAD)
library(knitr)
library(dplyr)
library(tidyr)
#Problem 5.2
#Given
#Degree of Freedom of Main Factor A
DF_A=1
#Degree of Freedom of Interaction AB
DF_AB=3
#Degree of Freedom of Error
DF_E=8
#Degree of Freedom of Total
DF_T=15
#Sum of Square
SSB = 180.378
SSAB = 8.479
SSE = 158.797
SST = 347.653
#Mean Square
MSA = 0.0002
# p-value of Interaction=0.932
## (a)
#We know D.F. of interaction = (I-1)*((J-1)
#So (J-1) or the Degree of Freedom main Factor B
DF_B= 3/1
SSA = MSA/DF_A
MSB = SSB/DF_B
MSAB = SSAB/DF_AB
MSE = SSE/DF_E
F_A = MSA/MSE
F_B = MSB/MSE
F_AB = MSAB/MSE
pvalue_A = (1 - pf(F_A, DF_A, DF_E))
pvalue_B = (1 - pf(F_B, DF_B, DF_E))
# (b)
#Factor B had 4 levels
# (c)
# Here total observations =16
# Level of factor A = 2 & factor B = 4
# Total number of replicates, K = 16/(2*4) = 2
# (d)
#Model equation for the 2-factor design
#Y_ijk = mu + alpha_i + Beta_j +Alpha*Beta_ij + E_ijk
#Where, mu = grand mean
#alpha_i = effect of factor A
#Beta_j = effect of factor B
#alpha*Beta_ij = 2-way interaction effect of factor A and B
#E_ijk = random error
#Hypotheses for the main and interaction effects are
#for interaction effect, H_0: alpha*Beta_ij= 0
#Alternative hypothesis for interaction effect, H_a: alpha*Beta_ij != 0
#Main effects,
#for effect-A, H_0: alpha_i = 0
#Alternative hypothesis for effect-1, H_a: alpha_i != 0
#for effect-B, H_0: Beta_j = 0
#Alternative hypothesis for effect-2, H_a: Beta_j != 0
#We see that, for an alpha of 0.05, we fail to reject the null hypothesis
#Hence, we conclude that there is no main or interaction effect present in the provided experiment.
#Problem 5.4
feed_rate54 <-c(rep(0.20,12), rep(0.25,12), rep(0.30,12))
D <- c(0.15,0.18,0.20,0.25)
DoC <-c(rep(D,9))
obs54 <-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)
df54 <-data.frame (feed_rate54,obs54,DoC)
df54$feed_rate54 <-as.fixed(df54$feed_rate54)
df54$DoC <- as.fixed(df54$DoC)
str(df54)
# (a)
#Model equation for the 2-factor design
#Y_ijk = mu + alpha_i + Beta_j +Alpha*Beta_ij + E_ijk
#Where, mu = grand mean
#alpha_i = effect of factor 1
#Beta_j = effect of factor 2
#alpha*Beta_ij = 2-way interaction effect of factor 1 and 2
#E_ijk = random error
#Hypotheses for the main and interaction effects are
#for interaction effect, H_0: alpha*Beta_ij= 0
#Alternative hypothesis for interaction effect, H_a: alpha*Beta_ij != 0
#Main effects,
#for effect-1, H_0: alpha_i = 0
#Alternative hypothesis for effect-1, H_a: alpha_i != 0
#for effect-2, H_0: Beta_j = 0
#Alternative hypothesis for effect-2, H_a: Beta_j != 0
model54 <-aov(obs54~feed_rate54+DoC+feed_rate54*DoC, data=df54)
GAD::gad(model54)
# From the ANOVA table we can see that p-value of interaction effect 0.018 < 0.05
# We reject H_0 for interaction effect.
# Lets observe a interaction plot between the two factors to understand the interaction between them
interaction.plot(df54$feed_rate54,df54$DoC,obs54,
xlab = "Feedrate",
ylab = "Surface Finish",
col = c("blue", "red","black","cyan"),
trace.label = "Depth of Cut")
#(b)Residual plots and model’s adequacy.
plot(model54,1:2)
# From the plot we can observe that the residual are normal-ish (two outliers) and show constant variation.
#(c) Point estimates of the mean surface finish at each feed rate
df54 %>% group_by(feed_rate54) %>% summarize(mean_surface_finish = mean(obs54))
# (d) p-value of the test
GAD::gad(model54)
#p-value of interaction =0.01797
#p-value of feed rate = 1.086*10^-9
#p-value of Depth of cut = 1.652*10^-7
#Problem 5.9
drill_speed <- c(rep("125",8), rep("200",8))
f <- c("0.015","0.030","0.045","0.060")
feed_rate <- rep(f,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)
df <- data.frame(drill_speed,feed_rate, obs)
df$drill_speed <- as.fixed(df$drill_speed)
df$feed_rate <- as.fixed(df$feed_rate)
#Model equation for the 2-factor design
#Y_ijk = mu + alpha_i + Beta_j +Alpha*Beta_ij + E_ijk
#Where, mu = grand mean
#alpha_i = effect of factor 1
#Beta_j = effect of factor 2
#alpha*Beta_ij = 2-way interaction effect of factor 1 and 2
#E_ijk = random error
#Hypotheses for the main and interaction effects are
#for interaction effect, H_0: alpha*Beta_ij= 0
#Alternative hypothesis for interaction effect, H_a: alpha*Beta_ij != 0
#Main effects,
#for effect-1, H_0: alpha_i = 0
#Alternative hypothesis for effect-1, H_a: alpha_i != 0
#for effect-2, H_0: Beta_j = 0
#Alternative hypothesis for effect-2, H_a: Beta_j != 0
model59 <- aov(obs~drill_speed+feed_rate+drill_speed*feed_rate, data = df)
summary(model59)
#From the ANOVA table, we see that there is a significant interaction effect ( p < 0.05).
#We reject the null hypothesis that alpha*Beta_ij= 0
#Lets observe the interaction plot between the two factors to understand the interaction between them
interaction.plot(df$feed_rate,df$drill_speed,obs,
xlab = "Feedrate",
ylab = "Thrust Force",
col = c("blue", "red"),trace.label = "Drill Speed")
#From the interaction plot we can see that,
#Feed-rate increases from 0.015 to 0.030, the thrust force shows significant negative correlation for a drill speed of 125.
#Feed-rate from 0.030 to 0.045 an forward, there is a positive correlation for drill speed of 125, also for drill speed of 200 there is slight positive correlation visible.
# For drill speed 200 the change in trust force does not change significantly like drill speed 125, but follows the trend.
#It is quite evident that the interaction between the feed-rate and the drill speed is a significant.
#Problem 5.34
b <-c(rep(1,4),rep(2,4),rep(3,4))
block <- c(rep(b,3))
block <- as.fixed(block)
feed_rate534 <- as.fixed(feed_rate54)
DoC534 <- as.fixed(DoC)
obs534 = obs54
df534 <- data.frame(feed_rate534,DoC534,block,obs534)
str(df534)
model534 <- aov(obs534~feed_rate534+DoC534+block+feed_rate534*DoC534)
summary(model534)
# From the ANOVA Table we get
MS_block=90.3
MS_E=23.1
I=3
J=4
# We know variance component of effect A = (MS_A-MS_E)/JK
#Variance component of Block
var_b=(MS_block-MS_E)/(I*J)
var_b
#Without blocking, p-value for Feed Rate of 3.635∗10−10<0.05 & p-value for Depth of Cut of 4.893∗10−8<0.05
# meaning the Feed Rate & Depth of Cut is significant and we reject H0
#With blocking, p-value for Feed Rate-Depth of Cut Interaction of 0.007258<0.05
# The Interaction effect is significant and we reject H0
#Additionally the p-value for the Block is 0.035322<0.05, shows that the block has a significant effect.
#In conclusion Blocking did not change any of the conclusions of significance from Problem 5.4, so we can say that it was not very useful in this experiment.
#Problem 13.5
pos <- c(rep(1,9),rep(2,9))
t <- c(800,825,850)
temp <- c(rep(t,6))
den <- c(570,1063,565,565,1080,510,
583,1043,590,528,988,526,
547,1026,538,521,1004,532)
df135 <- data.frame(pos,temp,den)
df135$pos <-as.random(df135$pos)
df135$temp <-as.fixed(df135$temp)
model135 <-aov(den~pos+temp+pos*temp,data=df135)
GAD::gad(model135)
#The p-value for Position of 0.0017624<0.05, emplies the Position of furnace have significant effect.
# The p-value for Temperature 0.0008647<0.05. So Temperature does have significant effect.
#The p-value for Position-Temperature Interaction of 0.4271101>0.05. Hence Position-Temperature Interaction is not significant.
#Problem 13.6
part <- c(rep(1,6),rep(2,6),rep(3,6),rep(4,6),rep(5,6),
rep(6,6),rep(7,6),rep(8,6),rep(9,6),rep(10,6))
o <- c("Op1","Op1","Op1","Op2","Op2","Op2")
op <- c(rep(o,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)
df136 <- data.frame(part,op,obs)
df136$part <- as.random(df136$part)
df136$op <- as.fixed(df136$op)
str(df136)
model136 <-aov(obs~part+op+part*op,data=df136)
GAD::gad(model136)
# The p-value for Part Number 3.216∗10−6<0.05, implies the Part Number have a significant effect.
#The p-value for Operator 0.4269>0.05. So Operator does not have a significant effect.
#The p-value for Part Number & Operator Interaction 0..9270>0.05. Hence the Interaction effect is not significant.