Linear Regression and its cousin

Author

Guibril Ramde

Part: 6.2.

  1. Start R and use these commands to load the data:
library(tidyverse)
Warning: package 'ggplot2' was built under R version 4.5.2
Warning: package 'tibble' was built under R version 4.5.2
Warning: package 'tidyr' was built under R version 4.5.2
Warning: package 'readr' was built under R version 4.5.2
Warning: package 'purrr' was built under R version 4.5.2
Warning: package 'dplyr' was built under R version 4.5.2
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.2.0     ✔ readr     2.1.6
✔ forcats   1.0.1     ✔ stringr   1.6.0
✔ ggplot2   4.0.2     ✔ tibble    3.3.1
✔ lubridate 1.9.4     ✔ tidyr     1.3.2
✔ purrr     1.2.1     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(fpp3)
Warning: package 'fpp3' was built under R version 4.5.2
── Attaching packages ──────────────────────────────────────────── fpp3 1.0.3 ──
✔ tsibble     1.2.0     ✔ feasts      0.5.0
✔ tsibbledata 0.4.1     ✔ fable       0.5.0
✔ ggtime      1.0.0     
Warning: package 'tsibble' was built under R version 4.5.2
Warning: package 'ggtime' was built under R version 4.5.2
Warning: package 'feasts' was built under R version 4.5.2
Warning: package 'fabletools' was built under R version 4.5.2
Warning: package 'fable' was built under R version 4.5.2
── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
✖ lubridate::date()    masks base::date()
✖ dplyr::filter()      masks stats::filter()
✖ tsibble::intersect() masks base::intersect()
✖ tsibble::interval()  masks lubridate::interval()
✖ dplyr::lag()         masks stats::lag()
✖ tsibble::setdiff()   masks base::setdiff()
✖ tsibble::union()     masks base::union()
library(AppliedPredictiveModeling)
Warning: package 'AppliedPredictiveModeling' was built under R version 4.5.2
library(caret)
Loading required package: lattice

Attaching package: 'caret'

The following objects are masked from 'package:fabletools':

    MAE, RMSE

The following object is masked from 'package:purrr':

    lift
data(permeability)
head(permeability, 15)
   permeability
1        12.520
2         1.120
3        19.405
4         1.730
5         1.680
6         0.510
7        25.365
8         0.550
9        39.455
10        4.910
11        0.550
12        1.570
13        0.060
14        5.560
15        3.850
#head(fingerprints, 5)

dim(permeability)
[1] 165   1
dim(fingerprints)
[1]  165 1107
str(permeability)
 num [1:165, 1] 12.52 1.12 19.41 1.73 1.68 ...
 - attr(*, "dimnames")=List of 2
  ..$ : chr [1:165] "1" "2" "3" "4" ...
  ..$ : chr "permeability"
str(fingerprints)
 num [1:165, 1:1107] 0 0 0 0 0 0 0 0 0 0 ...
 - attr(*, "dimnames")=List of 2
  ..$ : chr [1:165] "1" "2" "3" "4" ...
  ..$ : chr [1:1107] "X1" "X2" "X3" "X4" ...

Exploratory Data Analysis

# missing values
sum(is.na(permeability))
[1] 0
sum(is.na(fingerprints))
[1] 0
summary(permeability)
  permeability  
 Min.   : 0.06  
 1st Qu.: 1.55  
 Median : 4.91  
 Mean   :12.24  
 3rd Qu.:15.47  
 Max.   :55.60  
# Count of presence of each molecular substructure
fingerprint_counts <- colSums(fingerprints, dims = 1)
# summary of frequencies
summary(fingerprint_counts)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   0.00    1.00    4.00   25.54   30.00  165.00 
# predictor that are not present 0
sum(fingerprint_counts == 0)
[1] 20
# number of occurance < 5
sum(fingerprint_counts < 5)
[1] 564
# visualize the fingerprints data
fingerprint_df <- tibble(
  Frequency = as.numeric(fingerprint_counts)
)

ggplot(fingerprint_df, aes(x = Frequency)) +
  geom_histogram(
    bins = 30,
    fill = "steelblue",
    color = "black"
  ) +
  labs(
    title = "Distribution of Molecular Fingerprint Frequencies",
    x = "Number of Molecules Containing Substructure",
    y = "Number of Predictors"
  ) +
  theme_minimal()

Interpretation

If most predictors have frequencies close to zero, it means many molecular substructures occur in only a small number of molecules. These sparse predictors may provide limited information for regression modeling.

b. The fingerprint predictors indicate the presence or absence of substructures of a molecule and are often sparse meaning that relatively few of the molecules contain each substructure. Filter out the predictors that have low frequencies using the nearZeroVar function from the caret package. How many predictors are left for modeling?

# Identify near-zero variance predictor
nzv <- nearZeroVar(fingerprints)

# number of predictor before filtering
ncol(fingerprints)
[1] 1107
length(nzv)
[1] 719
# remove near - zero - variance predictors
fingerprints_filtered <- fingerprints[, -nzv, drop = FALSE]

# number of predictor remaining
ncol(fingerprints_filtered)
[1] 388
nzv_details <- nearZeroVar(fingerprints, saveMetrics = TRUE)
head(nzv_details, 10)
    freqRatio percentUnique zeroVar   nzv
X1   3.342105     1.2121212   FALSE FALSE
X2   3.459459     1.2121212   FALSE FALSE
X3   3.714286     1.2121212   FALSE FALSE
X4   3.714286     1.2121212   FALSE FALSE
X5   3.714286     1.2121212   FALSE FALSE
X6   1.229730     1.2121212   FALSE FALSE
X7   0.000000     0.6060606    TRUE  TRUE
X8   0.000000     0.6060606    TRUE  TRUE
X9  54.000000     1.2121212   FALSE  TRUE
X10 40.250000     1.2121212   FALSE  TRUE
table(nzv_details$nzv)

FALSE  TRUE 
  388   719

Interpretation:

The fingerprint dataset initially contained 1107 predictors. I applied the nearZeroVar() function from the caret package to identify predictors with little or no variation. After removing 719 predictors, 388 predictors remained for modeling. This preprocessing step reduces the number of uninformative predictors and may improve computational efficiency.

c. Split the data into a training and a test set, pre-process the data, and tune a PLS model. How many latent variables are optimal and what is the corresponding resampled estimate of R2?

# Combine predictors and target
model_data <- as.data.frame(fingerprints) |>
  mutate(Permeability = as.numeric(permeability))

# Verify dimensions
dim(model_data)
[1]  165 1108
# Check target
summary(model_data$Permeability)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   0.06    1.55    4.91   12.24   15.47   55.60 
# Check missing values
sum(is.na(model_data$Permeability))
[1] 0
set.seed(42)

train_index <- createDataPartition(
  y = model_data$Permeability,
  p = 0.80,
  list = FALSE
)

train_data <- model_data[train_index, ]
test_data <- model_data[-train_index, ]

dim(train_data)
[1]  133 1108
dim(test_data)
[1]   32 1108
# Predictors
x_train <- train_data |>
  select(-Permeability)

x_test <- test_data |>
  select(-Permeability)

# Convert target to numeric vectors
y_train <- as.numeric(train_data$Permeability)
y_test <- as.numeric(test_data$Permeability)

# Verify
class(y_train)
[1] "numeric"
is.numeric(y_train)
[1] TRUE
length(y_train)
[1] 133
summary(y_train)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   0.06    1.55    4.91   12.18   15.47   55.60 
# Check dimensions
dim(x_train)
[1]  133 1107
dim(x_test)
[1]   32 1107
length(y_train)
[1] 133
length(y_test)
[1] 32
# Identify near-zero variance predictors
nzv_train <- nearZeroVar(x_train)

# Filter training and testing predictors
keep_cols <- setdiff(seq_len(ncol(x_train)), nzv_train)

x_train_filtered <- x_train[, keep_cols, drop = FALSE]
x_test_filtered <- x_test[, keep_cols, drop = FALSE]

