Homework_Module5
Juan Carlos Soto
2024-10-25
Problem 5.2 - Part(a)
# Load necessary library
library(GAD)
# Hypothetical response values based on the structure of the problem
response <- c(1.2, 1.4, 1.3, 1.5, 2.2, 2.4, 2.3, 2.5) # Replace with actual data
# Create factors for A and B
factor_A <- factor(rep(c("A1", "A2"), each = 4)) # 2 levels for factor A
factor_B <- factor(rep(c("B1", "B2", "B3", "B4"), times = 2)) # 4 levels for factor B
# Convert factors A and B to fixed factors
factor_A <- as.fixed(factor_A)
factor_B <- as.fixed(factor_B)
# Create the data frame
df <- data.frame(response, factor_A, factor_B)
# Fit a linear model using lm()
model <- lm(response ~ factor_A * factor_B, data = df)
# Run the ANOVA using GAD
anova_table <- gad(model)
anova_table## $anova
## Analysis of Variance Table
##
## Response: response
## Df Sum Sq Mean Sq F value Pr(>F)
## factor_A 1 2.0 2.00000 NaN NaN
## factor_B 3 0.1 0.03333 NaN NaN
## factor_A:factor_B 3 0.0 0.00000 NaN NaN
## Residuals 0 0.0 NaNProblem 5.2 - Part(b)
# Calculate the number of levels for factor B
levels_B <- length(levels(factor_B))
print(paste("The number of levels for factor B is:", levels_B))## [1] "The number of levels for factor B is: 4"Problem 5.2 - Part(c)
# Calculate the number of replicates
replicates <- length(response) / (length(levels(factor_A)) * length(levels(factor_B)))
print(paste("The number of replicates is:", replicates))## [1] "The number of replicates is: 1"Problem 5.2 - Part (d)
# Display the summary of the model (ANOVA table)
summary(model)##
## Call:
## lm(formula = response ~ factor_A * factor_B, data = df)
##
## Residuals:
## ALL 8 residuals are 0: no residual degrees of freedom!
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.200e+00 NaN NaN NaN
## factor_AA2 1.000e+00 NaN NaN NaN
## factor_BB2 2.000e-01 NaN NaN NaN
## factor_BB3 1.000e-01 NaN NaN NaN
## factor_BB4 3.000e-01 NaN NaN NaN
## factor_AA2:factor_BB2 -7.466e-17 NaN NaN NaN
## factor_AA2:factor_BB3 -2.162e-16 NaN NaN NaN
## factor_AA2:factor_BB4 -1.496e-16 NaN NaN NaN
##
## Residual standard error: NaN on 0 degrees of freedom
## Multiple R-squared: 1, Adjusted R-squared: NaN
## F-statistic: NaN on 7 and 0 DF, p-value: NA# Interpretation:
# Look at the P-values from the summary(model). If any of the factors or interactions have a P-value less than 0.05,
# they are considered statistically significant. Otherwise, they are not significant.Problem 5.4 - part(a)
(a) Analyze the data and draw conclusions using α = 0.05
# Load necessary library
library(GAD)
# Input data
feed_rate <- factor(rep(c(0.20, 0.25, 0.30), each = 4)) # 3 levels of feed rate
depth_cut <- factor(rep(c(0.15, 0.18, 0.20, 0.25), times = 3)) # 4 levels of depth cut
# Surface finish data (replace with actual values)
surface_finish <- 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)
# Create the data frame
df <- data.frame(feed_rate, depth_cut, surface_finish)
# Convert feed_rate and depth_cut to fixed factors
df$feed_rate <- as.fixed(df$feed_rate)
df$depth_cut <- as.fixed(df$depth_cut)
# Fit the linear model using lm()
model <- lm(surface_finish ~ feed_rate * depth_cut, data = df)
# Run the ANOVA using GAD
anova_table <- gad(model)
anova_table## $anova
## Analysis of Variance Table
##
## Response: surface_finish
## Df Sum Sq Mean Sq F value Pr(>F)
## feed_rate 2 180.7 90.33 0.5320 0.5942
## depth_cut 3 2125.1 708.37 4.1717 0.0164 *
## feed_rate:depth_cut 6 150.9 25.15 0.1481 0.9877
## Residuals 24 4075.3 169.81
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Summary of the model to see significance (P-values)
summary(model)##
## Call:
## lm(formula = surface_finish ~ feed_rate * depth_cut, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -23.333 -5.167 2.667 8.083 18.667
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.833e+01 7.523e+00 11.741 1.96e-11 ***
## feed_rate0.25 -5.667e+00 1.064e+01 -0.533 0.599
## feed_rate0.3 -5.000e+00 1.064e+01 -0.470 0.643
## depth_cut0.18 5.333e+00 1.064e+01 0.501 0.621
## depth_cut0.2 8.000e+00 1.064e+01 0.752 0.459
## depth_cut0.25 1.733e+01 1.064e+01 1.629 0.116
## feed_rate0.25:depth_cut0.18 2.333e+00 1.505e+01 0.155 0.878
## feed_rate0.3:depth_cut0.18 -3.333e+00 1.505e+01 -0.222 0.827
## feed_rate0.25:depth_cut0.2 1.133e+01 1.505e+01 0.753 0.459
## feed_rate0.3:depth_cut0.2 4.000e+00 1.505e+01 0.266 0.793
## feed_rate0.25:depth_cut0.25 8.333e+00 1.505e+01 0.554 0.585
## feed_rate0.3:depth_cut0.25 -1.026e-14 1.505e+01 0.000 1.000
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 13.03 on 24 degrees of freedom
## Multiple R-squared: 0.3761, Adjusted R-squared: 0.09014
## F-statistic: 1.315 on 11 and 24 DF, p-value: 0.27545.4 - part(b)
# Residual plots for the linear model
par(mfrow = c(2, 2)) # Set up a 2x2 plot layout
plot(model)
# Interpretation:
# 1. Check if residuals follow a normal distribution (Q-Q plot).
# 2. Check for homoscedasticity (residuals vs. fitted values should show no pattern).
# 3. Look for any outliers or influential points in the residuals.5.4 - Part(c)
# Calculate mean surface finish at each feed rate
means_feed_rate <- aggregate(surface_finish ~ feed_rate, data = df, mean)
means_feed_rate## feed_rate surface_finish
## 1 0.2 96.00000
## 2 0.25 95.83333
## 3 0.3 91.16667# Display the means for each level of feed rate
print(means_feed_rate)## feed_rate surface_finish
## 1 0.2 96.00000
## 2 0.25 95.83333
## 3 0.3 91.166675.4 - part(d)
# Summary of the linear model
model_summary <- summary(model)
# Extract the P-values for feed rate, depth cut, and interaction
p_values <- model_summary$coefficients[, 4]
print(p_values)## (Intercept) feed_rate0.25
## 1.960472e-11 5.992108e-01
## feed_rate0.3 depth_cut0.18
## 6.426421e-01 6.207507e-01
## depth_cut0.2 depth_cut0.25
## 4.594225e-01 1.163458e-01
## feed_rate0.25:depth_cut0.18 feed_rate0.3:depth_cut0.18
## 8.780619e-01 8.265535e-01
## feed_rate0.25:depth_cut0.2 feed_rate0.3:depth_cut0.2
## 4.586531e-01 7.926354e-01
## feed_rate0.25:depth_cut0.25 feed_rate0.3:depth_cut0.25
## 5.848215e-01 1.000000e+00Problem 5.9
# Load necessary library
library(GAD)
# Input data for thrust force based on drill speed and feed rate
drill_speed <- factor(rep(c(125, 200), each = 4)) # 2 levels of drill speed
feed_rate <- factor(rep(c(0.015, 0.030, 0.045, 0.060), times = 2)) # 4 levels of feed rate
# Thrust force data (from the table in the problem)
thrust_force <- 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)
# Create the data frame
df <- data.frame(drill_speed, feed_rate, thrust_force)
# Convert drill_speed and feed_rate to fixed factors
df$drill_speed <- as.fixed(df$drill_speed)
df$feed_rate <- as.fixed(df$feed_rate)
# Fit a linear model using lm() with interaction between drill speed and feed rate
model <- lm(thrust_force ~ drill_speed * feed_rate, data = df)
# Run the ANOVA using GAD
anova_table <- gad(model)
anova_table## $anova
## Analysis of Variance Table
##
## Response: thrust_force
## Df Sum Sq Mean Sq F value Pr(>F)
## drill_speed 1 0.0049 0.004900 0.1931 0.6720
## feed_rate 3 0.0925 0.030833 1.2151 0.3652
## drill_speed:feed_rate 3 0.0030 0.001000 0.0394 0.9888
## Residuals 8 0.2030 0.025375# Summary of the model to see significance (P-values)
summary(model)##
## Call:
## lm(formula = thrust_force ~ drill_speed * feed_rate, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.20 -0.08 0.00 0.08 0.20
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.7650 0.1126 24.547 8.1e-09 ***
## drill_speed200 0.0550 0.1593 0.345 0.739
## feed_rate0.03 -0.1150 0.1593 -0.722 0.491
## feed_rate0.045 -0.0350 0.1593 -0.220 0.832
## feed_rate0.06 0.0800 0.1593 0.502 0.629
## drill_speed200:feed_rate0.03 -0.0600 0.2253 -0.266 0.797
## drill_speed200:feed_rate0.045 0.0100 0.2253 0.044 0.966
## drill_speed200:feed_rate0.06 -0.0300 0.2253 -0.133 0.897
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1593 on 8 degrees of freedom
## Multiple R-squared: 0.3309, Adjusted R-squared: -0.2545
## F-statistic: 0.5652 on 7 and 8 DF, p-value: 0.7667# Residual plots to check model adequacy
par(mfrow = c(2, 2)) # Set up a 2x2 plot layout
plot(model)
# Interaction plot between drill speed and feed rate
interaction.plot(df$drill_speed, df$feed_rate, df$thrust_force)
## Problem 5.34
# Load necessary library
library(GAD)
# Input data
feed_rate <- factor(rep(c(0.20, 0.25, 0.30), each = 4)) # 3 levels of feed rate
depth_cut <- factor(rep(c(0.15, 0.18, 0.20, 0.25), times = 3)) # 4 levels of depth cut
# Surface finish data (same as in Problem 5.4)
surface_finish <- 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)
# Create blocks factor (3 blocks for replicates)
blocks <- factor(rep(1:3, each = 12)) # 3 blocks for the experiment
# Create the data frame
df <- data.frame(feed_rate, depth_cut, surface_finish, blocks)
# Convert feed_rate, depth_cut, and blocks to factors
df$feed_rate <- as.fixed(df$feed_rate)
df$depth_cut <- as.fixed(df$depth_cut)
df$blocks <- as.random(df$blocks) # Blocks treated as random
# Fit the linear model using lm() with blocking
model <- lm(surface_finish ~ feed_rate * depth_cut + blocks, data = df)
# Run the ANOVA using GAD
anova_table <- gad(model)
anova_table## $anova
## Analysis of Variance Table
##
## Response: surface_finish
## Df Sum Sq Mean Sq F value Pr(>F)
## feed_rate 2 180.67 90.33 2.1723 0.1377
## depth_cut 3 2125.11 708.37 17.0350 6.034e-06 ***
## blocks 2 3160.50 1580.25 38.0020 7.294e-08 ***
## feed_rate:depth_cut 6 150.89 25.15 0.6048 0.7237
## Residuals 22 914.83 41.58
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Summary of the model to see significance (P-values)
summary(model)##
## Call:
## lm(formula = surface_finish ~ feed_rate * depth_cut + blocks,
## data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10.5833 -2.2292 -0.5833 1.6042 10.4167
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.558e+01 4.021e+00 18.795 4.86e-15 ***
## feed_rate0.25 -5.667e+00 5.265e+00 -1.076 0.29348
## feed_rate0.3 -5.000e+00 5.265e+00 -0.950 0.35261
## depth_cut0.18 5.333e+00 5.265e+00 1.013 0.32210
## depth_cut0.2 8.000e+00 5.265e+00 1.519 0.14290
## depth_cut0.25 1.733e+01 5.265e+00 3.292 0.00332 **
## blocks2 1.600e+01 2.633e+00 6.078 4.07e-06 ***
## blocks3 2.225e+01 2.633e+00 8.452 2.34e-08 ***
## feed_rate0.25:depth_cut0.18 2.333e+00 7.446e+00 0.313 0.75696
## feed_rate0.3:depth_cut0.18 -3.333e+00 7.446e+00 -0.448 0.65877
## feed_rate0.25:depth_cut0.2 1.133e+01 7.446e+00 1.522 0.14224
## feed_rate0.3:depth_cut0.2 4.000e+00 7.446e+00 0.537 0.59653
## feed_rate0.25:depth_cut0.25 8.333e+00 7.446e+00 1.119 0.27515
## feed_rate0.3:depth_cut0.25 2.590e-14 7.446e+00 0.000 1.00000
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.449 on 22 degrees of freedom
## Multiple R-squared: 0.8599, Adjusted R-squared: 0.7772
## F-statistic: 10.39 on 13 and 22 DF, p-value: 1.426e-06# Residual plots to check model adequacy
par(mfrow = c(2, 2)) # Set up a 2x2 plot layout
plot(model)
Problem 13.5
# Load necessary library
library(DoE.base)## Loading required package: grid## Loading required package: conf.design## Registered S3 method overwritten by 'DoE.base':
## method from
## factorize.factor conf.design##
## Attaching package: 'DoE.base'## The following objects are masked from 'package:stats':
##
## aov, lm## The following object is masked from 'package:graphics':
##
## plot.design## The following object is masked from 'package:base':
##
## lengths# Input data from Problem 5.13, treating furnace positions as a fixed factor
# Levels: A (temperature), B (pressure), C (furnace positions)
# Define levels for temperature (-1 for low, 1 for high)
A <- c(-1, 1, -1, 1, -1, 1, -1, 1)
# Define levels for pressure (-1 for low, 1 for high)
B <- c(-1, -1, 1, 1, -1, -1, 1, 1)
# Define levels for furnace positions (-1 and 1 representing two random furnace positions)
C <- c(-1, -1, -1, -1, 1, 1, 1, 1)
# Observed responses for each combination of temperature, pressure, and furnace position
obs <- c(90.4, 90.7, 90.2, 90.2, 90.6, 90.4, 89.9, 90.1)
# Create a data frame with factors and observed values
dat <- data.frame(A, B, C, obs)
# Fit a linear model with two-way interactions between factors A (temperature), B (pressure), and C (furnace positions)
mod <- lm(obs ~ A * B + A * C + B * C, data = dat)
# Show the coefficients of the fitted model
coef(mod)## (Intercept) A B C A:B A:C
## 90.3125 0.0375 -0.2125 -0.0625 0.0125 -0.0375
## B:C
## -0.0375# Perform a half-normal plot of the effects to identify significant factors
halfnormal(mod)##
## Significant effects (alpha=0.05, Lenth method):## [1] B
# Get the summary of the model (ANOVA table)
summary(mod)##
## Call:
## lm.default(formula = obs ~ A * B + A * C + B * C, data = dat)
##
## Residuals:
## 1 2 3 4 5 6 7 8
## -0.0875 0.0875 0.0875 -0.0875 0.0875 -0.0875 -0.0875 0.0875
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 90.3125 0.0875 1032.143 0.000617 ***
## A 0.0375 0.0875 0.429 0.742238
## B -0.2125 0.0875 -2.429 0.248668
## C -0.0625 0.0875 -0.714 0.605137
## A:B 0.0125 0.0875 0.143 0.909666
## A:C -0.0375 0.0875 -0.429 0.742238
## B:C -0.0375 0.0875 -0.429 0.742238
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2475 on 1 degrees of freedom
## Multiple R-squared: 0.8747, Adjusted R-squared: 0.1228
## F-statistic: 1.163 on 6 and 1 DF, p-value: 0.6104# Plot the residuals to check the adequacy of the model
par(mfrow = c(2, 2)) # 2x2 layout for diagnostic plots
plot(mod)## hat values (leverages) are all = 0.875
## and there are no factor predictors; no plot no. 5
## Problem 13.6
# Load the necessary library
library(DoE.base)
# Input data based on the table from Problem 13.1
# Part numbers
part <- factor(rep(1:10, each = 6))
# Operator (fixed factor: 2 levels, Operator 1 and Operator 2)
operator <- factor(rep(c("Operator 1", "Operator 2"), each = 3, times = 10))
# Measurements as given in the table for both operators
measurements <- c(
50, 49, 50, 50, 48, 51, # Part 1
52, 52, 51, 51, 51, 51, # Part 2
53, 50, 50, 54, 52, 51, # Part 3
49, 51, 50, 48, 50, 51, # Part 4
48, 49, 48, 48, 49, 48, # Part 5
52, 50, 50, 52, 50, 50, # Part 6
51, 51, 51, 51, 50, 50, # Part 7
52, 50, 49, 53, 48, 50, # Part 8
50, 51, 50, 51, 48, 49, # Part 9
47, 46, 49, 46, 47, 48 # Part 10
)
# Create a data frame with part, operator, and measurements
df <- data.frame(part, operator, measurements)
# Convert part to a random factor since parts were randomly selected
df$part <- as.random(df$part)
# Fit the linear model using lm() for fixed operator factor
model <- lm(measurements ~ operator + part, data = df)
# Perform ANOVA to estimate the model components
anova_table <- anova(model)
print(anova_table)## Analysis of Variance Table
##
## Response: measurements
## Df Sum Sq Mean Sq F value Pr(>F)
## operator 1 0.417 0.4167 0.3121 0.5789
## part 9 99.017 11.0019 8.2409 2.458e-07 ***
## Residuals 49 65.417 1.3350
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Summary of the model
summary(model)##
## Call:
## lm.default(formula = measurements ~ operator + part, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.2500 -0.5833 -0.1667 0.5833 2.7500
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 49.7500 0.4947 100.560 < 2e-16 ***
## operatorOperator 2 -0.1667 0.2983 -0.559 0.578937
## part2 1.6667 0.6671 2.498 0.015879 *
## part3 2.0000 0.6671 2.998 0.004258 **
## part4 0.1667 0.6671 0.250 0.803755
## part5 -1.3333 0.6671 -1.999 0.051202 .
## part6 1.0000 0.6671 1.499 0.140278
## part7 1.0000 0.6671 1.499 0.140278
## part8 0.6667 0.6671 0.999 0.322529
## part9 0.1667 0.6671 0.250 0.803755
## part10 -2.5000 0.6671 -3.748 0.000471 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.155 on 49 degrees of freedom
## Multiple R-squared: 0.6032, Adjusted R-squared: 0.5222
## F-statistic: 7.448 on 10 and 49 DF, p-value: 4.754e-07# Plot diagnostic plots for the residuals
par(mfrow = c(2, 2)) # Set up a 2x2 plot layout
plot(model)