Перекрестная проверка нескольких нейронных сетей с различным размером одного скрытого слоя в R

Question

Я должен использовать перекрестную проверку, чтобы узнать, сколько нейронов должен включать один скрытый слой моей модели (используя пакет nnet). Я должен написать функцию в R, которая принимает данные, модель и параметр n в качестве входных данных и вычисляет производительность модели с точки зрения точности на случайно разделенном обучающем и тестовом наборе, используя нейронную сеть с n слоями. Используя эту функцию в al oop, вычислите производительность, используя нейронные сети с размерами скрытых слоев n = 1, 2, 3, 20. Моя главная цель - понять, какой размер скрытого слоя, потому что в конце концов я должен построить график, чтобы показать точность и сложность модели. По этой причине в идеале я хотел бы иметь все измерения точности как для тестового набора, так и для наборов поездов

Я получаю сообщение об ошибке: объект «accNN» не найден, который является пустым вектором для хранения результатов. Я хочу сравнить 20 моделей, поэтому в l oop мне нужно создать 20 пустых векторов для хранения 20 различных результатов (accNN1, accNN2, accNN3 и т. Д. c.) Было бы здорово получить помощь по кодированию. петли правильно.

Большое спасибо!

set.seed(1)
df <- data.frame(
    X = sample(1:100),
    Y = sample(1:100),
    Z = sample(1:100),
    target = sample(c("yes", "no"), 10, replace = TRUE))

# Create K folds with equal size for cross validation.
nFolds  <- 5
myFolds <- cut(seq(1, nrow(df)), 
                breaks = nFolds, 
                labels=FALSE)
table(myFolds)

# Create object for number of neurons
sizehiddenlayer <- 3

# Define the model
mdl <- target ~ X + Y + Z


for (j in 1:sizehiddenlayer) {
   # Initialize empty vectors to collect results
   accNN[j]    <- rep(NA, nFolds)

   for (i in 1:nFolds) {
   cat("Analysis of fold", i, "\n")

   # 1: Define training and test sets
   testObs  <- which(myFolds == i, arr.ind = TRUE)
   dfTest   <- df[ testObs, ]
   dfTrain  <- df[-testObs, ]

   # 2: Train the models on the training sets
   rsltNN[j] <- nnet(mdlB, data = df, size = j)

   # 3: Predict values for the test sets
   predNN[j] <- predict(rsltNN[j], type ="class")

   # 4: Measure accuracy and store the results
   accNN[j] <- mean(df$target == predNN[j])
}
}

Answer 1

Вам нужно создать объект для хранения результатов, используя стрелку, чтобы не добавить объект в существующий вектор или список, поэтому что-то вроде этого будет работать (обратите внимание, вы тренируетесь на dfTrain и прогнозируете на dfTest:

results = vector("list",sizehiddenlayer)

for (j in 1:sizehiddenlayer) {

   results[[j]]$accNN  <- rep(NA, nFolds)
   results[[j]]$rsltNN  <- vector("list",nFolds)
   results[[j]]$predNN  <- vector("list",nFolds)

   for (i in 1:nFolds) {

   testObs  <- which(myFolds == i, arr.ind = TRUE)
   dfTest   <- df[ testObs, ]
   dfTrain  <- df[-testObs, ]

   results[[j]]$rsltNN[[i]] <- nnet(mdl, data = dfTrain, size = j)
   results[[j]]$predNN[[i]] <- predict(results[[j]]$rsltNN[[i]],dfTest, type ="class")
   results[[j]]$accNN[i] <- mean(dfTest$target == results[[j]]$predNN[[i]])
}
}

Результаты упорядочены в виде списка:

head(results[[1]],2)
$accNN
[1] 0.6 0.6 0.6 0.6 0.6

$rsltNN
$rsltNN[[1]]
a 3-1-1 network with 6 weights
inputs: X Y Z 
output(s): target 
options were - entropy fitting 

$rsltNN[[2]]
a 3-1-1 network with 6 weights
inputs: X Y Z 
output(s): target 
options were - entropy fitting 

Другой способ - использовать caret для обработки CV et c, или вы можете попробовать что-то вроде purrr:

library(purrr)
library(dplyr)

fit = function(dat,Folds,i,j){nnet(mdl, data = dat[Folds!=i,],size = j)}
pred = function(dat,Folds,mdl,i){predict(mdl,dat[Folds==i,],type="class")}
accr = function(dat,Folds,prediction,i){mean(dat$target[Folds==i] == prediction)}

results = expand.grid(hiddenlayer=1:sizehiddenlayer,fold=1:nFolds) %>%
tibble() %>%
mutate(
mdl=map2(.x=fold,.y= hiddenlayer,~fit(dat=df,F=myFolds,i =.x ,j=.y)),
pred = map2(.x=fold,.y= mdl,~pred(dat=df,F=myFolds,mdl = .y ,i=.x)),
accuracy = map2(.x=fold,.y= pred,~accr(dat=df,F=myFolds,prediction = .y ,i=.x))
)

results
# A tibble: 15 x 5
   hiddenlayer  fold mdl        pred       accuracy 
         <int> <int> <list>     <list>     <list>   
 1           1     1 <nnt.frml> <chr [20]> <dbl [1]>
 2           2     1 <nnt.frml> <chr [20]> <dbl [1]>
 3           3     1 <nnt.frml> <chr [20]> <dbl [1]>
 4           1     2 <nnt.frml> <chr [20]> <dbl [1]>
 5           2     2 <nnt.frml> <chr [20]> <dbl [1]>
 6           3     2 <nnt.frml> <chr [20]> <dbl [1]>
 7           1     3 <nnt.frml> <chr [20]> <dbl [1]>

И вы можете получить к ним доступ так:

results$mdl[[1]]
a 3-1-1 network with 6 weights
inputs: X Y Z 
output(s): target 
options were - entropy fitting 
> results$pred[[1]]
 [1] "no" "no" "no" "no" "no" "no" "no" "no" "no" "no" "no" "no" "no" "no" "no"
[16] "no" "no" "no" "no" "no"
> results$accuracy[[1]]
[1] 0.6