1 Question 5.4:

1.1 Solution:

PART A:

To analyze the data and draw conclusions we first state the model equation and then perform hypothesis testing.

Linear Effects Model Equation:

\[ y_{i,j}=\mu+\alpha_{i}+\beta_{j}+\alpha\beta_{ij}+\epsilon_{ijk} \]

\(\alpha_{i}\)= the main effect of the ith treatment of Feed Rate

\(\beta_{j}\)= the main effect of the jth treatment of Depth of Cut

\(\alpha\beta_{ij}\)= the interaction effect of the ijth treatment of Feed Rate * Depth of Cut

\(\epsilon_{ijk}\)= Random Error Term

Hypothesis:

We perform the Hypothesis testing backwards:

Hypothesis for 2-Factor Interaction:

Null:\[H_O:(\alpha\beta)_{ij}=0 \space\space\forall\space\space"i,j"\]

Alternate:\[Ha:(\alpha\beta)_{ij}\neq0\space\space\exists\space\space"i,j"\]

Hypothesis for Main Effects:

Null:\[\alpha_{i}=0\space\forall\space"i"\]

\[\beta_{j}=0\space\forall\space"j"\]

Alternative:

\[\alpha_{i}\neq0\space\exists\space"i"\] \[\beta_{j}\neq0\space\exists\space"j"\]

Reading the Data:

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)
str(Data)
## 'data.frame':    36 obs. of  3 variables:
##  $ FeedRate: chr  "0.20" "0.20" "0.20" "0.20" ...
##  $ Cut     : chr  "0.15" "0.18" "0.20" "0.25" ...
##  $ Response: num  74 79 82 99 64 68 88 104 60 73 ...
print(Data)
##    FeedRate  Cut Response
## 1      0.20 0.15       74
## 2      0.20 0.18       79
## 3      0.20 0.20       82
## 4      0.20 0.25       99
## 5      0.20 0.15       64
## 6      0.20 0.18       68
## 7      0.20 0.20       88
## 8      0.20 0.25      104
## 9      0.20 0.15       60
## 10     0.20 0.18       73
## 11     0.20 0.20       92
## 12     0.20 0.25       96
## 13     0.25 0.15       92
## 14     0.25 0.18       98
## 15     0.25 0.20       99
## 16     0.25 0.25      104
## 17     0.25 0.15       86
## 18     0.25 0.18      104
## 19     0.25 0.20      108
## 20     0.25 0.25      110
## 21     0.25 0.15       88
## 22     0.25 0.18       88
## 23     0.25 0.20       95
## 24     0.25 0.25       99
## 25     0.30 0.15       99
## 26     0.30 0.18      104
## 27     0.30 0.20      108
## 28     0.30 0.25      114
## 29     0.30 0.15       98
## 30     0.30 0.18       99
## 31     0.30 0.20      110
## 32     0.30 0.25      111
## 33     0.30 0.15      102
## 34     0.30 0.18       95
## 35     0.30 0.20       99
## 36     0.30 0.25      107

Analysis:

library(GAD)
Data$FeedRate <- as.fixed(Data$FeedRate)
Data$Cut <- as.fixed(Data$Cut)
str(Data)
## 'data.frame':    36 obs. of  3 variables:
##  $ FeedRate: Factor w/ 3 levels "0.20","0.25",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ Cut     : Factor w/ 4 levels "0.15","0.18",..: 1 2 3 4 1 2 3 4 1 2 ...
##  $ Response: num  74 79 82 99 64 68 88 104 60 73 ...
Model <- aov(Response~FeedRate+Cut+FeedRate*Cut,data = Data)
GAD::gad(Model)
## 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 *  
## Residual     24  689.33   28.72                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
--> The interaction p value = 0.01797 < alpha = 0.05, we reject the null hypothesis and claim that there is an interaction between the two factors of feed rate and depth of cut. Also the main effects are also significant because their p-values (feed rate is 1.086e-06) & (depth of cut is 1.652e-07) both < 0.05. We know that whenever interaction is significant the corresponding main effects have little practical meaning

To analyze the interaction graphically we plot interaction plot:

interaction.plot(Data$FeedRate,Data$Cut,Response,col = c("Blue","Red","Green","Purple"))

PART B:

Plot Residuals:

library(ggfortify)
library(ggplot2)
autoplot(Model)

--> From “Normal Q-Q” and “Residuals vs Factor Levels” plots, we can see that they satisfy the assumptions of normality and constant variance. Model can be considered adequate.

PART C:

