packages <- c(
  "AppliedPredictiveModeling",
  "caret",
  "pls",
  "glmnet"
)

new_packages <- packages[
  !packages %in% installed.packages()[, "Package"]
]

if (length(new_packages) > 0) {
  install.packages(new_packages)
}

library(AppliedPredictiveModeling)
library(caret)
## Loading required package: ggplot2
## Loading required package: lattice
library(pls)
## 
## Attaching package: 'pls'
## The following object is masked from 'package:caret':
## 
##     R2
## The following object is masked from 'package:stats':
## 
##     loadings
library(glmnet)
## Loading required package: Matrix
## Loaded glmnet 5.2
set.seed(123)

Problem 6.2

a

data(permeability)

dim(permeability)
## [1] 165   1
head(permeability)
##   permeability
## 1       12.520
## 2        1.120
## 3       19.405
## 4        1.730
## 5        1.680
## 6        0.510

b

nzv <- nearZeroVar(fingerprints)

fp_filtered <- fingerprints[, -nzv]

dim(fp_filtered)
## [1] 165 388

The nearZeroVar function removed predictors with very low variation. This reduced the number of predictors from 1,107 to 388, which were used for modeling.

c

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

train_x <- fp_filtered[train_index, ]
test_x <- fp_filtered[-train_index, ]

train_y <- permeability[train_index]
test_y <- permeability[-train_index]

control <- trainControl(
  method = "repeatedcv",
  number = 10,
  repeats = 5
)

set.seed(123)

pls_model <- train(
  x = train_x,
  y = train_y,
  method = "pls",
  preProcess = c("center", "scale"),
  tuneLength = 20,
  trControl = control,
  metric = "RMSE"
)

pls_model$bestTune
dplyr::filter(
  pls_model$results,
  ncomp == pls_model$bestTune$ncomp
)

The data were divided into 80% training and 20% testing sets. A PLS model was trained using centered and scaled predictors. Repeated 10-fold cross-validation with 5 repeats selected 7 components as optimal. The resampled R-squared was 0.513.

d

pls_predictions <- predict(
  pls_model,
  newdata = test_x
)

postResample(
  pred = pls_predictions,
  obs = test_y
)
##       RMSE   Rsquared        MAE 
## 11.9744490  0.3618213  8.3021291

The PLS model was evaluated using the testing dataset. It produced an RMSE of 11.97, an R-squared of 0.362, and an MAE of 8.30. This indicates that the model explains approximately 36.2% of the variation in permeability.

e

set.seed(123)

enet_model <- train(
  x = train_x,
  y = train_y,
  method = "glmnet",
  preProcess = c("center", "scale"),
  tuneLength = 10,
  trControl = control,
  metric = "RMSE"
)
## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.
enet_model$bestTune
enet_model$results
enet_predictions <- predict(
  enet_model,
  newdata = test_x
)

postResample(
  pred = enet_predictions,
  obs = test_y
)
##       RMSE   Rsquared        MAE 
## 11.0500977  0.3655409  7.2856720
pls_results <- postResample(
  predict(pls_model, newdata = test_x),
  test_y
)

enet_results <- postResample(
  enet_predictions,
  test_y
)

rbind(
  PLS = pls_results,
  Elastic_Net = enet_results
)
##                 RMSE  Rsquared      MAE
## PLS         11.97445 0.3618213 8.302129
## Elastic_Net 11.05010 0.3655409 7.285672

An Elastic Net model was developed and compared with the PLS model using the same training and testing datasets. Elastic Net performed slightly better, with a test RMSE of 11.05, an R-squared of 0.366, and an MAE of 7.29. However, the improvement was small, and both models have limited predictive ability.

F

I would not recommend replacing the permeability laboratory experiment entirely. Although Elastic Net performed slightly better than PLS, its test R-squared was only 0.366. The model could be useful as an initial screening tool to identify promising compounds and prioritize laboratory testing. However, laboratory experiments should remain the final method of confirmation.

Problem 6.3

a

if (!requireNamespace("AppliedPredictiveModeling", quietly = TRUE)) {
  install.packages("AppliedPredictiveModeling")
}

if (!requireNamespace("caret", quietly = TRUE)) {
  install.packages("caret")
}

if (!requireNamespace("RANN", quietly = TRUE)) {
  install.packages("RANN")
}

