library(neuralnet)
library(MASS)
library(randomForest)
library(nnet)



data <- Boston

set.seed(500)
index <- sample(1:nrow(data),round(0.75*nrow(data)))
train <- data[index,]
test <- data[-index,]

Регрессия

Линейная регрессия

lm.fit <- glm(medv~., data=train)
summary(lm.fit)
## 
## Call:
## glm(formula = medv ~ ., data = train)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -14.9143   -2.8607   -0.5244    1.5242   25.0004  
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  43.469681   6.099347   7.127 5.50e-12 ***
## crim         -0.105439   0.057095  -1.847 0.065596 .  
## zn            0.044347   0.015974   2.776 0.005782 ** 
## indus         0.024034   0.071107   0.338 0.735556    
## chas          2.596028   1.089369   2.383 0.017679 *  
## nox         -22.336623   4.572254  -4.885 1.55e-06 ***
## rm            3.538957   0.472374   7.492 5.15e-13 ***
## age           0.016976   0.015088   1.125 0.261291    
## dis          -1.570970   0.235280  -6.677 9.07e-11 ***
## rad           0.400502   0.085475   4.686 3.94e-06 ***
## tax          -0.015165   0.004599  -3.297 0.001072 ** 
## ptratio      -1.147046   0.155702  -7.367 1.17e-12 ***
## black         0.010338   0.003077   3.360 0.000862 ***
## lstat        -0.524957   0.056899  -9.226  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 23.26491)
## 
##     Null deviance: 33642  on 379  degrees of freedom
## Residual deviance:  8515  on 366  degrees of freedom
## AIC: 2290
## 
## Number of Fisher Scoring iterations: 2
pr.lm <- predict(lm.fit,test)
MSE.lm <- sum((pr.lm - test$medv)^2)/nrow(test)

MSE.lm
## [1] 21.62976

Нейронная сеть

Для нейронной сети необходимо стандартизировать данные.

scaled <- as.data.frame(scale(data))
train_ <- scaled[index,]
test_ <- scaled[-index,]

test.error <- NULL
train.error <- NULL
crossvalidate <- function(data,hidden_l=c(5))
{
      scaled <- as.data.frame(scale(data))

      cv.error <- NULL

      k <- 5
      for(j in 1:k)
      {
            print(k)
            index <- sample(1:nrow(data),round(0.90*nrow(data)))
            train.cv <- scaled[index,]
            test.cv <- scaled[-index,]

            nn <- neuralnet(f,data=train.cv,hidden=hidden_l,linear.output=T, stepmax = 10^6)
            pr.nn <- compute(nn,test.cv[,1:13])
            pr.nn <- pr.nn$net.result*sd(data$medv) + mean(data$medv)
            test.cv.r <- (test.cv$medv)*sd(data$medv) + mean(data$medv)
            cv.error[j] <- sum((test.cv.r - pr.nn)^2)/nrow(test.cv)
      }
      return(mean(cv.error))
}

Используем нейронную сеть с одним слоем. Наиболее популярное правило выбирать количество нейронов между 1 и количеством признаков. Для выбора количества нейронов будем использовать 5-fold cross-validation. Выберем то количество, которое минимизирует ошибку.

n <- names(train)
f <- as.formula(paste("medv ~", paste(n[!n %in% "medv"], collapse = " + ")))

# set.seed(100)
# for(i in 1:13)
# {
#       nn <- neuralnet(f,data=scaled,hidden=c(i),linear.output=T, stepmax = 10^6)
#       print(i)
#       train.error[i] <- sum(((as.data.frame(nn$net.result)*sd(data$medv) + mean(data$medv))  - (scaled$medv*sd(data$medv) + mean(data$medv)))^2)/nrow(scaled)
#       test.error[i] <- crossvalidate(data,hidden_l=c(i))
# }
test.error <- c(14.197351092, 19.118568862, 15.323856797,  9.900850077, 13.013030110, 10.294646035, 18.273162987, 14.455016860, 17.336128854,16.800375573, 18.927995691, 12.791386809, 19.295322392)

train.error <- c(15.579924258, 11.583278409,  6.542277976,  7.211608826,  5.299934423 , 5.344445163,  3.685781822,  4.148210662,  3.280870741,2.679354351,  2.202861799,  2.153608806 , 1.886667069)

Функция neuralnet используется для обучения нейронной сети. По непонятным причиным, она не принимает формулу в виде “y~ …”.

Важные аргуенты

  1. hidden - вектор, определяющий количество нейроннов в скрытых слоях;

  2. stepmax - максимальное количество шагов, в обучении нейронной сети;

  3. algorithm - какой алгоритм будет использоваться для построения сети;

  4. linear.output - логический. Когда TRUE - регрессия, FALSE - классификация;

  5. act.fct - выбор функции активации. ’logistic’ или ’tanh.

Функция compute вычисляет результат по построенной нейронной сети для тестовой выборки.

plot(train.error,main='MSE vs hidden neurons',xlab="Hidden neurons",ylab='Train error MSE',type='l',col='red',lwd=2)

plot(test.error,main='MSE vs hidden neurons',xlab="Hidden neurons",ylab='Test error MSE',type='l',col='blue',lwd=2)

opt_n <- which(min(test.error) == test.error)
which(min(train.error) == train.error)
## [1] 13
opt_n
## [1] 4

