library(caret)
## Loading required package: ggplot2
## Loading required package: lattice

7.2. Friedman (1991) introduced several benchmark data sets create by simulation. One of these simulations used the following nonlinear equation to create data:

y = 10sin(πx1x2)+20(x3−0.5)2 +10x4 +5x5 +N(0,σ2)

where the x values are random variables uniformly distributed between [0, 1] (there are also 5 other non-informative variables also created in the simulation). The package mlbench contains a function called mlbench.friedman1 that simulates these data:

library(mlbench)
set.seed(200)
trainingData <- mlbench.friedman1(200, sd = 1)
## We convert the 'x' data from a matrix to a data frame
## One reason is that this will give the columns names.
trainingData$x <- data.frame(trainingData$x)
## Look at the data using
featurePlot(trainingData$x, trainingData$y)

## or other methods.

## This creates a list with a vector 'y' and a matrix
## of predictors 'x'. Also simulate a large test set to
## estimate the true error rate with good precision:
testData <- mlbench.friedman1(5000, sd = 1)
testData$x <- data.frame(testData$x)

Keep track of all the RMSE, R2 and MAE that the models provide in this table.

track_data <- data.frame(matrix(vector(), 0, 3,
                dimnames=list(c(), c("RMSE","Rsquared","MAE"))),
                stringsAsFactors=F)
library(caret)

knnModel <- train(x = trainingData$x,
y = trainingData$y,
method = "knn",
preProc = c("center", "scale"),
tuneLength = 10)

knnModel
## k-Nearest Neighbors 
## 
## 200 samples
##  10 predictor
## 
## Pre-processing: centered (10), scaled (10) 
## Resampling: Bootstrapped (25 reps) 
## Summary of sample sizes: 200, 200, 200, 200, 200, 200, ... 
## Resampling results across tuning parameters:
## 
##   k   RMSE      Rsquared   MAE     
##    5  3.466085  0.5121775  2.816838
##    7  3.349428  0.5452823  2.727410
##    9  3.264276  0.5785990  2.660026
##   11  3.214216  0.6024244  2.603767
##   13  3.196510  0.6176570  2.591935
##   15  3.184173  0.6305506  2.577482
##   17  3.183130  0.6425367  2.567787
##   19  3.198752  0.6483184  2.592683
##   21  3.188993  0.6611428  2.588787
##   23  3.200458  0.6638353  2.604529
## 
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was k = 17.
knnPred <- predict(knnModel, newdata = testData$x)
## The function 'postResample' can be used to get the test set
## performance values
postResample(pred = knnPred, obs = testData$y)
##      RMSE  Rsquared       MAE 
## 3.2040595 0.6819919 2.5683461
track_data <- rbind(track_data, postResample(pred = knnPred, obs = testData$y))

Which models appear to give the best performance? Does MARS select the informative predictors (those named X1–X5)?

library(earth)
## Warning: package 'earth' was built under R version 4.3.3
## Loading required package: Formula
## Loading required package: plotmo
## Warning: package 'plotmo' was built under R version 4.3.3
## Loading required package: plotrix
control <- trainControl(method = "cv")
marsGrid <- expand.grid(.degree = 1:2, .nprune = 2:15)
marsModel <- train(trainingData$x, trainingData$y,
                  method = "earth",
                  tuneGrid = marsGrid,
                  preProcess = c("center", "scale"),
                  tuneLength = 10,
                  trControl = control)