Point estimates of the mean surface finish at each feed rate. (Point estimates are mean and variance)

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
--> Point estimates of mean surface finish at each feedrate alongwith the variance values have been calculated above

PART D:

P-value of Depth of Cut & Feedrate Interaction: 0.01797

P-value of Depth of Cut : 1.652e-07

P-value of Feedrate : 1.086e-09

2 Question 5.34:

2.1 Solution:

Linear Effects Model Equation:

\[ y_{i,j}=\mu+\alpha_{i}+\beta_{j}+\alpha\beta_{ij}+\epsilon_{ijk} \]

\(\alpha_{i}\)= the main effect of the ith treatment of Feed Rate

\(\beta_{j}\)= the main effect of the jth treatment of Depth of Cut

\(\alpha\beta_{ij}\)= the interaction effect of the ijth treatment of Feed Rate * Depth of Cut

\(\epsilon_{ijk}\)= Random Error Term

Hypothesis for 2-Factor Interaction:

Null:\[H_O:(\alpha\beta)_{ij}=0 \space\space\forall\space\space"i,j"\]

Alternate:\[Ha:(\alpha\beta)_{ij}\neq0\space\space\exists\space\space"i,j"\]

Hypothesis for Main Effects:

Null:\[\alpha_{i}=0\space\forall\space"i"\]

\[\beta_{j}=0\space\forall\space"j"\]

Alternative:

\[\alpha_{i}\neq0\space\exists\space"i"\] \[\beta_{j}\neq0\space\exists\space"j"\]

Reading the Data:

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)
str(Data2)
## 'data.frame':    36 obs. of  4 variables:
##  $ FeedRate: Factor w/ 3 levels "0.20","0.25",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ Cut     : 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 ...
##  $ Response: num  74 79 82 99 64 68 88 104 60 73 ...
print(Data2)
##    FeedRate  Cut Block Response
## 1      0.20 0.15     1       74
## 2      0.20 0.18     1       79
## 3      0.20 0.20     1       82
## 4      0.20 0.25     1       99
## 5      0.20 0.15     2       64
## 6      0.20 0.18     2       68
## 7      0.20 0.20     2       88
## 8      0.20 0.25     2      104
## 9      0.20 0.15     3       60
## 10     0.20 0.18     3       73
## 11     0.20 0.20     3       92
## 12     0.20 0.25     3       96
## 13     0.25 0.15     1       92
## 14     0.25 0.18     1       98
## 15     0.25 0.20     1       99
## 16     0.25 0.25     1      104
## 17     0.25 0.15     2       86
## 18     0.25 0.18     2      104
## 19     0.25 0.20     2      108
## 20     0.25 0.25     2      110
## 21     0.25 0.15     3       88
## 22     0.25 0.18     3       88
## 23     0.25 0.20     3       95
## 24     0.25 0.25     3       99
## 25     0.30 0.15     1       99
## 26     0.30 0.18     1      104
## 27     0.30 0.20     1      108
## 28     0.30 0.25     1      114
## 29     0.30 0.15     2       98
## 30     0.30 0.18     2       99
## 31     0.30 0.20     2      110
## 32     0.30 0.25     2      111
## 33     0.30 0.15     3      102
## 34     0.30 0.18     3       95
## 35     0.30 0.20     3       99
## 36     0.30 0.25     3      107
--> Above table shows that experiment had been conducted in three blocks, with each replicate a block. 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.

Analysis:

Model2 <- aov(Response~Cut+FeedRate+Block+Cut*FeedRate)
summary(Model2)
##              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 ' ' 1
--> The p value of depth and feed interaction is 0.00726 , which is less than 0.05 , which implies that there is interaction between both factors. P value of feed is 3.64e-10 and P value of depth of cut is 4.89e-08 which are less than 0.05 therefore it implies both feed rate and depth of cut has significant effect on the model

Variance Component of the Block:

From the model results above:

MSB<-90.3
MSE<-23.1
I=3
J=4
VAR<-(MSB-MSE)/(I*J)
print(VAR)
## [1] 5.6
--> Variance component of block is 5.6 --> p value of block is 0.03532 , which is less than 0.05.Also The Sum of squared error without adding block was 689.33 and the SSE with block is 508.7. In both the cases, we rejected the Null Hypothesis (with or w/o blocking) and conclude that the blocking was effective as it has significant effect on our model and it also decreased the SSE Value.

3 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.

3.1 Solution:

Model Equation:\[ y_{i,j,k}=\mu+\alpha_{i}+\beta_{j}+\alpha\beta_{ij}+\epsilon_{ijk} \]