Оптимальное количество нейронов - 4.

Сравним результаты линейной регрессии и нейронной сети.

nn <- neuralnet(f,data=train_,hidden=opt_n,linear.output=T, stepmax = 10^6)
pr.nn <- compute(nn,test_[,1:13])
pr.nn_ <- pr.nn$net.result*sd(data$medv) + mean(data$medv)
test.r <- (test_[,14])*sd(data$medv) + mean(data$medv)

par(mfrow=c(1,2))

plot(test$medv,pr.nn_,col='red',main='Real vs predicted NN',pch=18,cex=0.7)
abline(0,1,lwd=2)
legend('bottomright',legend='NN',pch=18,col='red', bty='n')

plot(test$medv,pr.lm,col='blue',main='Real vs predicted lm',pch=18, cex=0.7)
abline(0,1,lwd=2)
legend('bottomright',legend='LM',pch=18,col='blue', bty='n', cex=.95)

plot(test$medv,pr.nn_,col='red',main='Real vs predicted NN',pch=18,cex=0.7)
points(test$medv,pr.lm,col='blue',pch=18,cex=0.7)
abline(0,1,lwd=2)
legend('bottomright',legend=c('NN','LM'),pch=18,col=c('red','blue'))

Теперь посчитаем 5-fold CV error для регрессии.

library(boot)
set.seed(200)
k = 5
lm.fit <- glm(medv~.,data=data)
cv.lm <- cv.glm(data,lm.fit,K=k)$delta[1]
cv.lm
## [1] 23.7209488

5-fold CV error для нейронной сети.

cv.nn <- test.error[opt_n]
cv.nn
## [1] 9.900850077

Классификация

Нейронная сеть

wines <- read.table("http://archive.ics.uci.edu/ml/machine-learning-databases/wine/wine.data", sep = ",")
colnames(wines) <- c("type", "alcohol", "malic", "ash", "alcalinity", "magnesium", "phenols", "flavanoids", "nonflavanoids","proanthocyanins", "color", "hue", "dilution", "proline")
head(wines)
##   type alcohol malic  ash alcalinity magnesium phenols flavanoids
## 1    1   14.23  1.71 2.43       15.6       127    2.80       3.06
## 2    1   13.20  1.78 2.14       11.2       100    2.65       2.76
## 3    1   13.16  2.36 2.67       18.6       101    2.80       3.24
## 4    1   14.37  1.95 2.50       16.8       113    3.85       3.49
## 5    1   13.24  2.59 2.87       21.0       118    2.80       2.69
## 6    1   14.20  1.76 2.45       15.2       112    3.27       3.39
##   nonflavanoids proanthocyanins color  hue dilution proline
## 1          0.28            2.29  5.64 1.04     3.92    1065
## 2          0.26            1.28  4.38 1.05     3.40    1050
## 3          0.30            2.81  5.68 1.03     3.17    1185
## 4          0.24            2.18  7.80 0.86     3.45    1480
## 5          0.39            1.82  4.32 1.04     2.93     735
## 6          0.34            1.97  6.75 1.05     2.85    1450

Создадим dummy переменные для переменной type, которую будем предсказывать.

data <- cbind(wines[, 2:14], class.ind(as.factor(wines$type)))
names(data) <- c(names(wines)[2:14],"l1","l2","l3")
data[, 1:13] <- data.frame(lapply(data[, 1:13], scale))

Построим 2х слойную нейронную сеть с 9 и 5 нейронами в скрытых слоях соответственно.

set.seed(123)
index <- sample(1:nrow(data),round(0.75*nrow(data)))
train <- data[index,]
test <- data[-index,]

n <- names(data)
f <- as.formula(paste("l1 + l2 + l3 ~", paste(n[!n %in% c("l1","l2","l3")], collapse = " + ")))

nn <- neuralnet(f,data = train,hidden = c(9,5), linear.output = FALSE)
pr.nn <- compute(nn, test[, 1:13])
pr.nn_ <- pr.nn$net.result
original_values <- max.col(test[, 14:16])
pr.nn_2 <- max.col(pr.nn_)

test.nn <- mean(pr.nn_2 == original_values)
test.nn
## [1] 0.9772727273
Neural Network

Neural Network

10-fold CV error.

set.seed(10)
k <- 10
outs <- NULL
proportion <- 0.95

for(i in 1:k)
{
  index <- sample(1:nrow(train), round(proportion*nrow(train)))
  train_cv <- train[index, ]
  test_cv <- train[-index, ]
  nn_cv <- neuralnet(f,
                     data = train_cv,
                     hidden = c(9,5),
                     linear.output = FALSE)
  
  pr.nn <- compute(nn_cv, test_cv[, 1:13])
  pr.nn_ <- pr.nn$net.result
  
  original_values <- max.col(test_cv[, 14:16])
  pr.nn_2 <- max.col(pr.nn_)
  outs[i] <- mean(pr.nn_2 == original_values)
}

cv.nn <- mean(outs)
cv.nn
## [1] 0.9857142857

Random forest

set.seed(11)
wines$type <- as.factor(wines$type)
rf <- randomForest(type~., data = wines, mtry = 4, importance = TRUE)
test.rf <- mean(rf$predicted == wines$type)
test.rf
## [1] 0.9775280899
cv.rf <- 1-mean(rf$err.rate)

cv.rf
## [1] 0.9771086488