Summary of Question 6.2

Developing a model to predict permeability (see Sect. 1.4) could save significant resources for a pharmaceutical company, while at the same time more rapidly identifying molecules that have a sufficient permeability to become a drug:

Q6.2

(a) Start R and use these commands to load the data:

library(AppliedPredictiveModeling)
## Warning: package 'AppliedPredictiveModeling' was built under R version 4.3.3
data(permeability)

The matrix fingerprints contains the 1,107 binary molecular predictors for the 165 compounds, while permeability contains permeability response.

(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?

library(caret)
## Warning: package 'caret' was built under R version 4.3.1
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 4.3.2
## Loading required package: lattice
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
df = as.data.frame(fingerprints)
df = df |> mutate(target = permeability)

sparse = nearZeroVar(df)
df = df[, -sparse]
dim(df)
## [1] 165 389

(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?

splitdf = createDataPartition(df$target, times = 1, p = 0.8, list = FALSE)
train = df[splitdf, ]
test = df[-splitdf, ]

pls_model = train(target ~ ., data = train, method = "pls", metric="Rsquared",
  center = TRUE,  tuneLength = 20
)
pls_model
## Partial Least Squares 
## 
## 133 samples
## 388 predictors
## 
## No pre-processing
## Resampling: Bootstrapped (25 reps) 
## Summary of sample sizes: 133, 133, 133, 133, 133, 133, ... 
## Resampling results across tuning parameters:
## 
##   ncomp  RMSE      Rsquared   MAE      
##    1     14.37536  0.2274912  10.777179
##    2     12.97285  0.3673994   9.162910
##    3     12.62293  0.4048905   9.159215
##    4     12.56782  0.4121776   9.282698
##    5     12.34446  0.4364912   9.021845
##    6     12.24567  0.4485481   8.999359
##    7     12.28605  0.4511936   9.021218
##    8     12.36131  0.4510389   9.075612
##    9     12.63539  0.4401666   9.362610
##   10     12.85482  0.4335682   9.540994
##   11     13.18977  0.4142683   9.818354
##   12     13.56369  0.3954761  10.042929
##   13     13.76784  0.3866604  10.200634
##   14     14.02767  0.3778859  10.390253
##   15     14.24844  0.3709290  10.517175
##   16     14.50771  0.3627856  10.660456
##   17     14.80342  0.3526557  10.888889
##   18     15.13365  0.3429053  11.119715
##   19     15.56739  0.3291040  11.457589
##   20     15.95736  0.3175673  11.779334
## 
## Rsquared was used to select the optimal model using the largest value.
## The final value used for the model was ncomp = 7.

The optimal number of latent variables is 8, with an associated resampled estimate of R2 of 0.355.

(d) Predict the response for the test set. What is the test set estimate of R2?

predict_test = predict(pls_model, test)
check = data.frame(obs = test$target, pred = predict_test)
colnames(check) = c("obs","pred")
defaultSummary(check)
##       RMSE   Rsquared        MAE 
## 13.0444776  0.3730567 10.5615029

(e) Try building other models discussed in this chapter. Do any have better predictive performance?

# Principal Component Regression (PCR)
pcr_model = train(target ~ ., data = train, method = "pcr",
                   center = TRUE,
                   tuneLength = 20)

predict_pcr = predict(pcr_model, test)

check = data.frame(obs = test$target, pred = predict_pcr)
colnames(check) = c("obs","pred")
defaultSummary(check)
##       RMSE   Rsquared        MAE 
## 11.8182733  0.4726901  9.2716662

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

Considering the performance metrics, ElasticNet or pcr_model could be recommended as a potential model to replace the permeability lab experiment, although the other models showed similar R2 values.

6.3

chemical manufacturing process for a pharmaceutical product was discussed in Sect. 1.4. In this problem, the objective is to understand the relationship between biological measurements of the raw materials (predictors), 6.5 Computing 139 measurements of the manufacturing process (predictors), and the response of product yield. Biological predictors cannot be changed but can be used to assess the quality of the raw material before processing. On the other hand, manufacturing process predictors can be changed in the manufacturing process. Improving product yield by 1% will boost revenue by approximately one hundred thousand dollars per batch:

(a) Start R and use these commands to load the data:

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.

library(AppliedPredictiveModeling)
data("ChemicalManufacturingProcess")
dim(ChemicalManufacturingProcess)
## [1] 176  58

(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).

library(RANN)
## Warning: package 'RANN' was built under R version 4.3.3
library(caret)

imputed_data =preProcess(ChemicalManufacturingProcess, method = c('knnImpute'))
imputed_predictors = predict(imputed_data, newdata = ChemicalManufacturingProcess)

(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?

dfx = imputed_predictors |> select(-Yield)
dfy = imputed_predictors |> select(Yield)

chem_train = createDataPartition(dfy$Yield, p = .80, list = FALSE)
x_train = dfx[chem_train, ]
x_test = dfx[-chem_train, ]
y_train = dfy[chem_train, ]
y_test = dfy[-chem_train, ]

ridgeGrid = data.frame(.lambda = seq(0, 0.1, length = 15))
RRN = train(x = x_train, 
                  y = y_train,
                  method = 'ridge',
                  tuneGrid = ridgeGrid,
                  preProc = c('center', 'scale'))
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.000000 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.007143 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.014286 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.021429 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.028571 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.035714 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.042857 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.050000 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.057143 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.064286 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.071429 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.078571 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.085714 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.092857 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning: model fit failed for Resample07: lambda=0.100000 Error in elasticnet::enet(as.matrix(x), y, lambda = param$lambda) : 
##   Some of the columns of x have zero variance
## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.
RRN
## Ridge Regression 
## 
## 144 samples
##  57 predictor
## 
## Pre-processing: centered (57), scaled (57) 
## Resampling: Bootstrapped (25 reps) 
## Summary of sample sizes: 144, 144, 144, 144, 144, 144, ... 
## Resampling results across tuning parameters:
## 
##   lambda       RMSE       Rsquared    MAE      
##   0.000000000  11.468767  0.07455612  2.6880708
##   0.007142857   3.768007  0.18293925  1.2475967
##   0.014285714   3.007367  0.20550949  1.0828691
##   0.021428571   2.663109  0.22785069  1.0030692
##   0.028571429   2.457563  0.24484955  0.9550250
##   0.035714286   2.317038  0.25845199  0.9215139
##   0.042857143   2.212903  0.26956266  0.8957681
##   0.050000000   2.131531  0.27867198  0.8758151
##   0.057142857   2.065499  0.28620436  0.8599684
##   0.064285714   2.010372  0.29253332  0.8464478
##   0.071428571   1.963321  0.29795773  0.8348169
##   0.078571429   1.922450  0.30270118  0.8246441
##   0.085714286   1.886441  0.30692547  0.8155618
##   0.092857143   1.854347  0.31074658  0.8074497
##   0.100000000   1.825468  0.31424795  0.8001304
## 
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was lambda = 0.1.

The optimal value of the performance metric (RMSE) for the Ridge Regression model is 1.63, achieved with a lambda value of 0.1.

(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_ridge <- predict(RRN, x_test)
defaultSummary(data.frame(pred=predict_ridge,obs=y_test))
##      RMSE  Rsquared       MAE 
## 0.7880706 0.4208757 0.6292523

Comparing these metrics with the resampled performance metric on the training set: The RMSE for the test set (0.6853676) is higher than the resampled RMSE on the training set. The Rsquared for the test set (0.5238997) is lower than the resampled Rsquared on the training set. The MAE for the test set (0.5509677) is comparable to the resampled MAE on the training set.

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

varImp(RRN, scale = FALSE)
## loess r-squared variable importance
## 
##   only 20 most important variables shown (out of 57)
## 
##                        Overall
## ManufacturingProcess32  0.3718
## BiologicalMaterial06    0.3685
## ManufacturingProcess13  0.3255
## BiologicalMaterial03    0.3232
## BiologicalMaterial12    0.2996
## ManufacturingProcess36  0.2948
## BiologicalMaterial02    0.2827
## ManufacturingProcess06  0.2808
## ManufacturingProcess17  0.2748
## ManufacturingProcess09  0.2679
## ManufacturingProcess31  0.2585
## ManufacturingProcess33  0.2114
## BiologicalMaterial04    0.2111
## BiologicalMaterial11    0.2091
## ManufacturingProcess11  0.1874
## BiologicalMaterial08    0.1837
## ManufacturingProcess29  0.1710
## BiologicalMaterial01    0.1684
## ManufacturingProcess02  0.1432
## BiologicalMaterial09    0.1420

Looks like its a mixture and no significant side dominates in feature importance

(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?

library(corrplot)
## Warning: package 'corrplot' was built under R version 4.3.2
## corrplot 0.92 loaded
x <- imputed_predictors %>%
  select(ManufacturingProcess32, ManufacturingProcess13, BiologicalMaterial06, ManufacturingProcess36, ManufacturingProcess17, ManufacturingProcess09, BiologicalMaterial03, BiologicalMaterial02, BiologicalMaterial12, ManufacturingProcess06, ManufacturingProcess31,ManufacturingProcess11,ManufacturingProcess33,BiologicalMaterial11,BiologicalMaterial08,BiologicalMaterial04)
correlations <- cor(x)
corrplot(correlations, method = "color")

most of the ManufacturingProcess features are correlated with eachother, while the Biological features are correlated with eachother. Which najes sense