Упражнение 9

Необходимо построить модель на основе SVM для зависимой переменной high.mpg и объясняющих переменных displacement, acceleration.

Метод подгонки модели: Машина опорных векторов с полиномиальным ядром третьей степени

library('e1071') # SVM 
## Warning: package 'e1071' was built under R version 3.4.3
library('ROCR') # ROC-кривые 
## Warning: package 'ROCR' was built under R version 3.4.4
## Loading required package: gplots
## Warning: package 'gplots' was built under R version 3.4.4
## 
## Attaching package: 'gplots'
## The following object is masked from 'package:stats':
## 
##     lowess
library('ISLR') # данные по экспрессии генов 
## Warning: package 'ISLR' was built under R version 3.4.3
# Классификатор на опорных векторах —----------------------------------------— 

attach(Auto) 

# новая переменная 
High <- ifelse(mpg < 23, 'No', 'Yes') 
# присоединяем к таблице данных 
Auto <- data.frame(Auto, High) 

# таблица с данными, отклик — фактор 
dat <- data.frame(displacement, acceleration, High = as.factor(High)) 
plot(displacement, acceleration, col = as.factor(High), pch = 19) 

# обучающая выборка 
train <- sample(1:nrow(dat), nrow(dat)/2) 

# SVM с полиномиальным ядром и маленьким cost 
svmfit <- svm(High ~ ., data = dat[train, ], kernel = "polynomial", 
              gamma = 1, degree = 3, cost = 1) 
plot(svmfit, dat[train, ]) 

summary(svmfit) 
## 
## Call:
## svm(formula = High ~ ., data = dat[train, ], kernel = "polynomial", 
##     gamma = 1, degree = 3, cost = 1)
## 
## 
## Parameters:
##    SVM-Type:  C-classification 
##  SVM-Kernel:  polynomial 
##        cost:  1 
##      degree:  3 
##       gamma:  1 
##      coef.0:  0 
## 
## Number of Support Vectors:  84
## 
##  ( 42 42 )
## 
## 
## Number of Classes:  2 
## 
## Levels: 
##  No Yes
# SVM с полиномиальным ядром и большим cost 
svmfit <- svm(High ~ ., data = dat[train, ], kernel = "polynomial", 
              gamma = 1, degree = 3, cost = 1e4) 
plot(svmfit, dat[train, ]) 

# перекрёстная проверка 
tune.out <- tune(svm, High ~ ., data = dat[train, ], kernel = "polynomial", 
                 ranges = list(cost = c(0.1, 1, 10), degree = 3, 
                               gamma = c(0.5, 1, 2, 3, 4))) 
summary(tune.out) 
## 
## Parameter tuning of 'svm':
## 
## - sampling method: 10-fold cross validation 
## 
## - best parameters:
##  cost degree gamma
##    10      3     1
## 
## - best performance: 0.1223684 
## 
## - Detailed performance results:
##    cost degree gamma     error dispersion
## 1   0.1      3   0.5 0.2392105 0.11014589
## 2   1.0      3   0.5 0.1878947 0.10540342
## 3  10.0      3   0.5 0.1431579 0.08519346
## 4   0.1      3   1.0 0.1931579 0.09259436
## 5   1.0      3   1.0 0.1381579 0.08620848
## 6  10.0      3   1.0 0.1223684 0.09282716
## 7   0.1      3   2.0 0.1328947 0.08647584
## 8   1.0      3   2.0 0.1223684 0.09282716
## 9  10.0      3   2.0 0.1223684 0.09282716
## 10  0.1      3   3.0 0.1378947 0.08932047
## 11  1.0      3   3.0 0.1223684 0.09282716
## 12 10.0      3   3.0 0.1223684 0.09282716
## 13  0.1      3   4.0 0.1328947 0.08996468
## 14  1.0      3   4.0 0.1223684 0.09282716
## 15 10.0      3   4.0 0.1223684 0.09282716

Матрица неточностей для прогноза по лучшей модели

t1 <- table(true = dat[-train, "High"], 
      pred = predict(tune.out$best.model, newdata = dat[-train, ])) 
t1
##      pred
## true  No Yes
##   No  86  15
##   Yes 10  85
tune.out$best.model 
## 
## Call:
## best.tune(method = svm, train.x = High ~ ., data = dat[train, 
##     ], ranges = list(cost = c(0.1, 1, 10), degree = 3, gamma = c(0.5, 
##     1, 2, 3, 4)), kernel = "polynomial")
## 
## 
## Parameters:
##    SVM-Type:  C-classification 
##  SVM-Kernel:  polynomial 
##        cost:  10 
##      degree:  3 
##       gamma:  1 
##      coef.0:  0 
## 
## Number of Support Vectors:  81
#MSE
sum(diag(t1))/sum(t1)
## [1] 0.872449

Точность модели достаточно высока

# функция построения ROC-кривой: pred — прогноз, truth — факт 
rocplot <- function(pred, truth, ...){ 
  predob = prediction(pred, truth) 
  perf = performance(predob, "tpr", "fpr") 
  plot(perf,...)} 

# последняя оптимальная модель 
svmfit.opt <- svm(High ~ ., data = dat[train, ], 
                  kernel = "polynomial", gamma = 0.5, degree = 3, cost = 1000, decision.values = T) 

# количественные модельные значения, на основе которых присваивается класс 
fitted <- attributes(predict(svmfit.opt, dat[train, ], 
                             decision.values = TRUE))$decision.values 

# график для обучающей выборки 
par(mfrow = c(1, 2)) 
rocplot(fitted, dat[train, "High"], main = "Training Data") 

# более гибкая модель (gamma выше) 
svmfit.flex = svm(High ~ ., data = dat[train, ], kernel = "polynomial", 
                  gamma = 10, degree = 3, cost = 1000, decision.values = T) 

fitted <- attributes(predict(svmfit.flex, dat[train, ], 
                             decision.values = T))$decision.values 
rocplot(fitted, dat[train,"High"], add = T, col = "red") 

# график для тестовой выборки 
fitted <- attributes(predict(svmfit.opt, dat[-train, ], 
                             decision.values = T))$decision.values 
rocplot(fitted, dat[-train, "High"], main = "Test Data") 

fitted <- attributes(predict(svmfit.flex, dat[-train, ], 
                             decision.values = T))$decision.values 
rocplot(fitted, dat[-train, "High"], add = T, col = "red") 

par(mfrow = c(1, 1)) 

detach(Auto)

Видно, что ROC-кривые показывают достаточное количество неточных предсказаний. Я предполагаю, что это связано с малым количеством объясняющих переменных и с неоднородностью выборки