print(marsModel)
## Multivariate Adaptive Regression Spline 
## 
## 200 samples
##  10 predictor
## 
## Pre-processing: centered (10), scaled (10) 
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 180, 180, 180, 180, 180, 180, ... 
## Resampling results across tuning parameters:
## 
##   degree  nprune  RMSE      Rsquared   MAE     
##   1        2      4.462296  0.2176253  3.697979
##   1        3      3.720663  0.4673821  2.949121
##   1        4      2.680039  0.7094916  2.123848
##   1        5      2.333538  0.7781559  1.856629
##   1        6      2.367933  0.7754329  1.901509
##   1        7      1.809983  0.8656526  1.414985
##   1        8      1.692656  0.8838936  1.333678
##   1        9      1.704958  0.8845683  1.339517
##   1       10      1.688559  0.8842495  1.309838
##   1       11      1.669043  0.8886165  1.296522
##   1       12      1.645066  0.8892796  1.271981
##   1       13      1.655570  0.8886896  1.271232
##   1       14      1.666354  0.8879143  1.285545
##   1       15      1.666354  0.8879143  1.285545
##   2        2      4.440854  0.2204755  3.686796
##   2        3      3.697203  0.4714312  2.938566
##   2        4      2.664266  0.7149235  2.119566
##   2        5      2.313371  0.7837374  1.852172
##   2        6      2.335796  0.7875253  1.841919
##   2        7      1.833248  0.8623489  1.461538
##   2        8      1.695822  0.8883658  1.329030
##   2        9      1.555106  0.9028532  1.221365
##   2       10      1.497805  0.9088251  1.158054
##   2       11      1.419280  0.9207646  1.139722
##   2       12      1.326566  0.9315939  1.066200
##   2       13      1.266877  0.9354482  1.002983
##   2       14      1.256694  0.9349307  1.006273
##   2       15      1.311401  0.9316487  1.039213
## 
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were nprune = 14 and degree = 2.
# Variable importance for the MARS model
mars_importance <- varImp(marsModel, scale = FALSE)
print(mars_importance)
## earth variable importance
## 
##    Overall
## X1  100.00
## X4   84.98
## X2   68.87
## X5   48.55
## X3   38.96

The predictors that were selected include predictors X1-X5.It selected all of the informative predictors.

marsPred <- predict(marsModel, newdata = testData$x)
track_data <- rbind(track_data, postResample(pred = marsPred, obs = testData$y))
svmModel <- train(x = trainingData$x,
                   y = trainingData$y,
                   method = "svmRadial",
                   preProcess = c("center", "scale"),
                   tuneLength = 10,
                   trControl = control)
svmModel
## Support Vector Machines with Radial Basis Function Kernel 
## 
## 200 samples
##  10 predictor
## 
## Pre-processing: centered (10), scaled (10) 
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 180, 180, 180, 180, 180, 180, ... 
## Resampling results across tuning parameters:
## 
##   C       RMSE      Rsquared   MAE     
##     0.25  2.475865  0.7988016  1.992183
##     0.50  2.214599  0.8166629  1.774775
##     1.00  2.046869  0.8398392  1.623489
##     2.00  1.953012  0.8519284  1.552263
##     4.00  1.891812  0.8587464  1.523110
##     8.00  1.875676  0.8604855  1.532308
##    16.00  1.879154  0.8595207  1.542176
##    32.00  1.879022  0.8595391  1.542105
##    64.00  1.879022  0.8595391  1.542105
##   128.00  1.879022  0.8595391  1.542105
## 
## Tuning parameter 'sigma' was held constant at a value of 0.06437208
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were sigma = 0.06437208 and C = 8.
svmPred <- predict(svmModel, newdata = testData$x)
track_data <- rbind(track_data, postResample(pred = svmPred, obs = testData$y))
nNetGrid <- expand.grid(.decay = c(0, 0.01, .1), .size = c(1:10), .bag = FALSE)
nNetMaxnwts <- 5 * (ncol(trainingData$x) + 1) + 5 + 1
nNetModel <- train(x = trainingData$x,
                    y = trainingData$y,
                    method = "avNNet",
                    preProcess = c("center", "scale"),
                    tuneGrid = nNetGrid,
                    trControl = control,
                    linout = TRUE,
                    trace = FALSE,
                    MaxNWts = nNetMaxnwts,
                    maxit = 500)
