DATA624HW8
2024-11-9
Import Libraries
library(caret)## Warning: package 'caret' was built under R version 4.3.3## Loading required package: ggplot2## Warning: package 'ggplot2' was built under R version 4.3.3## Loading required package: latticelibrary(nnet)
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: plotrixlibrary(kernlab)## Warning: package 'kernlab' was built under R version 4.3.3##
## Attaching package: 'kernlab'## The following object is masked from 'package:ggplot2':
##
## alphalibrary(mlbench)## Warning: package 'mlbench' was built under R version 4.3.3library(AppliedPredictiveModeling)## Warning: package 'AppliedPredictiveModeling' was built under R version 4.3.3library(RANN)## Warning: package 'RANN' was built under R version 4.3.3library(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, union7.2
set.seed(200)
trainingData <- mlbench.friedman1(200, sd = 1)
## We convert the 'x" data from a matrix to a dataframe
## 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 maxtrix
## of predictors 'x'. Also simulates 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)
## Example of Tuning a Model is
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.5683461Variant Models
Neural Networks
# 1 Neural Network Layer containing 5 hidden layers
nnetfit <- nnet(trainingData$x, trainingData$y,
size = 5,
decay = 0.01,
linout = TRUE,
trace = FALSE,
maxit = 500,
MaxNWts = 5 * (ncol(trainingData$x) + 1) + 5 + 1)
nnet1_pred <- predict(nnetfit, newdata = testData$x)
postResample(pred = nnet1_pred, obs = testData$y)## RMSE Rsquared MAE
## 2.5244877 0.7621849 1.8722728# Average Neural Network Model
nnetavg <- avNNet(trainingData$x, trainingData$y,
size = 5,
decay = 0.01,
repeats = 5,
linout = TRUE,
trace = FALSE,
maxit = 500,
MaxNWts = 5 * (ncol(trainingData$x) + 1) + 5 + 1)## Warning: executing %dopar% sequentially: no parallel backend registerednnet2_pred <- predict(nnetavg, newdata = testData$x)
postResample(pred = nnet2_pred, obs = testData$y)## RMSE Rsquared MAE
## 2.0404770 0.8331947 1.5329094Multivariate Adaptive Regression Splines (MARS)
marsfit <- earth(trainingData$x, trainingData$y)
marsfit## 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.9183982summary(marsfit)## 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.9183982mars_pred1 <- predict(marsfit, newdata = testData$x)
postResample(pred = mars_pred1, obs = testData$y)## RMSE Rsquared MAE
## 1.8136467 0.8677298 1.3911836marsGrid <- expand.grid(.degree = 1:2, .nprune = 2:16)
set.seed(334)
# Tuning MARS based on Cross-Validation
marstuned <- train(trainingData$x, trainingData$y,
method = "earth",
tuneGrid = marsGrid,
trControl = trainControl(method = "cv"))
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.215043 0.2958829 3.4715006
## 1 3 3.596326 0.4925289 2.9105998
## 1 4 2.685802 0.7205596 2.1332921
## 1 5 2.457939 0.7645088 1.9835490
## 1 6 2.408785 0.7936804 1.9029015
## 1 7 1.946327 0.8555392 1.5609017
## 1 8 1.780400 0.8811200 1.4047687
## 1 9 1.688583 0.8901135 1.3192783
## 1 10 1.682062 0.8909456 1.3250403
## 1 11 1.646291 0.8973754 1.2914038
## 1 12 1.656040 0.8952787 1.2772892
## 1 13 1.653213 0.8953591 1.2818334
## 1 14 1.680246 0.8916559 1.3003684
## 1 15 1.680656 0.8915064 1.2995570
## 1 16 1.680656 0.8915064 1.2995570
## 2 2 4.215043 0.2958829 3.4715006
## 2 3 3.594757 0.4933080 2.9114298
## 2 4 2.683231 0.7210424 2.1310233
## 2 5 2.449310 0.7637838 1.9578090
## 2 6 2.333471 0.7894762 1.8489458
## 2 7 1.897656 0.8619660 1.5248216
## 2 8 1.719145 0.8846421 1.3595734
## 2 9 1.473660 0.9158201 1.1974286
## 2 10 1.380194 0.9257455 1.0992083
## 2 11 1.272798 0.9368827 1.0053695
## 2 12 1.227547 0.9419180 0.9692761
## 2 13 1.230587 0.9413298 0.9725188
## 2 14 1.202656 0.9445373 0.9394496
## 2 15 1.190089 0.9458320 0.9283424
## 2 16 1.189953 0.9456648 0.9346434
##
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were nprune = 16 and degree = 2.mars_pred2 <- predict(marstuned, newdata = testData$x)
postResample(pred = mars_pred2, obs = testData$y)## RMSE Rsquared MAE
## 1.1492504 0.9471145 0.9158382Support Vector Machines
svmfit <- ksvm(x = as.matrix(trainingData$x), y = trainingData$y,
kernel = "rbfdot", kpar = "automatic",
C = 1, epsilon = 0.1)
svmr_pred1 <- predict(svmfit, newdata = testData$x)
postResample(pred = svmr_pred1, obs = testData$y)## RMSE Rsquared MAE
## 2.2566786 0.7990135 1.7223733svmrtuned <- train(trainingData$x, trainingData$y,
method = "svmRadial",
preProc = c("center", "scale"),
tuneLength = 14,
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.494175 0.8024728 1.993835
## 0.50 2.243663 0.8155481 1.777142
## 1.00 2.057937 0.8395877 1.624516
## 2.00 1.950295 0.8508529 1.534357
## 4.00 1.888448 0.8562437 1.482902
## 8.00 1.876818 0.8564835 1.490836
## 16.00 1.886530 0.8552723 1.499634
## 32.00 1.886530 0.8552723 1.499634
## 64.00 1.886530 0.8552723 1.499634
## 128.00 1.886530 0.8552723 1.499634
## 256.00 1.886530 0.8552723 1.499634
## 512.00 1.886530 0.8552723 1.499634
## 1024.00 1.886530 0.8552723 1.499634
## 2048.00 1.886530 0.8552723 1.499634
##
## Tuning parameter 'sigma' was held constant at a value of 0.0668599
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were sigma = 0.0668599 and C = 8.svmrtuned$finalModel## Support Vector Machine object of class "ksvm"
##
## SV type: eps-svr (regression)
## parameter : epsilon = 0.1 cost C = 8
##
## Gaussian Radial Basis kernel function.
## Hyperparameter : sigma = 0.066859902035286
##
## Number of Support Vectors : 153
##
## Objective Function Value : -67.2203
## Training error : 0.008897svmr_pred2 <- predict(svmrtuned, newdata = testData$x)
postResample(pred = svmr_pred2, obs = testData$y)## RMSE Rsquared MAE
## 2.0715241 0.8262178 1.5731231In the analysis, we compared both the basic and optimized versions of each Non-Linear Model, except for KNN. For the base models, Multivariate Adaptive Regression Splines (MARS) performed the best, with an RMSE of 1.813 and an R-Squared of 0.8677. When optimized, MARS still led with improved scores: an RMSE of 1.1492 and an R-Squared of 0.947.
Among the other models, the Support Vector Machine (SVM) base model was next in performance, followed by the Neural Network, and finally, K-Nearest Neighbor (KNN). But with optimization, the Neural Network slightly outperformed SVM.
MARS identified X1 through X5 as the most useful predictors, while variables X7 to X10 didn’t seem to contribute. The top predictors were X1 through X5, with X6 slightly less important.
7.5
A
data("ChemicalManufacturingProcess")
impute <- preProcess(ChemicalManufacturingProcess, method = "knnImpute")
imputed <- predict(impute, ChemicalManufacturingProcess)
X <- dplyr::select(imputed, -Yield)
y <- imputed$Yield
set.seed(22)
index <- createDataPartition(y, p = .8, list = FALSE)
train_X <- X[index, ] %>% as.matrix()
test_X <- X[-index, ] %>% as.matrix()
train_y <- y[index]
test_y <- y[-index]K-Nearest Neighbor
knnmodel_2 <- train(x = train_X, y = train_y,
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: 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: BiologicalMaterial07
## Warning in preProcess.default(thresh = 0.95, k = 5, freqCut = 19, uniqueCut =
## 10, : These variables have zero variances: BiologicalMaterial07knnpred2 <- predict(knnmodel_2, newdata = test_X)
postResample(pred = knnpred2, obs = test_y)## RMSE Rsquared MAE
## 0.6514929 0.4499752 0.5493612Multivariate Adaptive Regression Splines (MARS)
marsGrid2 <- expand.grid(.degree = 1:2, .nprune = 2:58)
marstuned2 <- train(x = train_X, y = train_y,
method = "earth",
tuneGrid = marsGrid,
trControl = trainControl(method = "cv"))
marspred2 <- predict(marstuned2, newdata = test_X)
postResample(pred = marspred2, obs = test_y)## RMSE Rsquared MAE
## 0.6384544 0.4975974 0.4921832Support Vector Machines
svmrtuned2 <- train(x = train_X, y = train_y,
method = "svmRadial",
preProc = c("center", "scale"),
tuneLength = 14,
trControl = trainControl(method = "cv"))
svmrpred2 <- predict(svmrtuned2, newdata = test_X)
postResample(pred = svmrpred2, obs = test_y)## RMSE Rsquared MAE
## 0.6449523 0.4399861 0.5114197Neural Network
nnetavg2 <- avNNet(x = train_X, y = train_y,
size = 5,
decay = 0.01,
repeats = 5,
linout = TRUE,
trace = FALSE,
maxit = 500,
MaxNWts = 5 * (ncol(train_X) + 1) + 5 + 1)
nnetpred2 <- predict(nnetavg2, newdata = test_X)
postResample(pred = nnetpred2, obs = test_y)## RMSE Rsquared MAE
## 0.8184245 0.4615477 0.6572464The MARS model delivered the best performance among the Non-Linear Regression models on both the resampling and test sets, achieving an impressive RMSE of 0.6385 and an R-Squared of 0.4976. While KNN and Support Vector Machine showed similar performance, the Neural Network model had a higher RMSE despite having a higher R-Squared than KNN and SVM.
B
varImp(marstuned2)## earth variable importance
##
## Overall
## ManufacturingProcess32 100.00
## ManufacturingProcess09 47.83
## ManufacturingProcess13 0.00marstuned3 <- earth(x = train_X, y = train_y)
imp1 <- varImp(marstuned3)
varImp(marstuned3)The top 10 predictors are mostly related to the Manufacturing Process, with ManufacturingProcess 32, 09, and 13 ranking the highest overall, while the biological material predictors are further down the list. When comparing these to the top 10 predictors from the linear model, we see that both models share MP32, MP09, MP13, and MP33. However, the non-linear regression model includes only two biological material predictors, whereas the linear model includes three.
C
top_pred <- c("ManufacturingProcess32", "ManufacturingProcess09", "ManufacturingProcess13",
"ManufacturingProcess39", "ManufacturingProcess22", "ManufacturingProcess28",
"BiologicalMaterial12", "BiologicalMaterial03", "ManufacturingProcess01",
"ManufacturingProcess33")
for(i in top_pred) {
plot_data <- data.frame(X = X[[i]], Y = y)
p <- ggplot(plot_data, aes_string(x = "X", y = "Y")) +
geom_point(alpha = 0.5) +
geom_smooth(method = "lm", color = "blue", se = FALSE) +
labs(title = paste("Relationship between", i, "and Yield"),
x = i, y = "Yield") +
theme_minimal()
print(p)
}## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## `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'