# Verify dimensions
dim(x_train_filtered)
[1] 133 393
dim(x_test_filtered)
[1]  32 393
nrow(fingerprints)
[1] 165
length(permeability)
[1] 165
ncol(x_train_filtered)
[1] 393
#install.packages("pls")
library(caret)
library(pls)
Warning: package 'pls' was built under R version 4.5.2

Attaching package: 'pls'
The following object is masked from 'package:caret':

    R2
The following object is masked from 'package:stats':

    loadings
set.seed(42)

# Configure repeated cross-validation
train_control <- trainControl(
  method = "repeatedcv",
  number = 10,
  repeats = 3
)

# Train the PLS regression model
pls_model <- train(
  x = x_train_filtered,
  y = y_train,
  method = "pls",
  preProcess = c("center", "scale"),
  tuneGrid = expand.grid(ncomp = 1:30),
  trControl = train_control,
  metric = "Rsquared"
)

# Display model summary
print(pls_model)
Partial Least Squares 

133 samples
393 predictors

Pre-processing: centered (393), scaled (393) 
Resampling: Cross-Validated (10 fold, repeated 3 times) 
Summary of sample sizes: 119, 121, 120, 120, 118, 119, ... 
Resampling results across tuning parameters:

  ncomp  RMSE      Rsquared   MAE      
   1     13.07548  0.3359875   9.966304
   2     12.25093  0.4317432   8.787737
   3     12.31039  0.4299298   9.395322
   4     12.14453  0.4438789   9.211818
   5     11.43946  0.5037737   8.479882
   6     10.99738  0.5396807   8.181917
   7     11.00772  0.5466184   8.311588
   8     11.16872  0.5361976   8.439653
   9     11.22950  0.5290220   8.459234
  10     11.28902  0.5263495   8.539905
  11     11.21520  0.5338616   8.448644
  12     11.32723  0.5268043   8.463051
  13     11.40434  0.5232295   8.594503
  14     11.78746  0.4977856   8.788449
  15     11.90165  0.4997906   8.968237
  16     12.13744  0.4899328   9.170961
  17     12.49633  0.4686792   9.516685
  18     12.83179  0.4486602   9.750667
  19     12.93006  0.4459538   9.777679
  20     12.97298  0.4436120   9.839813
  21     13.20160  0.4340240  10.044044
  22     13.17583  0.4405650  10.036027
  23     13.34508  0.4359419  10.170894
  24     13.62996  0.4258076  10.346891
  25     13.83891  0.4183632  10.526050
  26     14.11978  0.4100074  10.712643
  27     14.51546  0.3943172  10.989881
  28     14.93641  0.3820855  11.294642
  29     15.22996  0.3782783  11.563662
  30     15.49306  0.3698000  11.725700

Rsquared was used to select the optimal model using the largest value.
The final value used for the model was ncomp = 7.
# Optimal number of latent variables
pls_model$bestTune
  ncomp
7     7
# Corresponding resampled R-squared
best_result <- pls_model$results |>
  filter(ncomp == pls_model$bestTune$ncomp)

best_result |>
  select(ncomp, RMSE, Rsquared)
  ncomp     RMSE  Rsquared
1     7 11.00772 0.5466184
ggplot(pls_model$results, aes(x = ncomp, y = Rsquared)) +
  geom_line(color = "steelblue") +
  geom_point(color = "darkblue") +
  geom_vline(
    xintercept = pls_model$bestTune$ncomp,
    linetype = "dashed",
    color = "red"
  ) +
  labs(
    title = "PLS Regression: Cross-Validated R-Squared",
    x = "Number of Latent Variables",
    y = "Cross-Validated R-Squared"
  ) +
  theme_minimal()

Interpretation: Training and Test Data Preparation

The data set contains 165 molecular observations and 1,107 fingerprint predictors. The data were divided into a training set containing 133 observations (approximately 80%) and a testing set containing 32 observations (approximately 20%).

Near-zero-variance filtering was applied to the training predictors to remove variables with little or no variation. Of the original 1,107 predictors, 714 were removed, leaving 393 predictors for model development. The same predictor columns were retained in the testing data set to ensure consistency.

The response variable is molecular permeability, which is continuous. Therefore, Partial Least Squares regression was selected to predict permeability from the molecular fingerprint predictors.

  1. Predict the response for the test set. What is the test set estimate of R2?
# Predict molecular permeability for the test set
pls_predictions <- predict(
  pls_model,
  newdata = x_test_filtered
)

# View predictions
head(pls_predictions)
[1] 20.527796  9.447243 28.548741  6.953834 18.627001  8.834673
# Calculate RMSE, R-squared, and MAE
pls_test_results <- postResample(
  pred = pls_predictions,
  obs = y_test
)

pls_test_results
      RMSE   Rsquared        MAE 
13.0723693  0.3560746 10.1451370 
# Visualize
pls_test_df <- tibble(
  Actual = y_test,
  Predicted = as.numeric(pls_predictions)
)

ggplot(pls_test_df, aes(x = Actual, y = Predicted)) +
  geom_point(color = "steelblue", size = 2.5) +
  geom_abline(
    slope = 1,
    intercept = 0,
    linetype = "dashed",
    color = "red"
  ) +
  labs(
    title = "PLS Regression: Actual vs Predicted Permeability",
    x = "Actual Permeability",
    y = "Predicted Permeability"
  ) +
  theme_minimal()

  1. Interpretation: Actual vs. Predicted Permeability
The scatterplot compares the actual permeability values with the values predicted by the Partial Least Squares (PLS) regression model. The red dashed line represents perfect predictions, where the predicted values equal the actual values.

The results show that several observations are far from the reference line, indicating substantial prediction errors. The model tends to underestimate permeability for molecules with high actual values, while overestimating permeability for some molecules with low actual values. Additionally, the model produces a negative prediction for one observation, which is not physically meaningful.

The test-set R² of 0.3561 and RMSE of 13.0724 indicate limited predictive performance. Therefore, the PLS model may provide approximate permeability estimates, but its accuracy is insufficient to reliably replace laboratory measurements.
  1. Try building other models discussed in this chapter. Do any have better predictive performance?
#install.packages("glmnet")
library(glmnet)
Warning: package 'glmnet' was built under R version 4.5.2
Loading required package: Matrix

Attaching package: 'Matrix'
The following objects are masked from 'package:tidyr':

    expand, pack, unpack
Loaded glmnet 5.2
set.seed(42)

ridge_model <- train(
  x = x_train_filtered,
  y = y_train,
  method = "glmnet",
  preProcess = c("center", "scale"),
  tuneGrid = expand.grid(
    alpha = 0,
    lambda = 10^seq(-4, 2, length.out = 50)
  ),
  trControl = train_control,
  metric = "Rsquared"
)

ridge_model$bestTune
   alpha  lambda
49     0 75.4312
## Lasso Regression
set.seed(42)