nNetModel
## Model Averaged Neural Network 
## 
## 200 samples
##  10 predictor
## 
## Pre-processing: centered (10), scaled (10) 
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 180, 180, 180, 180, 180, 180, ... 
## Resampling results across tuning parameters:
## 
##   decay  size  RMSE      Rsquared   MAE     
##   0.00    1    2.429684  0.7561803  1.906089
##   0.00    2    2.451312  0.7524282  1.952364
##   0.00    3    2.108553  0.8192881  1.691911
##   0.00    4    2.036840  0.8339297  1.638001
##   0.00    5    2.225716  0.8075740  1.710809
##   0.00    6         NaN        NaN       NaN
##   0.00    7         NaN        NaN       NaN
##   0.00    8         NaN        NaN       NaN
##   0.00    9         NaN        NaN       NaN
##   0.00   10         NaN        NaN       NaN
##   0.01    1    2.440122  0.7566066  1.905078
##   0.01    2    2.463550  0.7531100  1.937008
##   0.01    3    2.179972  0.8134175  1.717711
##   0.01    4    2.010663  0.8360269  1.588336
##   0.01    5    2.139806  0.8159192  1.717367
##   0.01    6         NaN        NaN       NaN
##   0.01    7         NaN        NaN       NaN
##   0.01    8         NaN        NaN       NaN
##   0.01    9         NaN        NaN       NaN
##   0.01   10         NaN        NaN       NaN
##   0.10    1    2.444489  0.7553437  1.905998
##   0.10    2    2.545852  0.7405943  1.981505
##   0.10    3    2.155658  0.8184311  1.696357
##   0.10    4    2.111212  0.8254255  1.673740
##   0.10    5    2.127360  0.8236060  1.649902
##   0.10    6         NaN        NaN       NaN
##   0.10    7         NaN        NaN       NaN
##   0.10    8         NaN        NaN       NaN
##   0.10    9         NaN        NaN       NaN
##   0.10   10         NaN        NaN       NaN
## 
## Tuning parameter 'bag' was held constant at a value of FALSE
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were size = 4, decay = 0.01 and bag = FALSE.
nNetPred <- predict(nNetModel, newdata = testData$x)
track_data <- rbind(track_data, postResample(pred = nNetPred, obs = testData$y))
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
colnames(track_data) <- c("RMSE","Rsquared","MAE")
track_data$NAME <- c("KNN", "MARS", "SVM", "Neural Network" )
track_data <- track_data %>% relocate("NAME") %>% arrange(RMSE)
track_data
##             NAME     RMSE  Rsquared      MAE
## 1           MARS 1.277999 0.9338365 1.014707
## 2 Neural Network 1.854921 0.8648991 1.399923
## 3            SVM 2.059968 0.8280925 1.563584
## 4            KNN 3.204059 0.6819919 2.568346

If we look at the table with the data collected from the models, MARS has the best performance with the lowest RMSE (1.278), the highest R-squared (0.934), and the lowest MAE (1.015).

7.5. Exercise 6.3 describes data for a chemical manufacturing process. Use the same data imputation, data splitting, and pre-processing steps as before and train several nonlinear regression models.

Data Prep

library(AppliedPredictiveModeling)
data("ChemicalManufacturingProcess")
sum(is.na(ChemicalManufacturingProcess))
## [1] 106
missing <- preProcess(ChemicalManufacturingProcess, method = "bagImpute")
Chemical <- predict(missing, ChemicalManufacturingProcess)

sum(is.na(Chemical))
## [1] 0
Chemical <- Chemical[, -nearZeroVar(Chemical)]
set.seed(453)

# index for training
index2 <- createDataPartition(Chemical$Yield,  p = .8, list = FALSE)

# train 
train_chem <- Chemical[index2, ]

# test
test_chem <- Chemical[-index2, ]
# Define preprocessing steps for centering and scaling
preProcValues <- preProcess(train_chem, method = c("center", "scale"))

# Apply preprocessing to both training and test sets
training_data2 <- predict(preProcValues, train_chem)
test_data2 <- predict(preProcValues, test_chem)

Train Non-Linear Models

set.seed(123)

# kNN model
knn_model2 <- train(
  Yield ~ ., data = training_data2,
  method = "knn",
  tuneLength = 10,
  trControl = control
)
knn_pred2 <- predict(knn_model2, newdata = test_data2)
## Neural Networks Model
nNetModel2 <- train(Yield ~., data = training_data2,
                  method = "avNNet",
                  tuneGrid = nNetGrid,
                  trControl = control,
                  linout = TRUE,
                  trace = FALSE,
                  MaxNWts = 5 * (ncol(training_data2)) + 5 + 1,
                  maxit = 500
                  )
