Homework 5
Yasir Iqbal
Last compiled on October 25, 2024 at 5:23 PM - CDT
5.2: (a)
Df_total<-15
Df_error<-8
Df_interaction<-3
Df_A<-1
Df_B<-Df_total-Df_error-Df_interaction-Df_A
MSA<-0.0002
SSA<-MSA*Df_A
SSB<-180.378
SSAB<-8.479
SSE<-158.797
MSB<-SSB/Df_B
MSAB<-SSAB/Df_interaction
MSE<-SSE/Df_error
Fa<-MSA/MSE
Fb<-MSB/MSE
Fab<-MSAB/MSE
pf(0.00001007576,1,8, lower.tail = FALSE)## [1] 0.9975451pf(3.0290,3,8, lower.tail = FALSE)## [1] 0.09335136(b):
LevelsofB<-Df_B+1
b<-LevelsofB(c):
LevelsofA<-Df_A+1
a<-LevelsofA
n<-16/(a*b)(d):
Fcritical_interaction=qf(0.9317,3,8)Since F-statistics interaction (0.1424) is lower than F-critical, we fail to reject the Null Hypothesis and conclude that there is no interaction.
Fcritical_A=qf(0.998,1,8)Since the F-statistics (1.01e-5) is less than F-critical, we fail to reject Null hypothesis and the factor A is insignificant.
Fcritical_B=qf(0.093,3,8)Since F-statistics (3.029) is greater than F-critical, we reject Null hypothesis and conclude that Factor B is significant.
5.4 (a):
library(GAD)
FeedRate <- c(rep("0.20",12), rep("0.25",12), rep("0.30",12))
Depth <- c("0.15","0.18","0.20","0.25")
Cut <- c(rep(Depth,9))
Response <- 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(FeedRate, Cut, Response)
Data$FeedRate <- as.fixed(Data$FeedRate)
Data$Cut <- as.fixed(Data$Cut)
Model1 <- aov(Response~FeedRate+Cut+FeedRate*Cut,data = Data)
GAD::gad(Model1)## $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 ***
## Cut 3 2125.11 708.37 24.6628 1.652e-07 ***
## FeedRate:Cut 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 ' ' 1Since all p-values are lower than than \(\alpha=0.05\), so we reject the Null hypothesis and conclude that there is an interaction between the two factors and the also the main effects.
interaction.plot(Data$FeedRate,Data$Cut,Response,col = c("Blue","Red","Green","Purple"))
(b):
library(ggfortify)
library(ggplot2)
autoplot(Model1)
Both the residuals and normal plots, we can see that both normality and constant variance are satisfied.
(c):
library(dplyr)
summarise(group_by(Data,FeedRate),Mean=mean(Response),Variance=var(Response))## # A tibble: 3 × 3
## FeedRate Mean Variance
## <fct> <dbl> <dbl>
## 1 0.20 81.6 206.
## 2 0.25 97.6 64.1
## 3 0.30 104. 36.9(d):
P-values are 0.01797, 1.65e-7 and 1.08e-9 for interaction, depth of cut and feed rate respectively.
5.9 (a):
FeedRate <- rep(seq(1,4),4)
DrillSpeed <- c(rep(1,8),rep(2,8))
ThrustForce <- 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)
dataframe1 <- data.frame(FeedRate,DrillSpeed,ThrustForce)
FeedRate <- as.fixed(FeedRate)
DrillSpeed <- as.fixed(DrillSpeed)
model2 <- aov(ThrustForce~FeedRate+DrillSpeed+FeedRate*DrillSpeed)
GAD::gad(model2)## $anova
## Analysis of Variance Table
##
## Response: ThrustForce
## Df Sum Sq Mean Sq F value Pr(>F)
## FeedRate 3 0.092500 0.030833 11.8590 0.002582 **
## DrillSpeed 1 0.148225 0.148225 57.0096 6.605e-05 ***
## FeedRate:DrillSpeed 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 ' ' 1Since all p-values are less than \(\alpha=0.05\), so we reject \(H_0\) and say that all of the main and interaction effects are significant.
5.34:
FeedRate <- c(rep("0.20",12), rep("0.25",12), rep("0.30",12))
Depth <- c("0.15","0.18","0.20","0.25")
Cut <- c(rep(Depth,9))
Response <- 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)
DepthReplicates <- c(rep("1",4),rep("2",4),rep("3",4))
Block <- c(rep(DepthReplicates,3))
Data2 <- data.frame(FeedRate, Cut,Block, Response)
Data2$Block<-as.fixed(Data2$Block)
Data2$FeedRate <- as.fixed(Data2$FeedRate)
Data2$Cut <- as.fixed(Data2$Cut)
Model3 <- aov(Response~Cut+FeedRate+Block+Cut*FeedRate)
summary(Model3)## Df Sum Sq Mean Sq F value Pr(>F)
## Cut 3 2125.1 708.4 30.637 4.89e-08 ***
## FeedRate 2 3160.5 1580.2 68.346 3.64e-10 ***
## Block 2 180.7 90.3 3.907 0.03532 *
## Cut:FeedRate 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 ' ' 1All p-values are less than \(\alpha=0.05\), so all the main and interaction effects are significant.
Since the SSE of the residuals without blocks is 689.33 which is greater than with blocks 508.7 so we say that the blocking was effective.
13.5:
Model equation
\[ y_{ijk} = \mu +\alpha_i +\beta_j + \alpha \beta_{ij} +\epsilon_{ijk} \]
furnaceposition <- c(rep(1,9),rep(2,9))
temperatures<-c(800,825,850)
firingtemperature <- rep(temperatures,6)
bakeddensity <- c(570,1063,565,565,1080,510,583,1043,590,528,988,526,547,1026,538,521,1004,532)
data.frame(furnaceposition,firingtemperature,bakeddensity)## furnaceposition firingtemperature bakeddensity
## 1 1 800 570
## 2 1 825 1063
## 3 1 850 565
## 4 1 800 565
## 5 1 825 1080
## 6 1 850 510
## 7 1 800 583
## 8 1 825 1043
## 9 1 850 590
## 10 2 800 528
## 11 2 825 988
## 12 2 850 526
## 13 2 800 547
## 14 2 825 1026
## 15 2 850 538
## 16 2 800 521
## 17 2 825 1004
## 18 2 850 532library(GAD)
furnaceposition <- as.random(furnaceposition)
firingtemperature <- as.fixed(firingtemperature)
Model <- aov(bakeddensity~furnaceposition+firingtemperature+furnaceposition*firingtemperature)
GAD::gad(Model)## $anova
## Analysis of Variance Table
##
## Response: bakeddensity
## Df Sum Sq Mean Sq F value Pr(>F)
## furnaceposition 1 7160 7160 15.998 0.0017624 **
## firingtemperature 2 945342 472671 1155.518 0.0008647 ***
## furnaceposition:firingtemperature 2 818 409 0.914 0.4271101
## Residuals 12 5371 448
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1The p-value of interaction is greater than \(\alpha\), so their is no interaction and for the main effects the p-value is less than \(\alpha\) so there is significance.
13.6:
PartNo <- 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))
Measurements <- c("1","1","1","2","2","2")
Operators <- c(rep(Measurements, 10))
Resp <- 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(PartNo, Operators, Resp)
Data$PartNo <- as.random(Data$PartNo)
Data$Operators <- as.fixed(Data$Operators)
str(Data)## 'data.frame': 60 obs. of 3 variables:
## $ PartNo : Factor w/ 10 levels "1","2","3","4",..: 1 1 1 1 1 1 2 2 2 2 ...
## $ Operators: Factor w/ 2 levels "1","2": 1 1 1 2 2 2 1 1 1 2 ...
## $ Resp : num 50 49 50 50 48 51 52 52 51 51 ...Model4<- aov(Resp~PartNo+Operators+PartNo*Operators,data = Data)
GAD::gad(Model4)## $anova
## Analysis of Variance Table
##
## Response: Resp
## Df Sum Sq Mean Sq F value Pr(>F)
## PartNo 9 99.017 11.0019 7.3346 3.216e-06 ***
## Operators 1 0.417 0.4167 0.6923 0.4269
## PartNo: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 ' ' 1Both the p-values of interaction and operators is greater than \(\alpha\), so their is no significance and for part number the p-value is less than that so it is significant.