Data624HW8
Jaya Veluri
2024-04-06
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:
## Warning: package 'mlbench' was built under R version 4.3.2set.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)
## This creates a list with a vector 'y' and a matrix of predictors 'x'.
testData <- mlbench.friedman1(5000, sd = 1)
testData$x <- data.frame(testData$x)a
Tune several models on these data. For example:
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 perforamnce values
postResample(pred = knnPred, obs = testData$y)## RMSE Rsquared MAE
## 3.2040595 0.6819919 2.5683461Tuned SVM model:
svmRTuned <- train(x = trainingData$x,
y = trainingData$y,
method = "svmRadial",
preProc = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method = "cv"))
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.505383 0.8031869 1.999381
## 0.50 2.290725 0.8103140 1.829703
## 1.00 2.105086 0.8302040 1.677851
## 2.00 2.014620 0.8418576 1.598814
## 4.00 1.965196 0.8491165 1.567327
## 8.00 1.927649 0.8538945 1.542267
## 16.00 1.924262 0.8545293 1.539275
## 32.00 1.924262 0.8545293 1.539275
## 64.00 1.924262 0.8545293 1.539275
## 128.00 1.924262 0.8545293 1.539275
##
## Tuning parameter 'sigma' was held constant at a value of 0.06802164
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were sigma = 0.06802164 and C = 16.svmPred <- predict(svmRTuned, newdata = testData$x)
## The function 'postResample' can be used to get the test set
## perforamnce values
postResample(pred = svmPred, obs = testData$y)## RMSE Rsquared MAE
## 2.0864652 0.8236735 1.5854649Results on test data: RMSE 2.08, Rsquared 0.82, MAE 1.58
Multivariate Adaptive Regression Spline model
## Call: earth(x=trainingData$x, y=trainingData$y)
##
## coefficients
## (Intercept) 18.451984
## h(0.621722-X1) -11.074396
## h(0.601063-X2) -10.744225
## h(X3-0.281766) 20.607853
## h(0.447442-X3) 17.880232
## h(X3-0.447442) -23.282007
## h(X3-0.636458) 15.150350
## h(0.734892-X4) -10.027487
## h(X4-0.734892) 9.092045
## h(0.850094-X5) -4.723407
## h(X5-0.850094) 10.832932
## h(X6-0.361791) -1.956821
##
## Selected 12 of 18 terms, and 6 of 10 predictors
## Termination condition: Reached nk 21
## Importance: X1, X4, X2, X5, X3, X6, X7-unused, X8-unused, X9-unused, ...
## Number of terms at each degree of interaction: 1 11 (additive model)
## GCV 2.540556 RSS 397.9654 GRSq 0.8968524 RSq 0.9183982marsPred <- predict(marsFit, newdata = testData$x)
## The function 'postResample' can be used to get the test set perforamnce values
postResample(pred = marsPred, obs = testData$y)## RMSE Rsquared MAE
## 1.8136467 0.8677298 1.3911836Results on test data: RMSE 1.81, Rsquared 0.87, MAE 1.39
Neural Networks model:
nnetAvg <- avNNet(trainingData$x, trainingData$y,
size = 5,
decay = 0.01,
## Specify how many models to average
repeats = 5,
linout = TRUE,
## Reduce the amount of printed output
trace = FALSE,
## Expand the number of iterations to find
## parameter estimates..
maxit = 500)## Warning: executing %dopar% sequentially: no parallel backend registered## Length Class Mode
## model 5 -none- list
## repeats 1 -none- numeric
## bag 1 -none- logical
## seeds 5 -none- numeric
## names 10 -none- characternnetPred <- predict(nnetAvg, newdata = testData$x)
## The function 'postResample' can be used to get the test set perforamnce values
postResample(pred = nnetPred, obs = testData$y)## RMSE Rsquared MAE
## 1.775923 0.873301 1.317650Results on test data: RMSE 1.77, Rsquared 0.87, MAE 1.31
b
Which models appear to give the best performance? Does MARS select the informative predictors (those named X1–X5)?
The above models all seem to perform very well with only marginal differences, however, they all outperform the KNN model. In terms of best results based on RMSE, Rsquare and MAE, the Neural Networks was the best performing model.
To answer the question whether MARS selects the informative predictors, we can use at the varImp() function, which shows us that this model in fact uses the informative predictors (X1-X5) and X6 as well.
## Overall
## X1 100.00000
## X4 84.21578
## X2 67.21639
## X5 45.44416
## X3 34.63259
## X6 11.903977.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.
## Warning: package 'AppliedPredictiveModeling' was built under R version 4.3.3preProcValues <- preProcess(ChemicalManufacturingProcess, method = c("knnImpute"))
data_imp <- predict(preProcValues, ChemicalManufacturingProcess)set.seed(123)
index <- createDataPartition(data_imp$Yield, p=0.8, list=FALSE)
Train <- data_imp[index, ]
Test <- data_imp[-index, ]das_train <- preProcess(Train, method = c("center", "scale"))
das_test <- preProcess(Test, method = c("center", "scale"))## Warning in preProcess.default(Test, method = c("center", "scale")): These
## variables have zero variances: BiologicalMaterial07KNN
knnModel2 <- train(x = Train[, 2:58],
y = Train$Yield,
method = "knn",
preProc = c("center", "scale"),
tuneLength = 10)## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07knnPred2 <- predict(knnModel2, newdata = Test[, 2:58])
postResample(pred = knnPred2, obs = Test$Yield)## RMSE Rsquared MAE
## 0.7585275 0.4284176 0.6270432SVM
svmRTuned2 <- train(x = Train[, 2:58],
y = Train$Yield,
method = "svmRadial",
preProc = c("center", "scale"),
tuneLength = 10,
trControl = trainControl(method = "cv"))
svmPred2 <- predict(svmRTuned2, newdata = Test[, 2:58])
postResample(pred = svmPred2, obs = Test$Yield)## RMSE Rsquared MAE
## 0.6665632 0.5536012 0.5630546MARS
marsFit2 <- earth(Train_prep[, 2:58], Train_prep$Yield)
marsPred2 <- predict(marsFit2, newdata = Test_prep[, 2:58])
postResample(pred = marsPred2, obs = Test_prep$Yield)## RMSE Rsquared MAE
## 1.76572491 0.05438788 1.28748814NN
nnetAvg2 <- avNNet(Train_prep[, 2:58], Train_prep$Yield,
size = 5,
decay = 0.01,
repeats = 5,
linout = TRUE,
trace = FALSE,
maxit = 500)
nnetPred2 <- predict(nnetAvg2, newdata = Test_prep[, 2:58])
postResample(pred = nnetPred2, obs = Test_prep$Yield)## RMSE Rsquared MAE
## 0.7886255 0.4152242 0.6688686a
Which nonlinear regression model gives the optimal resampling and test set performance?
The nonlinear regression with the optimal resampling and test set performance in this case is the SVM model, which also outperforms by a slight difference the elastic net model used in the previous homework.
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?
## loess r-squared variable importance
##
## only 20 most important variables shown (out of 57)
##
## Overall
## ManufacturingProcess32 100.00
## BiologicalMaterial06 94.06
## BiologicalMaterial03 81.27
## ManufacturingProcess13 80.63
## ManufacturingProcess36 79.17
## ManufacturingProcess31 76.84
## BiologicalMaterial02 76.04
## ManufacturingProcess17 75.92
## ManufacturingProcess09 73.04
## BiologicalMaterial12 69.48
## ManufacturingProcess06 66.28
## BiologicalMaterial11 59.72
## ManufacturingProcess33 58.60
## ManufacturingProcess29 54.77
## BiologicalMaterial04 53.93
## ManufacturingProcess11 49.55
## BiologicalMaterial01 45.62
## BiologicalMaterial08 44.93
## BiologicalMaterial09 40.88
## ManufacturingProcess30 40.31The most important predictor in the SVM model is “ManufacturingProcess32”. However, within the first 20 important predictors we see a good combination of both the biological and process variables.
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?
p1 <- ggplot(data_imp, aes(x = ManufacturingProcess32, y = Yield)) + geom_point()
p2 <- ggplot(data_imp, aes(x = BiologicalMaterial06, y = Yield)) + geom_point()
p3 <- ggplot(data_imp, aes(x = BiologicalMaterial03, y = Yield)) + geom_point()
p4 <- ggplot(data_imp, aes(x = ManufacturingProcess13, y = Yield)) + geom_point()
p5 <- ggplot(data_imp, aes(x = ManufacturingProcess36, y = Yield)) + geom_point()
p6 <- ggplot(data_imp, aes(x = ManufacturingProcess31, y = Yield)) + geom_point()
p7 <- ggplot(data_imp, aes(x = BiologicalMaterial02, y = Yield)) + geom_point()
p8 <- ggplot(data_imp, aes(x = ManufacturingProcess17, y = Yield)) + geom_point()
p9 <- ggplot(data_imp, aes(x = ManufacturingProcess09, y = Yield)) + geom_point()
p10 <- ggplot(data_imp, aes(x = BiologicalMaterial12, y = Yield)) + geom_point()
grid.arrange(p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, nrow = 2)
p11 <- ggplot(data_imp, aes(x = ManufacturingProcess06, y = Yield)) + geom_point()
p12 <- ggplot(data_imp, aes(x = BiologicalMaterial11, y = Yield)) + geom_point()
p13 <- ggplot(data_imp, aes(x = ManufacturingProcess33, y = Yield)) + geom_point()
p14 <- ggplot(data_imp, aes(x = ManufacturingProcess29, y = Yield)) + geom_point()
p15 <- ggplot(data_imp, aes(x = BiologicalMaterial04, y = Yield)) + geom_point()
p16 <- ggplot(data_imp, aes(x = ManufacturingProcess11, y = Yield)) + geom_point()
p17 <- ggplot(data_imp, aes(x = BiologicalMaterial01, y = Yield)) + geom_point()
p18 <- ggplot(data_imp, aes(x = BiologicalMaterial08, y = Yield)) + geom_point()
p19 <- ggplot(data_imp, aes(x = BiologicalMaterial09, y = Yield)) + geom_point()
p20 <- ggplot(data_imp, aes(x = ManufacturingProcess30, y = Yield)) + geom_point()
grid.arrange(p11, p12, p13, p14, p15, p16, p17, p18, p19, p20, nrow = 2)
We can see on the plot of the first 20 important predictors and yield, some of the process variables seem to have either a positive or negative relationship as well as some that do not have a defined relationship such as in the case with process “36”, “31”, “29” and “30”. In the case of the biological variables, they all seem to have a positive relationship with yield. To answer the question above, we can say that these plots reveal intuition about the biological predictors in respect to their relationship with yield.