library(AppliedPredictiveModeling)
library(caret)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
data(ChemicalManufacturingProcess)

dim(ChemicalManufacturingProcess)
## [1] 176  58
head(ChemicalManufacturingProcess)
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 ...

b

cmp_y <- ChemicalManufacturingProcess$Yield

cmp_x <- ChemicalManufacturingProcess |>
  select(-Yield)

missing_counts <- colSums(is.na(cmp_x))

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
set.seed(123)

cmp_imputer <- preProcess(
  cmp_x,
  method = "knnImpute"
)

cmp_x_imputed <- predict(
  cmp_imputer,
  cmp_x
)

sum(is.na(cmp_x_imputed))
## [1] 0

Missing values were found in several manufacturing-process predictors. KNN imputation was used to replace them based on similar observations. After imputation, the dataset contained zero missing predictor values.

c

set.seed(123)

cmp_index <- createDataPartition(
  cmp_y,
  p = 0.80,
  list = FALSE
)

cmp_train_x <- cmp_x[cmp_index, ]
cmp_test_x <- cmp_x[-cmp_index, ]

cmp_train_y <- cmp_y[cmp_index]
cmp_test_y <- cmp_y[-cmp_index]

control <- trainControl(
  method = "repeatedcv",
  number = 10,
  repeats = 5
)

set.seed(123)

cmp_pls_model <- train(
  x = cmp_train_x,
  y = cmp_train_y,
  method = "pls",
  preProcess = c("knnImpute", "center", "scale"),
  tuneLength = 10,
  trControl = control,
  metric = "RMSE"
)

cmp_pls_model$bestTune
cmp_pls_model$results

The data were divided into 80% training and 20% testing sets. A PLS model was trained using KNN imputation, centering, and scaling. Repeated 10-fold cross-validation with 5 repeats selected 3 components as optimal, with an RMSE of 1.35 and an R-squared of 0.586.

d

cmp_predictions <- predict(
  cmp_pls_model,
  newdata = cmp_test_x
)

postResample(
  pred = cmp_predictions,
  obs = cmp_test_y
)
##      RMSE  Rsquared       MAE 
## 1.3618829 0.4820735 1.1602099

The PLS model was evaluated using the testing dataset. It produced an RMSE of 1.36, an R-squared of 0.482, and an MAE of 1.16. The test results were slightly worse than the cross-validation results, but the RMSE remained similar. This suggests the model performs reasonably well on new observations.

e

cmp_importance <- varImp(
  cmp_pls_model,
  scale = FALSE
)

cmp_top10 <- cmp_importance$importance[
  order(cmp_importance$importance$Overall, decreasing = TRUE),
  ,
  drop = FALSE
]

head(cmp_top10, 10)
plot(
  cmp_importance,
  top = 15,
  main = "Top 15 Predictors of Manufacturing Yield"
)

Variable importance was used to identify the most important predictors. ManufacturingProcess32 was the strongest predictor, followed by ManufacturingProcess17 and ManufacturingProcess13. Seven of the top ten predictors were manufacturing-process variables, suggesting that manufacturing conditions play an important role in predicting yield.

f

if (!requireNamespace("ggplot2", quietly = TRUE)) {
  install.packages("ggplot2")
}

library(ggplot2)

top_vars <- rownames(cmp_top10)[1:10]

cmp_plot_data <- cmp_x_imputed |>
  mutate(Yield = cmp_y)

for (v in top_vars) {
  print(
    ggplot(cmp_plot_data, aes(x = .data[[v]], y = Yield)) +
      geom_point() +
      geom_smooth(method = "loess", se = FALSE) +
      labs(
        title = paste("Yield vs", v),
        x = v,
        y = "Product Yield"
      )
  )
}
## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'

The plots show that several predictors have relationships with manufacturing yield. ManufacturingProcess09 and BiologicalMaterial02 show generally positive relationships, while ManufacturingProcess17 and ManufacturingProcess13 show generally negative relationships. Other predictors show nonlinear patterns.

These relationships can help identify manufacturing conditions associated with higher yields. Since manufacturing-process variables can be adjusted, they may help guide future process improvements. Biological-material variables can help assess the quality of incoming materials. Further testing would be needed to confirm which changes actually improve yield.