lasso_model <- train(
  x = x_train_filtered,
  y = y_train,
  method = "glmnet",
  preProcess = c("center", "scale"),
  tuneGrid = expand.grid(
    alpha = 1,
    lambda = 10^seq(-4, 2, length.out = 50)
  ),
  trControl = train_control,
  metric = "Rsquared"
)
Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
: There were missing values in resampled performance measures.
Warning in train.default(x = x_train_filtered, y = y_train, method = "glmnet",
: missing values found in aggregated results
lasso_model$bestTune
   alpha   lambda
30     1 0.355648
# Evaluate both models
# Ridge predictions
ridge_predictions <- predict(
  ridge_model,
  newdata = x_test_filtered
)

# Lasso predictions
lasso_predictions <- predict(
  lasso_model,
  newdata = x_test_filtered
)

# Test performance
ridge_results <- postResample(
  ridge_predictions,
  y_test
)

lasso_results <- postResample(
  lasso_predictions,
  y_test
)
# Compare all three models
model_comparison <- tibble(
  Model = c("PLS", "Ridge", "Lasso"),
  RMSE = c(
    pls_test_results["RMSE"],
    ridge_results["RMSE"],
    lasso_results["RMSE"]
  ),
  Rsquared = c(
    pls_test_results["Rsquared"],
    ridge_results["Rsquared"],
    lasso_results["Rsquared"]
  ),
  MAE = c(
    pls_test_results["MAE"],
    ridge_results["MAE"],
    lasso_results["MAE"]
  )
)

model_comparison
# A tibble: 3 × 4
  Model  RMSE Rsquared   MAE
  <chr> <dbl>    <dbl> <dbl>
1 PLS    13.1    0.356 10.1 
2 Ridge  10.7    0.583  8.14
3 Lasso  13.1    0.324 10.4 
ggplot(model_comparison, aes(x = Model, y = Rsquared, fill = Model)) +
  geom_col(width = 0.6) +
  labs(
    title = "Comparison of Regression Models",
    x = "Regression Model",
    y = "Test Set R-Squared"
  ) +
  theme_minimal() +
  theme(legend.position = "none")

Interpretation: Comparison of Regression Models

Three regression models were evaluated to predict molecular permeability: Partial Least Squares (PLS), Ridge Regression, and Lasso Regression. Their predictive performances were compared using R-squared (R²), Root Mean Squared Error (RMSE), and Mean Absolute Error (MAE).

Ridge Regression achieved the best predictive performance, with an R² of 0.5832, RMSE of 10.6637, and MAE of 8.1449. PLS Regression achieved an R² of 0.3561, while Lasso Regression had the lowest R² of 0.3239.

These results indicate that Ridge Regression performs better than the other two models on the testing data set. Ridge Regression may be more effective because it reduces the influence of individual predictors through regularization while retaining information from all predictors.

Therefore, Ridge Regression is the preferred model among the three approaches evaluated. However, further validation would be necessary to confirm its reliability on new molecular observations.

f. Would you recommend any of your models to replace the permeability laboratory experiment?

Interpretation: Recommendation

Based on the results, I would not recommend replacing the laboratory permeability experiment entirely with any of the regression models.

Although Ridge Regression achieved the highest R² of 0.5832 and the lowest RMSE of 10.6637, its predictions still contain substantial errors. This suggests that the model does not fully capture the relationship between molecular fingerprints and permeability.

Additionally, the data set contains only 165 molecular observations, with 32 observations used for testing. This relatively small testing data set limits our confidence in the model’s ability to generalize to new molecules.

However, Ridge Regression could be useful as a preliminary screening tool to estimate molecular permeability and identify molecules that require further laboratory testing. Additional observations, external validation, and further model improvement would be necessary before considering it a replacement for laboratory experiments.

Part 6.3

a. Start R and use these commands to load the data: > library(AppliedPredictiveModeling) > data(chemicalManufacturingProcess) The matrix processPredictors contains the 57 predictors (12 describing the input biological material and 45 describing the process predictors) for the 176 manufacturing runs. yield contains the percent yield for each run.

Exploratory Data Analysis

data(ChemicalManufacturingProcess)
head(ChemicalManufacturingProcess)
  Yield BiologicalMaterial01 BiologicalMaterial02 BiologicalMaterial03
1 38.00                 6.25                49.58                56.97
2 42.44                 8.01                60.97                67.48
3 42.03                 8.01                60.97                67.48
4 41.42                 8.01                60.97                67.48
5 42.49                 7.47                63.33                72.25
6 43.57                 6.12                58.36                65.31
  BiologicalMaterial04 BiologicalMaterial05 BiologicalMaterial06
1                12.74                19.51                43.73
2                14.65                19.36                53.14
3                14.65                19.36                53.14
4                14.65                19.36                53.14
5                14.02                17.91                54.66
6                15.17                21.79                51.23
  BiologicalMaterial07 BiologicalMaterial08 BiologicalMaterial09
1                  100                16.66                11.44
2                  100                19.04                12.55
3                  100                19.04                12.55
4                  100                19.04                12.55
5                  100                18.22                12.80
6                  100                18.30                12.13
  BiologicalMaterial10 BiologicalMaterial11 BiologicalMaterial12
1                 3.46               138.09                18.83
2                 3.46               153.67                21.05
3                 3.46               153.67                21.05
4                 3.46               153.67                21.05
5                 3.05               147.61                21.05
6                 3.78               151.88                20.76
  ManufacturingProcess01 ManufacturingProcess02 ManufacturingProcess03
1                     NA                     NA                     NA
2                    0.0                      0                     NA
3                    0.0                      0                     NA
4                    0.0                      0                     NA
5                   10.7                      0                     NA
6                   12.0                      0                     NA
  ManufacturingProcess04 ManufacturingProcess05 ManufacturingProcess06
1                     NA                     NA                     NA
2                    917                 1032.2                  210.0
3                    912                 1003.6                  207.1
4                    911                 1014.6                  213.3
5                    918                 1027.5                  205.7
6                    924                 1016.8                  208.9
  ManufacturingProcess07 ManufacturingProcess08 ManufacturingProcess09
1                     NA                     NA                  43.00
2                    177                    178                  46.57
3                    178                    178                  45.07
4                    177                    177                  44.92
5                    178                    178                  44.96
6                    178                    178                  45.32
  ManufacturingProcess10 ManufacturingProcess11 ManufacturingProcess12
1                     NA                     NA                     NA
2                     NA                     NA                      0
3                     NA                     NA                      0
4                     NA                     NA                      0
5                     NA                     NA                      0
6                     NA                     NA                      0
  ManufacturingProcess13 ManufacturingProcess14 ManufacturingProcess15
1                   35.5                   4898                   6108
2                   34.0                   4869                   6095
3                   34.8                   4878                   6087
4                   34.8                   4897                   6102
5                   34.6                   4992                   6233
6                   34.0                   4985                   6222
  ManufacturingProcess16 ManufacturingProcess17 ManufacturingProcess18
1                   4682                   35.5                   4865
2                   4617                   34.0                   4867
3                   4617                   34.8                   4877
4                   4635                   34.8                   4872
5                   4733                   33.9                   4886
6                   4786                   33.4                   4862
  ManufacturingProcess19 ManufacturingProcess20 ManufacturingProcess21
1                   6049                   4665                    0.0
2                   6097                   4621                    0.0
3                   6078                   4621                    0.0
4                   6073                   4611                    0.0
5                   6102                   4659                   -0.7
6                   6115                   4696                   -0.6
  ManufacturingProcess22 ManufacturingProcess23 ManufacturingProcess24
1                     NA                     NA                     NA
2                      3                      0                      3
3                      4                      1                      4
4                      5                      2                      5
5                      8                      4                     18
6                      9                      1                      1
  ManufacturingProcess25 ManufacturingProcess26 ManufacturingProcess27
1                   4873                   6074                   4685
2                   4869                   6107                   4630
3                   4897                   6116                   4637
4                   4892                   6111                   4630
5                   4930                   6151                   4684
6                   4871                   6128                   4687
  ManufacturingProcess28 ManufacturingProcess29 ManufacturingProcess30
1                   10.7                   21.0                    9.9
2                   11.2                   21.4                    9.9
3                   11.1                   21.3                    9.4
4                   11.1                   21.3                    9.4
5                   11.3                   21.6                    9.0
6                   11.4                   21.7                   10.1
  ManufacturingProcess31 ManufacturingProcess32 ManufacturingProcess33
1                   69.1                    156                     66
2                   68.7                    169                     66
3                   69.3                    173                     66
4                   69.3                    171                     68
5                   69.4                    171                     70
6                   68.2                    173                     70
  ManufacturingProcess34 ManufacturingProcess35 ManufacturingProcess36
1                    2.4                    486                  0.019
2                    2.6                    508                  0.019
3                    2.6                    509                  0.018
4                    2.5                    496                  0.018
5                    2.5                    468                  0.017
6                    2.5                    490                  0.018
  ManufacturingProcess37 ManufacturingProcess38 ManufacturingProcess39
1                    0.5                      3                    7.2
2                    2.0                      2                    7.2
3                    0.7                      2                    7.2
4                    1.2                      2                    7.2
5                    0.2                      2                    7.3
6                    0.4                      2                    7.2
  ManufacturingProcess40 ManufacturingProcess41 ManufacturingProcess42
1                     NA                     NA                   11.6
2                    0.1                   0.15                   11.1
3                    0.0                   0.00                   12.0
4                    0.0                   0.00                   10.6
5                    0.0                   0.00                   11.0
6                    0.0                   0.00                   11.5
  ManufacturingProcess43 ManufacturingProcess44 ManufacturingProcess45
1                    3.0                    1.8                    2.4
2                    0.9                    1.9                    2.2
3                    1.0                    1.8                    2.3
4                    1.1                    1.8                    2.1
5                    1.1                    1.7                    2.1
6                    2.2                    1.8                    2.0
nrow(ChemicalManufacturingProcess)
[1] 176
dim(ChemicalManufacturingProcess)
[1] 176  58
sum(is.na(ChemicalManufacturingProcess))
[1] 106
str(ChemicalManufacturingProcess)
'data.frame':   176 obs. of  58 variables:
 $ Yield                 : num  38 42.4 42 41.4 42.5 ...
 $ BiologicalMaterial01  : num  6.25 8.01 8.01 8.01 7.47 6.12 7.48 6.94 6.94 6.94 ...
 $ BiologicalMaterial02  : num  49.6 61 61 61 63.3 ...
 $ BiologicalMaterial03  : num  57 67.5 67.5 67.5 72.2 ...
 $ BiologicalMaterial04  : num  12.7 14.7 14.7 14.7 14 ...
 $ BiologicalMaterial05  : num  19.5 19.4 19.4 19.4 17.9 ...
 $ BiologicalMaterial06  : num  43.7 53.1 53.1 53.1 54.7 ...
 $ BiologicalMaterial07  : num  100 100 100 100 100 100 100 100 100 100 ...
 $ BiologicalMaterial08  : num  16.7 19 19 19 18.2 ...
 $ BiologicalMaterial09  : num  11.4 12.6 12.6 12.6 12.8 ...
 $ BiologicalMaterial10  : num  3.46 3.46 3.46 3.46 3.05 3.78 3.04 3.85 3.85 3.85 ...
 $ BiologicalMaterial11  : num  138 154 154 154 148 ...
 $ BiologicalMaterial12  : num  18.8 21.1 21.1 21.1 21.1 ...
 $ ManufacturingProcess01: num  NA 0 0 0 10.7 12 11.5 12 12 12 ...
 $ ManufacturingProcess02: num  NA 0 0 0 0 0 0 0 0 0 ...
 $ ManufacturingProcess03: num  NA NA NA NA NA NA 1.56 1.55 1.56 1.55 ...
 $ ManufacturingProcess04: num  NA 917 912 911 918 924 933 929 928 938 ...
 $ ManufacturingProcess05: num  NA 1032 1004 1015 1028 ...
 $ ManufacturingProcess06: num  NA 210 207 213 206 ...
 $ ManufacturingProcess07: num  NA 177 178 177 178 178 177 178 177 177 ...
 $ ManufacturingProcess08: num  NA 178 178 177 178 178 178 178 177 177 ...
 $ ManufacturingProcess09: num  43 46.6 45.1 44.9 45 ...
 $ ManufacturingProcess10: num  NA NA NA NA NA NA 11.6 10.2 9.7 10.1 ...
 $ ManufacturingProcess11: num  NA NA NA NA NA NA 11.5 11.3 11.1 10.2 ...
 $ ManufacturingProcess12: num  NA 0 0 0 0 0 0 0 0 0 ...
 $ ManufacturingProcess13: num  35.5 34 34.8 34.8 34.6 34 32.4 33.6 33.9 34.3 ...
 $ ManufacturingProcess14: num  4898 4869 4878 4897 4992 ...
 $ ManufacturingProcess15: num  6108 6095 6087 6102 6233 ...
 $ ManufacturingProcess16: num  4682 4617 4617 4635 4733 ...
 $ ManufacturingProcess17: num  35.5 34 34.8 34.8 33.9 33.4 33.8 33.6 33.9 35.3 ...
 $ ManufacturingProcess18: num  4865 4867 4877 4872 4886 ...
 $ ManufacturingProcess19: num  6049 6097 6078 6073 6102 ...
 $ ManufacturingProcess20: num  4665 4621 4621 4611 4659 ...
 $ ManufacturingProcess21: num  0 0 0 0 -0.7 -0.6 1.4 0 0 1 ...
 $ ManufacturingProcess22: num  NA 3 4 5 8 9 1 2 3 4 ...
 $ ManufacturingProcess23: num  NA 0 1 2 4 1 1 2 3 1 ...
 $ ManufacturingProcess24: num  NA 3 4 5 18 1 1 2 3 4 ...
 $ ManufacturingProcess25: num  4873 4869 4897 4892 4930 ...
 $ ManufacturingProcess26: num  6074 6107 6116 6111 6151 ...
 $ ManufacturingProcess27: num  4685 4630 4637 4630 4684 ...
 $ ManufacturingProcess28: num  10.7 11.2 11.1 11.1 11.3 11.4 11.2 11.1 11.3 11.4 ...
 $ ManufacturingProcess29: num  21 21.4 21.3 21.3 21.6 21.7 21.2 21.2 21.5 21.7 ...
 $ ManufacturingProcess30: num  9.9 9.9 9.4 9.4 9 10.1 11.2 10.9 10.5 9.8 ...
 $ ManufacturingProcess31: num  69.1 68.7 69.3 69.3 69.4 68.2 67.6 67.9 68 68.5 ...
 $ ManufacturingProcess32: num  156 169 173 171 171 173 159 161 160 164 ...
 $ ManufacturingProcess33: num  66 66 66 68 70 70 65 65 65 66 ...
 $ ManufacturingProcess34: num  2.4 2.6 2.6 2.5 2.5 2.5 2.5 2.5 2.5 2.5 ...
 $ ManufacturingProcess35: num  486 508 509 496 468 490 475 478 491 488 ...
 $ ManufacturingProcess36: num  0.019 0.019 0.018 0.018 0.017 0.018 0.019 0.019 0.019 0.019 ...
 $ ManufacturingProcess37: num  0.5 2 0.7 1.2 0.2 0.4 0.8 1 1.2 1.8 ...
 $ ManufacturingProcess38: num  3 2 2 2 2 2 2 2 3 3 ...
 $ ManufacturingProcess39: num  7.2 7.2 7.2 7.2 7.3 7.2 7.3 7.3 7.4 7.1 ...
 $ ManufacturingProcess40: num  NA 0.1 0 0 0 0 0 0 0 0 ...
 $ ManufacturingProcess41: num  NA 0.15 0 0 0 0 0 0 0 0 ...
 $ ManufacturingProcess42: num  11.6 11.1 12 10.6 11 11.5 11.7 11.4 11.4 11.3 ...
 $ ManufacturingProcess43: num  3 0.9 1 1.1 1.1 2.2 0.7 0.8 0.9 0.8 ...
 $ ManufacturingProcess44: num  1.8 1.9 1.8 1.8 1.7 1.8 2 2 1.9 1.9 ...
 $ ManufacturingProcess45: num  2.4 2.2 2.3 2.1 2.1 2 2.2 2.2 2.1 2.4 ...
names(ChemicalManufacturingProcess)
 [1] "Yield"                  "BiologicalMaterial01"   "BiologicalMaterial02"  
 [4] "BiologicalMaterial03"   "BiologicalMaterial04"   "BiologicalMaterial05"  
 [7] "BiologicalMaterial06"   "BiologicalMaterial07"   "BiologicalMaterial08"  
[10] "BiologicalMaterial09"   "BiologicalMaterial10"   "BiologicalMaterial11"  
[13] "BiologicalMaterial12"   "ManufacturingProcess01" "ManufacturingProcess02"
[16] "ManufacturingProcess03" "ManufacturingProcess04" "ManufacturingProcess05"
[19] "ManufacturingProcess06" "ManufacturingProcess07" "ManufacturingProcess08"
[22] "ManufacturingProcess09" "ManufacturingProcess10" "ManufacturingProcess11"
[25] "ManufacturingProcess12" "ManufacturingProcess13" "ManufacturingProcess14"
[28] "ManufacturingProcess15" "ManufacturingProcess16" "ManufacturingProcess17"
[31] "ManufacturingProcess18" "ManufacturingProcess19" "ManufacturingProcess20"
[34] "ManufacturingProcess21" "ManufacturingProcess22" "ManufacturingProcess23"
[37] "ManufacturingProcess24" "ManufacturingProcess25" "ManufacturingProcess26"
[40] "ManufacturingProcess27" "ManufacturingProcess28" "ManufacturingProcess29"
[43] "ManufacturingProcess30" "ManufacturingProcess31" "ManufacturingProcess32"
[46] "ManufacturingProcess33" "ManufacturingProcess34" "ManufacturingProcess35"
[49] "ManufacturingProcess36" "ManufacturingProcess37" "ManufacturingProcess38"
[52] "ManufacturingProcess39" "ManufacturingProcess40" "ManufacturingProcess41"
[55] "ManufacturingProcess42" "ManufacturingProcess43" "ManufacturingProcess44"
[58] "ManufacturingProcess45"
summary(ChemicalManufacturingProcess)
     Yield       BiologicalMaterial01 BiologicalMaterial02 BiologicalMaterial03
 Min.   :35.25   Min.   :4.580        Min.   :46.87        Min.   :56.97       
 1st Qu.:38.75   1st Qu.:5.978        1st Qu.:52.68        1st Qu.:64.98       
 Median :39.97   Median :6.305        Median :55.09        Median :67.22       
 Mean   :40.18   Mean   :6.411        Mean   :55.69        Mean   :67.70       
 3rd Qu.:41.48   3rd Qu.:6.870        3rd Qu.:58.74        3rd Qu.:70.43       
 Max.   :46.34   Max.   :8.810        Max.   :64.75        Max.   :78.25       
                                                                               
 BiologicalMaterial04 BiologicalMaterial05 BiologicalMaterial06
 Min.   : 9.38        Min.   :13.24        Min.   :40.60       
 1st Qu.:11.24        1st Qu.:17.23        1st Qu.:46.05       
 Median :12.10        Median :18.49        Median :48.46       
 Mean   :12.35        Mean   :18.60        Mean   :48.91       
 3rd Qu.:13.22        3rd Qu.:19.90        3rd Qu.:51.34       
 Max.   :23.09        Max.   :24.85        Max.   :59.38       
                                                               
 BiologicalMaterial07 BiologicalMaterial08 BiologicalMaterial09
 Min.   :100.0        Min.   :15.88        Min.   :11.44       
 1st Qu.:100.0        1st Qu.:17.06        1st Qu.:12.60       
 Median :100.0        Median :17.51        Median :12.84       
 Mean   :100.0        Mean   :17.49        Mean   :12.85       
 3rd Qu.:100.0        3rd Qu.:17.88        3rd Qu.:13.13       
 Max.   :100.8        Max.   :19.14        Max.   :14.08       
                                                               
 BiologicalMaterial10 BiologicalMaterial11 BiologicalMaterial12
 Min.   :1.770        Min.   :135.8        Min.   :18.35       
 1st Qu.:2.460        1st Qu.:143.8        1st Qu.:19.73       
 Median :2.710        Median :146.1        Median :20.12       
 Mean   :2.801        Mean   :147.0        Mean   :20.20       
 3rd Qu.:2.990        3rd Qu.:149.6        3rd Qu.:20.75       
 Max.   :6.870        Max.   :158.7        Max.   :22.21       
                                                               
 ManufacturingProcess01 ManufacturingProcess02 ManufacturingProcess03
 Min.   : 0.00          Min.   : 0.00          Min.   :1.47          
 1st Qu.:10.80          1st Qu.:19.30          1st Qu.:1.53          
 Median :11.40          Median :21.00          Median :1.54          
 Mean   :11.21          Mean   :16.68          Mean   :1.54          
 3rd Qu.:12.15          3rd Qu.:21.50          3rd Qu.:1.55          
 Max.   :14.10          Max.   :22.50          Max.   :1.60          
 NA's   :1              NA's   :3              NA's   :15            
 ManufacturingProcess04 ManufacturingProcess05 ManufacturingProcess06
 Min.   :911.0          Min.   : 923.0         Min.   :203.0         
 1st Qu.:928.0          1st Qu.: 986.8         1st Qu.:205.7         
 Median :934.0          Median : 999.2         Median :206.8         
 Mean   :931.9          Mean   :1001.7         Mean   :207.4         
 3rd Qu.:936.0          3rd Qu.:1008.9         3rd Qu.:208.7         
 Max.   :946.0          Max.   :1175.3         Max.   :227.4         
 NA's   :1              NA's   :1              NA's   :2             
 ManufacturingProcess07 ManufacturingProcess08 ManufacturingProcess09
 Min.   :177.0          Min.   :177.0          Min.   :38.89         
 1st Qu.:177.0          1st Qu.:177.0          1st Qu.:44.89         
 Median :177.0          Median :178.0          Median :45.73         
 Mean   :177.5          Mean   :177.6          Mean   :45.66         
 3rd Qu.:178.0          3rd Qu.:178.0          3rd Qu.:46.52         
 Max.   :178.0          Max.   :178.0          Max.   :49.36         
 NA's   :1              NA's   :1                                    
 ManufacturingProcess10 ManufacturingProcess11 ManufacturingProcess12
 Min.   : 7.500         Min.   : 7.500         Min.   :   0.0        
 1st Qu.: 8.700         1st Qu.: 9.000         1st Qu.:   0.0        
 Median : 9.100         Median : 9.400         Median :   0.0        
 Mean   : 9.179         Mean   : 9.386         Mean   : 857.8        
 3rd Qu.: 9.550         3rd Qu.: 9.900         3rd Qu.:   0.0        
 Max.   :11.600         Max.   :11.500         Max.   :4549.0        
 NA's   :9              NA's   :10             NA's   :1             
 ManufacturingProcess13 ManufacturingProcess14 ManufacturingProcess15
 Min.   :32.10          Min.   :4701           Min.   :5904          
 1st Qu.:33.90          1st Qu.:4828           1st Qu.:6010          
 Median :34.60          Median :4856           Median :6032          
 Mean   :34.51          Mean   :4854           Mean   :6039          
 3rd Qu.:35.20          3rd Qu.:4882           3rd Qu.:6061          
 Max.   :38.60          Max.   :5055           Max.   :6233          
                        NA's   :1                                    
 ManufacturingProcess16 ManufacturingProcess17 ManufacturingProcess18
 Min.   :   0           Min.   :31.30          Min.   :   0          
 1st Qu.:4561           1st Qu.:33.50          1st Qu.:4813          
 Median :4588           Median :34.40          Median :4835          
 Mean   :4566           Mean   :34.34          Mean   :4810          
 3rd Qu.:4619           3rd Qu.:35.10          3rd Qu.:4862          
 Max.   :4852           Max.   :40.00          Max.   :4971          
                                                                     
 ManufacturingProcess19 ManufacturingProcess20 ManufacturingProcess21
 Min.   :5890           Min.   :   0           Min.   :-1.8000       
 1st Qu.:6001           1st Qu.:4553           1st Qu.:-0.6000       
 Median :6022           Median :4582           Median :-0.3000       
 Mean   :6028           Mean   :4556           Mean   :-0.1642       
 3rd Qu.:6050           3rd Qu.:4610           3rd Qu.: 0.0000       
 Max.   :6146           Max.   :4759           Max.   : 3.6000       
                                                                     
 ManufacturingProcess22 ManufacturingProcess23 ManufacturingProcess24
 Min.   : 0.000         Min.   :0.000          Min.   : 0.000        
 1st Qu.: 3.000         1st Qu.:2.000          1st Qu.: 4.000        
 Median : 5.000         Median :3.000          Median : 8.000        
 Mean   : 5.406         Mean   :3.017          Mean   : 8.834        
 3rd Qu.: 8.000         3rd Qu.:4.000          3rd Qu.:14.000        
 Max.   :12.000         Max.   :6.000          Max.   :23.000        
 NA's   :1              NA's   :1              NA's   :1             
 ManufacturingProcess25 ManufacturingProcess26 ManufacturingProcess27
 Min.   :   0           Min.   :   0           Min.   :   0          
 1st Qu.:4832           1st Qu.:6020           1st Qu.:4560          
 Median :4855           Median :6047           Median :4587          
 Mean   :4828           Mean   :6016           Mean   :4563          
 3rd Qu.:4877           3rd Qu.:6070           3rd Qu.:4609          
 Max.   :4990           Max.   :6161           Max.   :4710          
 NA's   :5              NA's   :5              NA's   :5             
 ManufacturingProcess28 ManufacturingProcess29 ManufacturingProcess30
 Min.   : 0.000         Min.   : 0.00          Min.   : 0.000        
 1st Qu.: 0.000         1st Qu.:19.70          1st Qu.: 8.800        
 Median :10.400         Median :19.90          Median : 9.100        
 Mean   : 6.592         Mean   :20.01          Mean   : 9.161        
 3rd Qu.:10.750         3rd Qu.:20.40          3rd Qu.: 9.700        
 Max.   :11.500         Max.   :22.00          Max.   :11.200        
 NA's   :5              NA's   :5              NA's   :5             
 ManufacturingProcess31 ManufacturingProcess32 ManufacturingProcess33
 Min.   : 0.00          Min.   :143.0          Min.   :56.00         
 1st Qu.:70.10          1st Qu.:155.0          1st Qu.:62.00         
 Median :70.80          Median :158.0          Median :64.00         
 Mean   :70.18          Mean   :158.5          Mean   :63.54         
 3rd Qu.:71.40          3rd Qu.:162.0          3rd Qu.:65.00         
 Max.   :72.50          Max.   :173.0          Max.   :70.00         
 NA's   :5                                     NA's   :5             
 ManufacturingProcess34 ManufacturingProcess35 ManufacturingProcess36
 Min.   :2.300          Min.   :463.0          Min.   :0.01700       
 1st Qu.:2.500          1st Qu.:490.0          1st Qu.:0.01900       
 Median :2.500          Median :495.0          Median :0.02000       
 Mean   :2.494          Mean   :495.6          Mean   :0.01957       
 3rd Qu.:2.500          3rd Qu.:501.5          3rd Qu.:0.02000       
 Max.   :2.600          Max.   :522.0          Max.   :0.02200       
 NA's   :5              NA's   :5              NA's   :5             
 ManufacturingProcess37 ManufacturingProcess38 ManufacturingProcess39
 Min.   :0.000          Min.   :0.000          Min.   :0.000         
 1st Qu.:0.700          1st Qu.:2.000          1st Qu.:7.100         
 Median :1.000          Median :3.000          Median :7.200         
 Mean   :1.014          Mean   :2.534          Mean   :6.851         
 3rd Qu.:1.300          3rd Qu.:3.000          3rd Qu.:7.300         
 Max.   :2.300          Max.   :3.000          Max.   :7.500         
                                                                     
 ManufacturingProcess40 ManufacturingProcess41 ManufacturingProcess42
 Min.   :0.00000        Min.   :0.00000        Min.   : 0.00         
 1st Qu.:0.00000        1st Qu.:0.00000        1st Qu.:11.40         
 Median :0.00000        Median :0.00000        Median :11.60         
 Mean   :0.01771        Mean   :0.02371        Mean   :11.21         
 3rd Qu.:0.00000        3rd Qu.:0.00000        3rd Qu.:11.70         
 Max.   :0.10000        Max.   :0.20000        Max.   :12.10         
 NA's   :1              NA's   :1                                    
 ManufacturingProcess43 ManufacturingProcess44 ManufacturingProcess45
 Min.   : 0.0000        Min.   :0.000          Min.   :0.000         
 1st Qu.: 0.6000        1st Qu.:1.800          1st Qu.:2.100         
 Median : 0.8000        Median :1.900          Median :2.200         
 Mean   : 0.9119        Mean   :1.805          Mean   :2.138         
 3rd Qu.: 1.0250        3rd Qu.:1.900          3rd Qu.:2.300         
 Max.   :11.0000        Max.   :2.100          Max.   :2.600

b. A small percentage of cells in the predictor set contain missing values. Use an imputation function to fill in these missing values (e.g., see Sect. 3.8).

## Separate predictors and response
process_predictors <- ChemicalManufacturingProcess |>
  select(-Yield)

yield <- as.numeric(ChemicalManufacturingProcess$Yield)

# Missing values in predictors
sum(is.na(process_predictors))
[1] 106
# Number of missing values per predictor
missing_counts <- colSums(is.na(process_predictors))

# Display only predictors with missing values
missing_counts[missing_counts > 0]
ManufacturingProcess01 ManufacturingProcess02 ManufacturingProcess03 
                     1                      3                     15 
ManufacturingProcess04 ManufacturingProcess05 ManufacturingProcess06 
                     1                      1                      2 
ManufacturingProcess07 ManufacturingProcess08 ManufacturingProcess10 
                     1                      1                      9 
ManufacturingProcess11 ManufacturingProcess12 ManufacturingProcess14 
                    10                      1                      1 
ManufacturingProcess22 ManufacturingProcess23 ManufacturingProcess24 
                     1                      1                      1 
ManufacturingProcess25 ManufacturingProcess26 ManufacturingProcess27 
                     5                      5                      5 
ManufacturingProcess28 ManufacturingProcess29 ManufacturingProcess30 
                     5                      5                      5 
ManufacturingProcess31 ManufacturingProcess33 ManufacturingProcess34 
                     5                      5                      5 
ManufacturingProcess35 ManufacturingProcess36 ManufacturingProcess40 
                     5                      5                      1 
ManufacturingProcess41 
                     1

c. Split the data into a training and a test set, pre-process the data, and tune a model of your choice from this chapter. What is the optimal value of the performance metric?

library(caret)
library(glmnet)
library(tidyverse)

set.seed(42)

train_index <- createDataPartition(
  y = yield,
  p = 0.80,
  list = FALSE
)

x_train <- process_predictors[train_index, ]
x_test <- process_predictors[-train_index, ]

y_train <- yield[train_index]
y_test <- yield[-train_index]

dim(x_train)
[1] 144  57
dim(x_test)
[1] 32 57
length(y_train)
[1] 144
length(y_test)
[1] 32
# Define preprocessing using training data only
preprocess_model <- preProcess(
  x_train,
  method = c("medianImpute", "nzv", "center", "scale")
)

# Apply the same preprocessing to both datasets
x_train_processed <- predict(preprocess_model, x_train)
x_test_processed <- predict(preprocess_model, x_test)

# Verify missing values
sum(is.na(x_train_processed))
[1] 0
sum(is.na(x_test_processed))
[1] 0
# Check dimensions
dim(x_train_processed)
[1] 144  56
dim(x_test_processed)
[1] 32 56
set.seed(42)

train_control <- trainControl(
  method = "repeatedcv",
  number = 10,
  repeats = 3
)

ridge_model <- caret::train(
  x = x_train,
  y = y_train,
  method = "glmnet",
  preProcess = c("medianImpute", "nzv", "center", "scale"),
  tuneGrid = expand.grid(
    alpha = 0,
    lambda = 10^seq(-4, 2, length.out = 50)
  ),
  trControl = train_control,
  metric = "RMSE"
)

print(ridge_model)
glmnet 

144 samples
 57 predictor

Pre-processing: median imputation (56), centered (56), scaled (56), remove (1) 
Resampling: Cross-Validated (10 fold, repeated 3 times) 
Summary of sample sizes: 129, 129, 130, 129, 130, 130, ... 
Resampling results across tuning parameters:

  lambda        RMSE      Rsquared   MAE     
  1.000000e-04  2.158858  0.5117213  1.298061
  1.325711e-04  2.158858  0.5117213  1.298061
  1.757511e-04  2.158858  0.5117213  1.298061
  2.329952e-04  2.158858  0.5117213  1.298061
  3.088844e-04  2.158858  0.5117213  1.298061
  4.094915e-04  2.158858  0.5117213  1.298061
  5.428675e-04  2.158858  0.5117213  1.298061
  7.196857e-04  2.158858  0.5117213  1.298061
  9.540955e-04  2.158858  0.5117213  1.298061
  1.264855e-03  2.158858  0.5117213  1.298061
  1.676833e-03  2.158858  0.5117213  1.298061
  2.222996e-03  2.158858  0.5117213  1.298061
  2.947052e-03  2.158858  0.5117213  1.298061
  3.906940e-03  2.158858  0.5117213  1.298061
  5.179475e-03  2.158858  0.5117213  1.298061
  6.866488e-03  2.158858  0.5117213  1.298061
  9.102982e-03  2.158858  0.5117213  1.298061
  1.206793e-02  2.158858  0.5117213  1.298061
  1.599859e-02  2.158858  0.5117213  1.298061
  2.120951e-02  2.158858  0.5117213  1.298061
  2.811769e-02  2.158858  0.5117213  1.298061
  3.727594e-02  2.158858  0.5117213  1.298061
  4.941713e-02  2.158858  0.5117213  1.298061
  6.551286e-02  2.158858  0.5117213  1.298061
  8.685114e-02  2.158858  0.5117213  1.298061
  1.151395e-01  2.144871  0.5133782  1.292843
  1.526418e-01  2.083028  0.5187541  1.271108
  2.023590e-01  2.011444  0.5234753  1.247004
  2.682696e-01  1.931524  0.5270870  1.219348
  3.556480e-01  1.846298  0.5293229  1.192087
  4.714866e-01  1.759015  0.5302795  1.167168
  6.250552e-01  1.672964  0.5302470  1.144197
  8.286428e-01  1.591785  0.5298177  1.123704
  1.098541e+00  1.519051  0.5297111  1.108146
  1.456348e+00  1.459301  0.5314437  1.100092
  1.930698e+00  1.419662  0.5368727  1.097915
  2.559548e+00  1.407325  0.5425088  1.100762
  3.393222e+00  1.421855  0.5298408  1.118165
  4.498433e+00  1.448322  0.5079230  1.144858
  5.963623e+00  1.476015  0.4882065  1.178372
  7.906043e+00  1.500852  0.4716366  1.210973
  1.048113e+01  1.522627  0.4576499  1.242323
  1.389495e+01  1.542775  0.4457845  1.270966
  1.842070e+01  1.563173  0.4358073  1.297224
  2.442053e+01  1.585196  0.4275218  1.320770
  3.237458e+01  1.609141  0.4207662  1.342331
  4.291934e+01  1.634258  0.4153639  1.360636
  5.689866e+01  1.659216  0.4111335  1.376917
  7.543120e+01  1.682681  0.4078685  1.392790
  1.000000e+02  1.703687  0.4053749  1.406582

Tuning parameter 'alpha' was held constant at a value of 0
RMSE was used to select the optimal model using the smallest value.
The final values used for the model were alpha = 0 and lambda = 2.559548.
# Best tuning parameters
ridge_model$bestTune
   alpha   lambda
37     0 2.559548
# Results at optimal lambda
best_ridge <- ridge_model$results |>
  filter(lambda == ridge_model$bestTune$lambda)

best_ridge |>
  select(alpha, lambda, RMSE, Rsquared, MAE)
  alpha   lambda     RMSE  Rsquared      MAE
1     0 2.559548 1.407325 0.5425088 1.100762
# Visualize
ggplot(ridge_model$results, aes(x = lambda, y = RMSE)) +
  geom_line(color = "steelblue") +
  geom_point(color = "darkblue", size = 1.5) +
  scale_x_log10() +
  labs(
    title = "Ridge Regression: Cross-Validated RMSE",
    x = "Regularization Parameter (Lambda)",
    y = "Cross-Validated RMSE"
  ) +
  theme_minimal()

# Predict test observations
ridge_predictions <- predict(
  ridge_model,
  newdata = x_test
)

# Test-set performance
ridge_test_results <- postResample(
  pred = ridge_predictions,
  obs = y_test
)

ridge_test_results
     RMSE  Rsquared       MAE 
1.2210206 0.6871973 0.9159219 
# Verify imputation
cat("Missing values before imputation:",
    sum(is.na(x_train)), "\n")
Missing values before imputation: 75 
cat("Missing values after imputation:",
    sum(is.na(x_train_processed)), "\n")
Missing values after imputation: 0 
cat("Missing values in processed test data:",
    sum(is.na(x_test_processed)), "\n")
Missing values in processed test data: 0

Interpretation: Ridge Regression Model

The Chemical Manufacturing Process data set contains 176 observations and 57 predictor variables. The response variable is manufacturing yield, expressed as a percentage.

The data set was divided into training and testing sets, and missing predictor values were handled using median imputation. Near-zero-variance filtering, centering, and scaling were applied during model preprocessing.

Ridge Regression was selected to predict manufacturing yield. Repeated 10-fold cross-validation was used to tune the regularization parameter, lambda, with RMSE as the performance metric.

The model achieved a cross-validated RMSE of approximately 1.4073. This indicates that the model’s prediction errors have a root mean squared magnitude of approximately 1.41 percentage points during cross-validation.

d. Predict the response for the test set. What is the value of the performance metric and how does this compare with the resampled performance metric on the training set?

# Predict response for the test set
ridge_predictions <- predict(
  ridge_model,
  newdata = x_test
)

# Calculate test performance
ridge_test_results <- postResample(
  pred = ridge_predictions,
  obs = y_test
)

ridge_test_results
     RMSE  Rsquared       MAE 
1.2210206 0.6871973 0.9159219 
# Compare training CV and test RMSE
performance_comparison <- tibble(
  Dataset = c("Cross-validation", "Test"),
  RMSE = c(
    min(ridge_model$results$RMSE),
    unname(ridge_test_results["RMSE"])
  )
)

performance_comparison
# A tibble: 2 × 2
  Dataset           RMSE
  <chr>            <dbl>
1 Cross-validation  1.41
2 Test              1.22
# Create prediction data
ridge_test_df <- tibble(
  Actual = y_test,
  Predicted = as.numeric(ridge_predictions)
)

# Plot
ggplot(ridge_test_df, aes(x = Actual, y = Predicted)) +
  geom_point(color = "steelblue", size = 2.5) +
  geom_abline(
    slope = 1,
    intercept = 0,
    linetype = "dashed",
    color = "red"
  ) +
  labs(
    title = "Ridge Regression: Actual vs Predicted Yield",
    x = "Actual Yield (%)",
    y = "Predicted Yield (%)"
  ) +
  theme_minimal()

Interpretation: Test-Set Performance

The Ridge Regression model was evaluated on the testing data set to determine its predictive performance on unseen observations.

The model achieved a test RMSE of approximately 1.2210, compared with a cross-validated RMSE of 1.4073. The lower test RMSE indicates that the model performed slightly better on the held-out observations than during cross-validation.

The actual-versus-predicted scatterplot shows that several observations are close to the diagonal reference line, indicating reasonably accurate predictions. However, some observations are farther from the line, showing that prediction errors remain.

Overall, the results suggest that Ridge Regression provides useful predictions of manufacturing yield, although additional testing would help establish its reliability on future manufacturing runs.

e. Which predictors are most important in the model you have trained? Do either the biological or process predictors dominate the list?

# Variable importance
ridge_importance <- varImp(
  ridge_model,
  scale = TRUE
)

# View importance
ridge_importance
glmnet variable importance

  only 20 most important variables shown (out of 56)

                       Overall
ManufacturingProcess32  100.00
ManufacturingProcess09   78.89
ManufacturingProcess36   71.51
ManufacturingProcess13   70.38
ManufacturingProcess17   68.26
ManufacturingProcess34   54.48
ManufacturingProcess06   45.70
ManufacturingProcess11   43.90
BiologicalMaterial03     40.71
ManufacturingProcess33   40.21
ManufacturingProcess37   38.63
BiologicalMaterial06     32.69
ManufacturingProcess12   29.01
ManufacturingProcess15   27.54
ManufacturingProcess38   24.00
BiologicalMaterial02     22.66
ManufacturingProcess39   22.62
ManufacturingProcess30   20.77
ManufacturingProcess45   19.78
ManufacturingProcess24   19.66
# Plot top 20 predictors
plot(ridge_importance, top = 20)

importance_df <- ridge_importance$importance |>
  tibble::rownames_to_column("Predictor") |>
  arrange(desc(Overall))

top_15 <- importance_df |>
  slice_head(n = 15)

top_15
                Predictor   Overall
1  ManufacturingProcess32 100.00000
2  ManufacturingProcess09  78.88595
3  ManufacturingProcess36  71.51112
4  ManufacturingProcess13  70.37738
5  ManufacturingProcess17  68.25682
6  ManufacturingProcess34  54.47594
7  ManufacturingProcess06  45.69522
8  ManufacturingProcess11  43.90333
9    BiologicalMaterial03  40.71388
10 ManufacturingProcess33  40.21446
11 ManufacturingProcess37  38.62899
12   BiologicalMaterial06  32.69228
13 ManufacturingProcess12  29.01110
14 ManufacturingProcess15  27.54387
15 ManufacturingProcess38  23.99776
ggplot(top_15,
       aes(x = reorder(Predictor, Overall),
           y = Overall)) +
  geom_col(fill = "steelblue") +
  coord_flip() +
  labs(
    title = "Top 15 Important Predictors: Ridge Regression",
    x = "Predictor",
    y = "Variable Importance"
  ) +
  theme_minimal()

names(process_predictors)
 [1] "BiologicalMaterial01"   "BiologicalMaterial02"   "BiologicalMaterial03"  
 [4] "BiologicalMaterial04"   "BiologicalMaterial05"   "BiologicalMaterial06"  
 [7] "BiologicalMaterial07"   "BiologicalMaterial08"   "BiologicalMaterial09"  
[10] "BiologicalMaterial10"   "BiologicalMaterial11"   "BiologicalMaterial12"  
[13] "ManufacturingProcess01" "ManufacturingProcess02" "ManufacturingProcess03"
[16] "ManufacturingProcess04" "ManufacturingProcess05" "ManufacturingProcess06"
[19] "ManufacturingProcess07" "ManufacturingProcess08" "ManufacturingProcess09"
[22] "ManufacturingProcess10" "ManufacturingProcess11" "ManufacturingProcess12"
[25] "ManufacturingProcess13" "ManufacturingProcess14" "ManufacturingProcess15"
[28] "ManufacturingProcess16" "ManufacturingProcess17" "ManufacturingProcess18"
[31] "ManufacturingProcess19" "ManufacturingProcess20" "ManufacturingProcess21"
[34] "ManufacturingProcess22" "ManufacturingProcess23" "ManufacturingProcess24"
[37] "ManufacturingProcess25" "ManufacturingProcess26" "ManufacturingProcess27"
[40] "ManufacturingProcess28" "ManufacturingProcess29" "ManufacturingProcess30"
[43] "ManufacturingProcess31" "ManufacturingProcess32" "ManufacturingProcess33"
[46] "ManufacturingProcess34" "ManufacturingProcess35" "ManufacturingProcess36"
[49] "ManufacturingProcess37" "ManufacturingProcess38" "ManufacturingProcess39"
[52] "ManufacturingProcess40" "ManufacturingProcess41" "ManufacturingProcess42"
[55] "ManufacturingProcess43" "ManufacturingProcess44" "ManufacturingProcess45"
top_15$Predictor
 [1] "ManufacturingProcess32" "ManufacturingProcess09" "ManufacturingProcess36"
 [4] "ManufacturingProcess13" "ManufacturingProcess17" "ManufacturingProcess34"
 [7] "ManufacturingProcess06" "ManufacturingProcess11" "BiologicalMaterial03"  
[10] "ManufacturingProcess33" "ManufacturingProcess37" "BiologicalMaterial06"  
[13] "ManufacturingProcess12" "ManufacturingProcess15" "ManufacturingProcess38"

Interpretation: Important Predictors

The variable importance analysis identified the predictors that contributed most strongly to the Ridge Regression model.

The five most important predictors were ManufacturingProcess32, ManufacturingProcess09, ManufacturingProcess36, ManufacturingProcess13, and ManufacturingProcess17. ManufacturingProcess32 had the highest relative importance.

Among the top 15 predictors, 13 were manufacturing process variables, while only two were biological material variables: BiologicalMaterial03 and BiologicalMaterial06.

These findings indicate that manufacturing process variables dominate the list of important predictors. This suggests that process conditions may play an important role in predicting manufacturing yield. However, the importance rankings do not establish a causal relationship between the predictors and yield.

f. Explore the relationships between each of the top predictors and the response. How could this information be helpful in improving yield in future runs of the manufacturing process?

top_5_predictors <- top_15 |>
  slice_head(n = 5) |>
  pull(Predictor)

top_5_predictors
[1] "ManufacturingProcess32" "ManufacturingProcess09" "ManufacturingProcess36"
[4] "ManufacturingProcess13" "ManufacturingProcess17"
# Prepare the data
relationship_data <- x_train |>
  mutate(Yield = y_train) |>
  select(Yield, all_of(top_5_predictors)) |>
  pivot_longer(
    cols = -Yield,
    names_to = "Predictor",
    values_to = "Value"
  ) |>
  filter(!is.na(Value), !is.na(Yield))
# Plot the relationship
ggplot(
  relationship_data,
  aes(x = Value, y = Yield)
) +
  geom_point(
    color = "steelblue",
    alpha = 0.6
  ) +
  geom_smooth(
    method = "lm",
    se = FALSE,
    color = "red",
    na.rm = TRUE
  ) +
  facet_wrap(
    ~ Predictor,
    scales = "free_x"
  ) +
  labs(
    title = "Relationships Between Top Predictors and Yield",
    x = "Predictor Value",
    y = "Manufacturing Yield (%)"
  ) +
  theme_minimal()
`geom_smooth()` using formula = 'y ~ x'

Interpretation: Relationships Between Important Predictors and Manufacturing Yield

The relationships between the five most important predictors and manufacturing yield were examined using scatterplots with fitted linear regression lines.

ManufacturingProcess32 and ManufacturingProcess09 showed positive relationships with yield. This indicates that manufacturing runs with higher values of these predictors generally achieved higher yields.

In contrast, ManufacturingProcess36, ManufacturingProcess13, and ManufacturingProcess17 showed negative relationships with yield. Higher values of these predictors were generally associated with lower manufacturing yields.

These findings suggest that understanding and monitoring important manufacturing process variables may help improve production efficiency. For example, future experiments could investigate whether adjusting process conditions associated with higher yields leads to improved manufacturing performance.

However, these relationships are observational and do not establish causation. Controlled experiments and further analysis would be necessary to determine which process adjustments can reliably increase yield.