HW10
Imtiaz, Jahir
2022-11-03
Answer to question no-5.4
Reading in the data and appropriate libraries:
library(GAD)## Warning: package 'GAD' was built under R version 4.1.3## Loading required package: matrixStats## Warning: package 'matrixStats' was built under R version 4.1.3## Loading required package: R.methodsS3## Warning: package 'R.methodsS3' was built under R version 4.1.3## R.methodsS3 v1.8.2 (2022-06-13 22:00:14 UTC) successfully loaded. See ?R.methodsS3 for help.feedrate <- c(rep(1,12), rep(2,12), rep(3,12))
doc <- rep(seq(1,4),9)
data <- 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)
feedrate <- as.fixed(feedrate)
doc <- as.fixed(doc)Part-a
The model equation is given as follows:
Yijk = u = ai +Bj +aBij+eijk
Where, u = grand mean
ai = effect of factor 1 (feedrate)
Bj = effect of factor 2 (depth of cut)
aBij = interaction between factor 1 and 2
eijk = random error
Hypothesis testing for factor 1:
Ho: ai = 0
Ha: ai ≠ 0
Hypothesis testing for factor 2:
Ho: Bj= 0
Ha: Bj ≠ 0
Hypothesis testing for interaction effect:
Ho: aBij = 0
Ha: aBij ≠ 0
ANOVA test:
anova1 <- aov(data~feedrate+doc+feedrate*doc)
gad(anova1)## Analysis of Variance Table
##
## Response: data
## Df Sum Sq Mean Sq F value Pr(>F)
## feedrate 2 3160.50 1580.25 55.0184 1.086e-09 ***
## doc 3 2125.11 708.37 24.6628 1.652e-07 ***
## feedrate:doc 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 ' ' 1From the reports of ANOVA, we see that the individual factors (feedrates and depth of cut) and the interaction effect have significant p-values < critical p-value = 0.05. Hence, we reject the null hypothesis. Hence, the main and interaction effects have significant effect.
Part-b
plot(anova1)
From the residual plot of the models we see that although the residuals show fairly normal tendency, the variance are not the same. ANOVA is not robust against the violation of constant variance. Hence the model is inadequate.
Part-c
The point estimates of the mean surface finish at each feedrate are as follows:
(point.estimate1 <- mean(data[1:12]))## [1] 81.58333(point.estimate2 <- mean(data[13:24]))## [1] 97.58333(point.estimate3 <- mean(data[25:36]))## [1] 103.8333Part-d
The p-values are given as follows:
Factor-1 (Feedrate) = 1.086e-09
Factor-2 (Depth of Cut) = 1.652e-07
Interaction = 0.01797
Answer to question no-5.34
Creating blocks on top of data already available from 5.13:
blocks <- c(rep(1,4), rep(2,4), rep(3,4), rep(1,4), rep(2,4), rep(3,4), rep(1,4),
rep(2,4), rep(3,4))
blocks <- as.fixed(blocks)The new model equation due to additon of the block is:
Yijkl = u = ai +Bj +aBij+yk+ eijkl
Where, yk = block
we run ANOVA on this:
anova2 <- aov(data~feedrate+doc+feedrate*doc+blocks)
gad(anova2)## Analysis of Variance Table
##
## Response: data
## Df Sum Sq Mean Sq F value Pr(>F)
## feedrate 2 3160.50 1580.25 68.3463 3.635e-10 ***
## doc 3 2125.11 708.37 30.6373 4.893e-08 ***
## blocks 2 180.67 90.33 3.9069 0.035322 *
## feedrate:doc 6 557.06 92.84 4.0155 0.007258 **
## Residual 22 508.67 23.12
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1We see that due to the blocking, the p-value of the interaction effect is further reduced from 0.017 to 0.007 (almost an order of magnitude). Hence we have a stronger evidence that the interaction effect is significant. Hence, blocking has an impact on the interaction term.
Although it reduced the p-value of the main effects by orders of magnitudes as well, they were already very small without the blocking. The strongest influence of blocking is seen thus in the interaction term.
The variance component for the block are SSE = 180.67, MSE = 90.33
Answer to question no-13.5
Reading in the data:
temperature <- rep(seq(1,3), 6)
pos <- c(rep(1,9), rep(2,9))
temperature <- as.fixed(temperature)
pos <- as.random(pos)
density <- c(570, 1063, 565,
565, 1080, 510,
583, 1043, 590,
528, 988, 526,
547, 1026, 538,
521, 1004, 532)Without the interaction parameter (as mentioned in the original question 5.13), and position as random effect the mixed model hypothesis are:
Fixed Factor-1 (temperature)
Ho: ai = 0
Ha: ai ≠ 0
Random Factor-2 (position)
Ho: σB^2 = 0
Ha: σB^2 ≠ 0
ANOVA results:
anova4 <- aov(density~temperature+pos)
gad(anova4)## Analysis of Variance Table
##
## Response: density
## Df Sum Sq Mean Sq F value Pr(>F)
## temperature 2 945342 472671 1069.257 4.924e-16 ***
## pos 1 7160 7160 16.197 0.001254 **
## Residual 14 6189 442
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1From the results it is seen that both the factors (fixed and random) are significant with p-value < critical p-values of 0.05.
Answer to question no-13.5
Data input:
x <- 1:10
parts <- rep(x, each = 6)
parts <- as.random(parts)
operators <- rep(c(rep("operator1", 3), rep("operator2", 3)),10)
operators <- as.fixed(operators)
measurements <- 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)As per the problems (13.1-original problem, 13.6-assigned problem), we are assuming the parts as Random factors and operators as fixed factors. Hence this becomes a mixed effect problem.
The results of ANOVA with the interaction effect are shown as follows:
anova3 <- aov(measurements~operators+parts+parts*operators)
gad(anova3)## Analysis of Variance Table
##
## Response: measurements
## Df Sum Sq Mean Sq F value Pr(>F)
## operators 1 0.417 0.4167 0.6923 0.4269
## parts 9 99.017 11.0019 7.3346 3.216e-06 ***
## operators:parts 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 ' ' 1anova3_1 <- aov(measurements~operators+parts)
gad(anova3_1)## Analysis of Variance Table
##
## Response: measurements
## Df Sum Sq Mean Sq F value Pr(>F)
## operators 1 0.417 0.4167 0.3121 0.5789
## parts 9 99.017 11.0019 8.2409 2.458e-07 ***
## Residual 49 65.417 1.3350
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1From our first run, we see that only the parts (random effect) has significant p-value < 0.05. Operator factor does not seem to effect since it has p-value . 0.05. Also, the interaction term does not show significant effect.
So, we drop the interaction term and re-run the experiment. Still the operator factor (fixed) is not significant and the parts (random effect) is significant. The conclusion does not change for the main effects due to the dropping of the interaction term.
Complete Code Chunk:
#Problem 5.4
library(GAD)
feedrate <- c(rep(1,12), rep(2,12), rep(3,12))
doc <- rep(seq(1,4),9)
feedrate
doc
data <- 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)
feedrate <- as.fixed(feedrate)
doc <- as.fixed(doc)
anova1 <- aov(data~feedrate+doc+feedrate*doc)
summary(anova1)
gad(anova1)
plot(anova1)
point.estimate1 <- mean(data[1:12])
point.estimate2 <- mean(data[13:24])
point.estimate3 <- mean(data[25:36])
#Problem 5.34
blocks <- c(rep(1,4), rep(2,4), rep(3,4), rep(1,4), rep(2,4), rep(3,4), rep(1,4),
rep(2,4), rep(3,4))
blocks <- as.fixed(blocks)
feedrate
doc
blocks
anova2 <- aov(data~feedrate+doc+feedrate*doc+blocks)
gad(anova2)
plot(anova2)
#Problem 13.6
x <- 1:10
parts <- rep(x, each = 6)
parts <- as.random(parts)
operators <- rep(c(rep("operator1", 3), rep("operator2", 3)),10)
operators <- as.fixed(operators)
measurements <- 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)
anova3 <- aov(measurements~operators+parts+parts*operators)
gad(anova3)
#Problem 13.5
temperature <- rep(seq(1,3), 6)
pos <- c(rep(1,9), rep(2,9))
temperature <- as.fixed(temperature)
pos <- as.random(pos)
density <- c(570, 1063, 565,
565, 1080, 510,
583, 1043, 590,
528, 988, 526,
547, 1026, 538,
521, 1004, 532)
anova4 <- aov(density~temperature+pos)
gad(anova4)