Hypothesis for Interaction:

Null:\[H_O:(\alpha\beta)_{ij}=0 \space\space\forall\space\space"i,j"\]

Alternate:\[Ha:(\alpha\beta)_{ij}\neq0\space\space\exists\space\space"i,j"\]

Hypothesis for Main Effects:

Null:\[\alpha_{i}=0\space\forall\space"i"\]

\[\beta_{j}=0\space\forall\space"j"\]

Alternative:

\[\alpha_{i}\neq0\space\exists\space"i"\] \[\beta_{j}\neq0\space\exists\space"j"\]

Reading the Data:

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          532

Analysis:

furnaceposition <- as.random(furnaceposition)
firingtemperature <- as.fixed(firingtemperature)
Model <- aov(bakeddensity~furnaceposition+firingtemperature+furnaceposition*firingtemperature)
GAD::gad(Model)
## 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    
## Residual                          12   5371     448                       
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
--> <The interaction p value is 0.427 > 0.05 , which implies that there is no interaction present between two factor. The p value of Furnaceposition is 0.0017624 and for Firing temperature is 0.0008647 , both are less than 0.05 , which implies both factors have significant effect on our model

4 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.

4.1 Solution:

Model Equation:\[ y_{i,j,k}=\mu+\alpha_{i}+\beta_{j}+\alpha\beta_{ij}+\epsilon_{ijk} \]

Hypothesis for Interaction:

Null:\[H_O:(\sigma^2)_{\alpha\beta}=0\]

Alternate:\[Ha:(\sigma^2)_{\alpha\beta}\neq0\]

Hypothesis for Main Effects:

Null:\[\sigma^2_{\alpha}=0\]

\[\beta_{j}=0\space\forall\space"j"\]

Alternative:

\[\sigma^2_{\alpha}\neq0\] \[\beta_{j}\neq0\space\exists\space"j"\]

Reading the Data:

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)

Analysis:

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 ...
Model13.6<- aov(Resp~PartNo+Operators+PartNo*Operators,data = Data)
GAD::gad(Model13.6)
## 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    
## Residual         40 60.000  1.5000                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
--> The interaction p value = 0.9270 > alpha = 0.05, we fail to reject the null hypothesis and claim that there is no interaction between the two factors. And for Operators, p = 0.4269 > 0.05, it does not have an effect. And also, for PartNo, p = 3.216e-06 < 0.05, therefor it has an effect.

5 Source Code:

#Question 5.4:::
#Reading the Data
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)
str(Data)

#PARTA
library(GAD)
Data$FeedRate <- as.fixed(Data$FeedRate)
Data$Cut <- as.fixed(Data$Cut)
str(Data)
Model <- aov(Response~FeedRate+Cut+FeedRate*Cut,data = Data)
GAD::gad(Model)

#OR We can simply use (Here we do not mention data=Data in AOV Model equation)
Feed <- c(rep(1,12), rep(2,12), rep(3,12))
Depth <- rep(seq(1,4),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)
Feed <- as.fixed(Feed)
Depth <- as.fixed(Depth)
Model2 <- aov(Response~Depth+Feed+Depth*Feed)
GAD::gad(Model2)

interaction.plot(Data$FeedRate,Data$Cut,Response,col = c("Blue","Red","Green","Purple"))

library(ggfortify)
library(ggplot2)
autoplot(Model)

?summarise()
library(dplyr)
summarise(group_by(Data,FeedRate),Mean=mean(Response),Variance=var(Response))

#Question5.34:::
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)
str(Data2)
print(Data2)

Model2 <- aov(Response~Cut+FeedRate+Block+Cut*FeedRate)
summary(Model2)

MSB<-90.3
MSE<-23.1
I=3
J=4
VAR<-(MSB-MSE)/(I*J)
print(VAR)

#Question 13.5:
#Reading the data
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)
#Analysis
furnaceposition <- as.random(furnaceposition)
firingtemperature <- as.fixed(firingtemperature)
Model <- aov(bakeddensity~furnaceposition+firingtemperature+furnaceposition*firingtemperature)
GAD::gad(Model)

#Question 13.6:
#Reading the Data:
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)
#Analysis:
Data <- data.frame(PartNo, Operators, Resp)
Data$PartNo <- as.random(Data$PartNo)
Data$Operators <- as.fixed(Data$Operators)
str(Data)

Model13.6 <- aov(Resp~PartNo+Operators+PartNo*Operators,data = Data)
GAD::gad(Model13.6)