library(ggplot2)
library(magrittr)

Homework-8 Nonlinear Regression Models

Kuhn, Max. Applied Predictive Modeling (p. 168).

Exercise 7.2

library(caret)
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)

Tune several models on these data. For example:

knnModel <- train(x = trainingData$x,
                  y = trainingData$y,
                  method = "knn",
                  preProcess = 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

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

Neural Network

## Ensure that the maximum absolute pairwise correlation betwween
## the predictors is less than 0.75
findCorrelation(cor(trainingData$x), cutoff = .75)
## integer(0)
## In this case there were no rows identified with such correlation threshold

## Create a specific candidate set of models to evaluate:
nnetGrid <- expand.grid(size = c(1:10),
                        decay = c(0, 0.01, 0.1),
                        bag = FALSE)
ctrl <- trainControl(method = "cv")
nnetTune <- train(trainingData$x, trainingData$y,
                  method = "avNNet",
                  tuneGrid = nnetGrid,
                  trControl = ctrl,
                  preProcess = c("center", "scale"),
                  linout = TRUE,
                  trace = FALSE,
                  MaxNWts = 10 * (ncol(trainingData$x) + 1) + 10 + 1,
                  maxit = 500
                  )
nnetTune
## 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:
## 
##   size  decay  RMSE      Rsquared   MAE     
##    1    0.00   2.434845  0.7683498  1.921367
##    1    0.01   2.437343  0.7689596  1.935100
##    1    0.10   2.450747  0.7652079  1.941971
##    2    0.00   2.564619  0.7437707  2.049075
##    2    0.01   2.493438  0.7576380  2.004657
##    2    0.10   2.470469  0.7623416  1.942559
##    3    0.00   2.107356  0.8283417  1.681631
##    3    0.01   2.118485  0.8252286  1.695232
##    3    0.10   2.113338  0.8296311  1.726697
##    4    0.00   1.993740  0.8454879  1.559778
##    4    0.01   2.055123  0.8382896  1.618923
##    4    0.10   2.111877  0.8360611  1.687825
##    5    0.00   2.173066  0.8230241  1.721098
##    5    0.01   2.117938  0.8262887  1.708309
##    5    0.10   2.126142  0.8313323  1.668135
##    6    0.00   3.011411  0.7133146  2.156020
##    6    0.01   2.245598  0.8059848  1.812856
##    6    0.10   2.200281  0.8204366  1.778666
##    7    0.00   6.423508  0.4711110  3.500348
##    7    0.01   2.369153  0.8044959  1.896450
##    7    0.10   2.277288  0.8082229  1.826526
##    8    0.00   5.161402  0.5296825  3.078540
##    8    0.01   2.375962  0.7935227  1.874543
##    8    0.10   2.355936  0.7886816  1.877549
##    9    0.00   7.052266  0.4257688  4.006578
##    9    0.01   2.443129  0.7865069  1.912185
##    9    0.10   2.242392  0.8071338  1.780744
##   10    0.00   2.906893  0.7036006  2.190651
##   10    0.01   2.516951  0.7569720  2.016432
##   10    0.10   2.238560  0.8113030  1.787851
## 
## 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 and bag
##  = FALSE.
nnetPred <- predict(nnetTune, newdata = testData$x)
postResample(pred = nnetPred, obs = testData$y)
##     RMSE Rsquared      MAE 
## 2.496722 0.784618 1.685182

MARS: Multivariate Adaptive Regression Splines

library(earth)
#marsFit <- earth(trainingData$x, trainingData$y)
#marsFit
#summary(marsFit)
#marsPred <- predict(marsFit, newdata = testData$x)
#postResample(pred = marsPred, obs = testData$y)

marsGrid <- expand.grid(.degree = 1:2, .nprune = 2:38)
marsTuned <- train(trainingData$x, trainingData$y,
                   method = "earth",
                   tuneGrid = marsGrid,
                   trControl = ctrl)
marsTuned
## Multivariate Adaptive Regression Spline 
## 
## 200 samples
##  10 predictor
## 
## No pre-processing
## 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.334325  0.2599883  3.607719
##   1        3      3.599334  0.4805557  2.888987
##   1        4      2.637145  0.7290848  2.087677
##   1        5      2.283872  0.7939684  1.817343
##   1        6      2.125875  0.8183677  1.647491
##   1        7      1.766013  0.8733619  1.410328
##   1        8      1.671282  0.8842102  1.324258
##   1        9      1.645406  0.8867947  1.322041
##   1       10      1.597968  0.8926582  1.297518
##   1       11      1.540109  0.8996361  1.237949
##   1       12      1.545349  0.8992979  1.243771
##   1       13      1.535169  0.9010122  1.233571
##   1       14      1.529405  0.9018457  1.223874
##   1       15      1.529405  0.9018457  1.223874
##   1       16      1.529405  0.9018457  1.223874
##   1       17      1.529405  0.9018457  1.223874
##   1       18      1.529405  0.9018457  1.223874
##   1       19      1.529405  0.9018457  1.223874
##   1       20      1.529405  0.9018457  1.223874
##   1       21      1.529405  0.9018457  1.223874
##   1       22      1.529405  0.9018457  1.223874
##   1       23      1.529405  0.9018457  1.223874
##   1       24      1.529405  0.9018457  1.223874
##   1       25      1.529405  0.9018457  1.223874
##   1       26      1.529405  0.9018457  1.223874
##   1       27      1.529405  0.9018457  1.223874
##   1       28      1.529405  0.9018457  1.223874
##   1       29      1.529405  0.9018457  1.223874
##   1       30      1.529405  0.9018457  1.223874
##   1       31      1.529405  0.9018457  1.223874
##   1       32      1.529405  0.9018457  1.223874
##   1       33      1.529405  0.9018457  1.223874
##   1       34      1.529405  0.9018457  1.223874
##   1       35      1.529405  0.9018457  1.223874
##   1       36      1.529405  0.9018457  1.223874
##   1       37      1.529405  0.9018457  1.223874
##   1       38      1.529405  0.9018457  1.223874
##   2        2      4.334325  0.2599883  3.607719
##   2        3      3.599334  0.4805557  2.888987
##   2        4      2.637145  0.7290848  2.087677
##   2        5      2.271844  0.7927888  1.823675
##   2        6      2.114868  0.8200184  1.659485
##   2        7      1.780140  0.8733216  1.429346
##   2        8      1.663164  0.8891928  1.294968
##   2        9      1.460976  0.9122520  1.180387
##   2       10      1.399692  0.9175376  1.122526
##   2       11      1.380002  0.9216251  1.110556
##   2       12      1.312883  0.9284253  1.063321
##   2       13      1.285612  0.9343029  1.014216
##   2       14      1.328520  0.9286650  1.052185
##   2       15      1.322954  0.9298515  1.045527
##   2       16      1.341454  0.9283961  1.053190
##   2       17      1.344590  0.9280972  1.054209
##   2       18      1.340821  0.9285264  1.050274
##   2       19      1.340821  0.9285264  1.050274
##   2       20      1.340821  0.9285264  1.050274
##   2       21      1.340821  0.9285264  1.050274
##   2       22      1.340821  0.9285264  1.050274
##   2       23      1.340821  0.9285264  1.050274
##   2       24      1.340821  0.9285264  1.050274
##   2       25      1.340821  0.9285264  1.050274
##   2       26      1.340821  0.9285264  1.050274
##   2       27      1.340821  0.9285264  1.050274
##   2       28      1.340821  0.9285264  1.050274
##   2       29      1.340821  0.9285264  1.050274
##   2       30      1.340821  0.9285264  1.050274
##   2       31      1.340821  0.9285264  1.050274
##   2       32      1.340821  0.9285264  1.050274
##   2       33      1.340821  0.9285264  1.050274
##   2       34      1.340821  0.9285264  1.050274
##   2       35      1.340821  0.9285264  1.050274
##   2       36      1.340821  0.9285264  1.050274
##   2       37      1.340821  0.9285264  1.050274
##   2       38      1.340821  0.9285264  1.050274
## 
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were nprune = 13 and degree = 2.
varImp(marsTuned)
## earth variable importance
## 
##     Overall
## X1   100.00
## X4    85.05
## X2    69.03
## X5    48.88
## X3    39.40
## X8     0.00
## X6     0.00
## X9     0.00
## X10    0.00
## X7     0.00
marsPred <- predict(marsTuned, newdata = testData$x)
postResample(pred = marsPred, obs = testData$y)
##      RMSE  Rsquared       MAE 
## 1.2803060 0.9335241 1.0168673

SVM: Support Vector Machines

svmRTuned <- train(trainingData$x, trainingData$y,
                   method = "svmRadial",
                   preProcess = c("center", "scale"),
                   tuneLength = 15,
                   trControl = ctrl)
svmRTuned
## 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.475062  0.7977926  1.976810
##      0.50  2.234423  0.8109248  1.779439
##      1.00  2.038468  0.8361825  1.620497
##      2.00  1.921966  0.8527644  1.509636
##      4.00  1.818693  0.8681554  1.421402
##      8.00  1.779439  0.8753612  1.403365
##     16.00  1.773106  0.8765124  1.417872
##     32.00  1.770587  0.8767984  1.416072
##     64.00  1.770587  0.8767984  1.416072
##    128.00  1.770587  0.8767984  1.416072
##    256.00  1.770587  0.8767984  1.416072
##    512.00  1.770587  0.8767984  1.416072
##   1024.00  1.770587  0.8767984  1.416072
##   2048.00  1.770587  0.8767984  1.416072
##   4096.00  1.770587  0.8767984  1.416072
## 
## Tuning parameter 'sigma' was held constant at a value of 0.06115065
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were sigma = 0.06115065 and C = 32.
svmRPred <- predict(svmRTuned, newdata = testData$x)
postResample(pred = svmRPred, obs = testData$y)
##      RMSE  Rsquared       MAE 
## 2.0695945 0.8263152 1.5720887

Summary

MARS model appears to give the best performance as evident from RMSE value in the table below.

rbind(
  "mars" = postResample(pred = marsPred, obs = testData$y),
  "svm" = postResample(pred = svmRPred, obs = testData$y),
  "net" = postResample(pred = nnetPred, obs = testData$y),
  "knn" = postResample(pred = knnPred, obs = testData$y)
)
##          RMSE  Rsquared      MAE
## mars 1.280306 0.9335241 1.016867
## svm  2.069594 0.8263152 1.572089
## net  2.496722 0.7846180 1.685182
## knn  3.204059 0.6819919 2.568346

The MARS model does select the informative predictors (those named X1-X5) as shown by the variable importance table (varImp) below.

varImp(marsTuned)
## earth variable importance
## 
##     Overall
## X1   100.00
## X4    85.05
## X2    69.03
## X5    48.88
## X3    39.40
## X9     0.00
## X7     0.00
## X10    0.00
## X6     0.00
## X8     0.00

Exercise 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.

  1. Which nonlinear regression model gives the optimal resampling and test set performance?
  2. 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?
  3. 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?

Data Pre-Processing

library(AppliedPredictiveModeling)
data("ChemicalManufacturingProcess")

preP <- preProcess(ChemicalManufacturingProcess, 
                   method = c("BoxCox", "knnImpute", "center", "scale"))
df <- predict(preP, ChemicalManufacturingProcess)
## Restore the response variable values to original
df$Yield = ChemicalManufacturingProcess$Yield

## Split the data into a training and a test set
trainRows <- createDataPartition(df$Yield, p = .80, list = FALSE)
df.train <- df[trainRows, ]
df.test <- df[-trainRows, ]

Nonlinear Regression Models Training

colYield <- which(colnames(df) == "Yield")
trainX <- df.train[, -colYield]
trainY <- df.train$Yield
testX <- df.test[, -colYield]
testY <- df.test$Yield

## KNN Model
knnModel <- train(x = trainX,
                  y = trainY,
                  method = "knn",
                  preProcess = c("center", "scale"),
                  tuneLength = 10)
knnPred <- predict(knnModel, newdata = testX)

## Neural Networks Model
tooHigh <- findCorrelation(cor(trainX), cutoff = .75)
trainXnnet <- trainX[, -tooHigh]
testXnnet <- testX[, -tooHigh]
nnetGrid <- expand.grid(size = c(1:10),
                        decay = c(0, 0.01, 0.1),
                        bag = FALSE)
ctrl <- trainControl(method = "cv")
nnetTune <- train(trainXnnet, trainY,
                  method = "avNNet",
                  tuneGrid = nnetGrid,
                  trControl = ctrl,
                  linout = TRUE,
                  trace = FALSE,
                  MaxNWts = 10 * (ncol(trainingData$x) + 1) + 10 + 1,
                  maxit = 500
                  )
nnetPred <- predict(nnetTune, newdata = testXnnet)

## MARS Model
marsGrid <- expand.grid(.degree = 1:2, .nprune = 2:38)
marsTuned <- train(trainX, trainY,
                   method = "earth",
                   tuneGrid = marsGrid,
                   trControl = ctrl)
marsPred <- predict(marsTuned, newdata = testX)

## SVM Model
svmRTuned <- train(trainX, trainY,
                   method = "svmRadial",
                   tuneLength = 15,
                   trControl = ctrl)
svmRPred <- predict(svmRTuned, newdata = testX)

Part A

print("Train set performance")
## [1] "Train set performance"
rbind(
  "mars" = postResample(pred = predict(marsTuned), obs = trainY),
  "svm" = postResample(pred = predict(svmRTuned), obs = trainY),
  "net" = postResample(pred = predict(nnetTune), obs = trainY),
  "knn" = postResample(pred = predict(knnModel), obs = trainY)
)
##           RMSE  Rsquared       MAE
## mars 1.1120471 0.6158278 0.9054960
## svm  0.3214276 0.9714781 0.2352552
## net  0.9065690 0.7467772 0.7278436
## knn  1.2072326 0.5881212 0.9786301
print("Test set performance")
## [1] "Test set performance"
rbind(
  "mars" = postResample(pred = marsPred, obs = testY),
  "svm" = postResample(pred = svmRPred, obs = testY),
  "net" = postResample(pred = nnetPred, obs = testY),
  "knn" = postResample(pred = knnPred, obs = testY)
)
##          RMSE  Rsquared       MAE
## mars 1.325448 0.6074336 1.0133286
## svm  1.186958 0.6714407 0.9525214
## net  1.949432 0.2532809 1.5542291
## knn  1.528433 0.4980650 1.2285140

Based on the lowest RMSE values, presented above for training and test set performances, SVM appears to be most optimal.

Part B

varImp(svmRTuned)
## loess r-squared variable importance
## 
##   only 20 most important variables shown (out of 57)
## 
##                        Overall
## ManufacturingProcess32  100.00
## ManufacturingProcess36   88.20
## BiologicalMaterial06     77.67
## ManufacturingProcess13   72.24
## ManufacturingProcess31   67.58
## BiologicalMaterial02     64.95
## ManufacturingProcess09   61.65
## BiologicalMaterial12     61.29
## BiologicalMaterial03     58.14
## ManufacturingProcess17   57.23
## ManufacturingProcess29   56.80
## ManufacturingProcess33   55.59
## ManufacturingProcess06   54.88
## BiologicalMaterial04     50.39
## BiologicalMaterial01     44.56
## BiologicalMaterial08     43.96
## ManufacturingProcess11   40.97
## BiologicalMaterial11     39.07
## ManufacturingProcess30   35.43
## ManufacturingProcess26   25.23

The above list shows most important predictors at the top, for the optimal model (SVM). There are slightly more process variables dominating the list rather than biological ones.

The below listings of top ten important predictors from the less optimal models against the SVM model, confirm that process variables dominate the list as being the most important. However, different models selected different process variables in the top ten list of importance.

varImp(marsTuned)
## earth variable importance
## 
##   only 20 most important variables shown (out of 57)
## 
##                        Overall
## ManufacturingProcess32  100.00
## ManufacturingProcess09   53.06
## ManufacturingProcess02    0.00
## BiologicalMaterial08      0.00
## ManufacturingProcess40    0.00
## ManufacturingProcess14    0.00
## BiologicalMaterial07      0.00
## ManufacturingProcess03    0.00
## ManufacturingProcess44    0.00
## BiologicalMaterial03      0.00
## ManufacturingProcess06    0.00
## ManufacturingProcess21    0.00
## ManufacturingProcess17    0.00
## ManufacturingProcess35    0.00
## ManufacturingProcess39    0.00
## ManufacturingProcess16    0.00
## ManufacturingProcess41    0.00
## ManufacturingProcess12    0.00
## ManufacturingProcess04    0.00
## ManufacturingProcess07    0.00
varImp(nnetTune)
## loess r-squared variable importance
## 
##   only 20 most important variables shown (out of 37)
## 
##                        Overall
## ManufacturingProcess36  100.00
## ManufacturingProcess31   76.61
## BiologicalMaterial03     65.90
## ManufacturingProcess17   64.87
## ManufacturingProcess33   63.01
## ManufacturingProcess06   62.21
## BiologicalMaterial11     44.28
## ManufacturingProcess30   40.16
## BiologicalMaterial10     27.41
## ManufacturingProcess12   26.42
## ManufacturingProcess18   26.08
## ManufacturingProcess35   25.24
## ManufacturingProcess20   23.91
## BiologicalMaterial09     23.55
## ManufacturingProcess02   21.83
## ManufacturingProcess04   21.53
## ManufacturingProcess28   19.89
## ManufacturingProcess01   19.68
## ManufacturingProcess24   15.44
## ManufacturingProcess10   15.26
varImp(knnModel)
## loess r-squared variable importance
## 
##   only 20 most important variables shown (out of 57)
## 
##                        Overall
## ManufacturingProcess32  100.00
## ManufacturingProcess36   88.20
## BiologicalMaterial06     77.67
## ManufacturingProcess13   72.24
## ManufacturingProcess31   67.58
## BiologicalMaterial02     64.95
## ManufacturingProcess09   61.65
## BiologicalMaterial12     61.29
## BiologicalMaterial03     58.14
## ManufacturingProcess17   57.23
## ManufacturingProcess29   56.80
## ManufacturingProcess33   55.59
## ManufacturingProcess06   54.88
## BiologicalMaterial04     50.39
## BiologicalMaterial01     44.56
## BiologicalMaterial08     43.96
## ManufacturingProcess11   40.97
## BiologicalMaterial11     39.07
## ManufacturingProcess30   35.43
## ManufacturingProcess26   25.23

Part C

vip <- varImp(svmRTuned)$importance
top10Vars <- head(rownames(vip)[order(-vip$Overall)], 10)
as.data.frame(top10Vars)
##                 top10Vars
## 1  ManufacturingProcess32
## 2  ManufacturingProcess36
## 3    BiologicalMaterial06
## 4  ManufacturingProcess13
## 5  ManufacturingProcess31
## 6    BiologicalMaterial02
## 7  ManufacturingProcess09
## 8    BiologicalMaterial12
## 9    BiologicalMaterial03
## 10 ManufacturingProcess17
#featurePlot(trainX[,top10Vars], trainY)
plotX <- df[,top10Vars]
plotY <- df[,colYield]

## Shorten the variable names for readability
colnames(plotX) <- gsub("(Process|Material)", "", colnames(plotX))
featurePlot(plotX, plotY)

The plots above reveal the relationship between the top 10 predictors and the response. These plots suggest that for the SVM (the optimal model here), the top predictors have much of a linear relationship with the response. Intuitively, one can eiher increase or decrease (depending on the linear slope) the biological or process variables in order to have a better result on the yield (response variable).