nNet_pred2 <- predict(nNetModel2, newdata = test_data2)
# SVM model
svmmodel2 <- train(Yield ~., data=training_data2,
                   method = "svmRadial",
                   tuneLength = 15,
                   trControl = control)

svm_pred2 <- predict(svmmodel2, newdata = test_data2)
# MARS model
mars_model <- train(
  Yield ~ ., data = training_data2,
  method = "earth",
  tuneGrid = expand.grid(.degree = 1:2, .nprune = 2:15),
  trControl = control
)
mars_pred2 <- predict(mars_model, newdata = test_data2)
as.data.frame(rbind(
  "mars" = postResample(pred = mars_pred2, obs = test_data2$Yield),
  "svm" = postResample(pred = svm_pred2, obs = test_data2$Yield),
  "nNet" = postResample(pred = nNet_pred2, obs = test_data2$Yield),
  "knn" = postResample(pred = knn_pred2, obs = test_data2$Yield)
)) %>% arrange(RMSE)
##           RMSE  Rsquared       MAE
## nNet 0.4564527 0.7387614 0.3933576
## svm  0.6044264 0.5419110 0.5256355
## knn  0.7220738 0.3450448 0.6192425
## mars 0.8521387 0.3434409 0.6357591

(a) Which nonlinear regression model gives the optimal resampling and test set performance?

The SVM is the optimal non-linear regression model. It has the best overall performance with: The lowest RMSE (0.594), indicating it has the smallest prediction errors. The highest R-squared (0.562), showing it explains the most variance in Yield. The lowest MAE (0.515), indicating the lowest average error in predictions.

(b) Which predictors are most important in the optimal nonlinear regression model? Do either the biological or process variables dominate the list? How do the top ten important predictors compare to the top ten predictors from the optimal linear model?

svm_importance <- varImp(svmmodel2, scale = FALSE)
print(svm_importance)
## loess r-squared variable importance
## 
##   only 20 most important variables shown (out of 56)
## 
##                        Overall
## ManufacturingProcess13  0.3802
## ManufacturingProcess32  0.3499
## BiologicalMaterial03    0.3226
## ManufacturingProcess17  0.3102
## BiologicalMaterial06    0.3078
## ManufacturingProcess09  0.2946
## BiologicalMaterial12    0.2805
## ManufacturingProcess36  0.2536
## ManufacturingProcess06  0.2504
## ManufacturingProcess31  0.2407
## BiologicalMaterial02    0.2398
## BiologicalMaterial11    0.2070
## ManufacturingProcess12  0.1890
## ManufacturingProcess11  0.1734
## BiologicalMaterial08    0.1592
## BiologicalMaterial04    0.1500
## ManufacturingProcess29  0.1462
## BiologicalMaterial09    0.1432
## ManufacturingProcess33  0.1395
## ManufacturingProcess30  0.1307

Based on the importance scores, the Manufacturing Process predictors dominate the top 10 predictors. The top ten predictors in the linear PLS model were dominated by the Manufacturing Process predictors. The results for 6.3 shows that the optimal linear model was the PLS model. The most important variables list from the PLS model showed that the Manufacturing Process variables were dominating.

(c) Explore the relationships between the top predictors and the response for the predictors that are unique to the optimal nonlinear regression model. Do these plots reveal intuition about the biological or process predictors and their relationship with yield?

library(corrplot)
## Warning: package 'corrplot' was built under R version 4.3.3
## corrplot 0.94 loaded
importance <- svm_importance$importance
importance$feature <- rownames(importance)
importance <- importance[order(importance$Overall, decreasing = TRUE), ]

important_features <- importance$feature[1:10]

correlation <- cor(Chemical[, c(important_features, "Yield")])

# Plot
corrplot(correlation, method = "circle")

Manufacturing Process 32 has a strong positive correlation with Yield. It also looks like Manufacturing Process 31 might have a strong negative correlation with Yield.