R: обучение нейронки с k-fold кроссвалидацией для поиска параметров модели
16 марта 2018, 11:25
1
465
R: обучение нейронки с k-fold кроссвалидацией для поиска параметров модели.
Этот код лучше сохранить как текстовый файл и открыть в R-Studio для удобной подсветки синтаксиса
library(elmNN) #нейронка library(MLmetrics) #пакет с разными оценками предсказания модели library(GA) #пакет с генетическим оптимизатором #установка пакетов если они ещё небыли установлены ранее # install.packages(c("elmNN"), dependencies = TRUE) # install.packages(c("MLmetrics"), dependencies = TRUE) # install.packages(c("GA"), dependencies = TRUE) #Для тренировки возьмём стандартный датасет Melanoma с классами 0 и 1 data(Melanoma) trainTable <- Melanoma PREDICTOR_COLUMNS <- 1:(ncol(trainTable)-1) #номера колонок с предикторами (тут будет 1, 2, ..., 6). # PREDICTOR_COLUMNS <- c(2,3,4,5,6) #если хотите то сами укажите номера колонок по которым нужно обучать модель TARGET_COLUMN <- ncol(trainTable) #номер колонки с таргетом (тут 7) #последнюю треть таблицы trainTable вырежем для последующего тестирования модели. #Вместо этого можно и самому загрузить testTable из другого csv файла testTable <- trainTable[round(nrow(trainTable)*2/3):nrow(trainTable),] trainTable <- trainTable[-(round(nrow(trainTable)*2/3):nrow(trainTable)),] KFOLDS <- 10 #число моделей в комитете NHID_MAX <- 200 #максимальное число нейронов в скрытом слое при поиске оптимального значения #кодовые названия активационных функций в elemNN ACTFUN_NAMES <- c("sig", "sin", "radbas", "hardlim", "hardlims", "satlins", "tansig", "tribas", "poslin", "purelin") # #Пример обычного обучения нейронки, без проверок и подбора параметров, просто для краткого объяснения что и куда подавать. # #На самом деле так обучать модель не надо, поэтому этот кусок я закоментил, но можете откоментить и поэкспериментировать. # elmNNmodel <- elmtrain( # x = trainTable[,PREDICTOR_COLUMNS], #табличка в которой только предикторы # y = trainTable[,TARGET_COLUMN], #вектор в котором только таргет # nhid = 100, #число нейронов в скрытом слое нейронки. Чем их больше тем точнее будет результат, но начнёт ухудшаться проноз на новых данных # actfun = "sig" #активационная функция нейронов. На выбор - # # sig: sigmoid # # sin: sine # # radbas: radial basis # # hardlim: hard-limit # # hardlims: symmetric hard-limit # # satlins: satlins # # tansig: tan-sigmoid # # tribas: triangular basis # # poslin: positive linear # # purelin: linear # ) # # # Предсказание используя обученную модель - # prediction <- predict(elmNNmodel, trainTable[,PREDICTOR_COLUMNS]) # # результат представлен матрицей, конвертируем его для удобства в вектор # prediction <- prediction[,1] # #раз у нас бинарная классификация, то округляем результат к 0 и 1 # prediction[prediction < 0.5] <- 0 # prediction[prediction >= 0.5] <- 1 # #находим точность предсказания # cat("model accuracy:", Accuracy(y_pred = prediction, y_true = trainTable[,TARGET_COLUMN]),"\n") # #в данном примере 100 скрытых нейронов хватило для точности в 100%. # #Но это точность на тех-же данных на которых мы и обучали модель, # #и нет абсолютно никаких гарантий что на новых данных модель сохранит такую точность. # #Поэтому таким простым способом обучать нейронку нельзя. #Эта функция будет обучать несколько моделей для комитета; возвращать их и прогноз по которому их можно оценить. #Я использую Kfold кроссвалидацию: Данные делятся на несколько фрагментов, модели обучаются только на части даных, а предсказывают неизвестную для себя часть данных elemnn_kfold <- function(x,y,nhid,actfun,seed){ split2 <- function(x,n) split(x, cut(seq_along(x), n, labels = FALSE)) #функция которая поделит строки таблицы на число кусков согласно KFOLDS folds <- split2(1:nrow(x), KFOLDS) #номера строк для обучения в каждом фолде modelList <- list() #список куда добавятся будующие обученные модели prediction <- rep(NA, nrow(x)) #предсказания на новых для каждого фолда данных for(i in 1:KFOLDS){ set.seed(seed) #установка генератора случайных чисел в определённое состояние, нужно для воспроизводимости результата modelList[[i]] <- elmtrain(x = x[-folds[[i]], , drop=FALSE], y = y[-folds[[i]]], nhid=nhid, actfun=actfun) #обучение модели без небольшого количества исходных данных prediction[folds[[i]]] <- predict(modelList[[i]], x[folds[[i]], , drop=FALSE]) #предсказание на ранее отсутсвующих данных, которые будут новыми для этой модели } return(list(modelList = modelList, prediction = prediction)) } #предсказание используя комитет моделей созданных функцией elemnn_kfold() #roundPrediction01 - TRUE если результат нужно округлить к 0 и 1; FALSE - оставить результат без изменений elemnn_kfold_predict <- function(model, x, roundPrediction01){ prediction <- rep(0, nrow(x)) for(i in 1:length(model$modelList)){ prediction <- prediction + predict(model$modelList[[i]], x)[,1] / length(model$modelList) #предсказываем каждой моделью в комитете, считаем среднее } if(roundPrediction01){ prediction[prediction < 0.5] <- 0 prediction[prediction >= 0.5] <- 1 } return(prediction) } #предсказание используя комитет моделей созданных функцией elemnn_kfold() #тут используется тернарное предсказание как в моделе Решетова. Предполагается что модели обучалась с таргетами 0 и 1, к ним и будет округляться предсказание. #предсказание в итоге будет либо -1 (класс "0"), либо 1 (класс "1"), либо 0 ("не знаю") elemnn_kfold_predict_reshetovstyle <- function(model, x){ prediction <- matrix(NA, ncol=length(model$modelList), nrow=nrow(x)) #результаты для всех моделей будут храниться отдельно, чтоб потом из сравнивать for(i in 1:length(model$modelList)){ prediction[,i] <- predict(model$modelList[[i]], x)[,1] #предсказываем каждой моделью в комитете } prediction[prediction < 0.5] <- 0 prediction[prediction >= 0.5] <- 1 predictionFinal <- rep(0, nrow(prediction)) for(i in 1:nrow(prediction)){ if(length(unique(prediction[i,]))==1){ if(prediction[i,1] == 1){ predictionFinal[i] <- 1 } if(prediction[i,1] == 0){ predictionFinal[i] <- -1 } } } return(predictionFinal) } #оптимальные параметры нейронки будут искаться генетикой. #эта функция будет использована внутри генетики для оценки параметров GaFitness <- function(x){ tryCatch({ #X - вектор с параметрами модели, нужные нам значения для elmNN - первый и второй элемент вектора nhid <- round(x[1]) actfun <- ACTFUN_NAMES[round(x[2])] seed <- round(x[3]) #обучение комитета моделей elemnnModels <- elemnn_kfold(x = trainTable[,PREDICTOR_COLUMNS], y = trainTable[,TARGET_COLUMN], nhid = nhid, actfun = actfun, seed = seed) #оценка результатов комитета, тут используется функция R2_Score из пакета MLmetrics score <- R2_Score(y_pred = elemnnModels$prediction, y_true = trainTable[,TARGET_COLUMN]) # лучший результат R2_Score тот что больше, в идеале должно быть 1 return(score) },error=function(e){}) return(-1000) } #генетика для поиска оптимальных значений nhid и actfun нейронки gaResult <- ga(type="real-valued", fitness = GaFitness, min = c(1,1,0), max = c(NHID_MAX, length(ACTFUN_NAMES), 1000), monitor=plot) #В процессе будет рисоваться график с лучшим результатом(зелёные точки), если результат достигнет 1 то очень хорошо. #В этом примере лучший результат оказался около ноля, это плохо, модель бесполезная, нужно отсеивать предикторы. #Результат кроссвалидации лучшей модели найденной генетикой, должен быть как можно ближе к 1 (чем меньше тем хуже). cat("Best R^2 score:",max(gaResult@fitness),"\n") #Лучшие параметры нейронки найденные генетикой nhidOptimised <- round(gaResult@solution[1,1]) actfunOptimised <- ACTFUN_NAMES[round(gaResult@solution[1,2])] seedOptimised <- round(gaResult@solution[1,3]) #теперь оптимальные параметры найдены, и можно обучить комитет моделей model <- elemnn_kfold(x = trainTable[,PREDICTOR_COLUMNS], y = trainTable[,TARGET_COLUMN], nhid = nhidOptimised, actfun = actfunOptimised, seed = seedOptimised) # На этом всё, модель создана. Для прогноза используйте # elemnn_kfold_predict(model, newData[,PREDICTOR_COLUMNS], roundPrediction01 = FALSE) #или roundPrediction01=TRUE если нужно сразу округлить результат к 0 или 1 #Немного тестов: #предскажем старые и новые данные чтоб узнать точность модели predictionTrain <- elemnn_kfold_predict(model, trainTable[,PREDICTOR_COLUMNS], roundPrediction01 = TRUE) predictionTest <- elemnn_kfold_predict(model, testTable[,PREDICTOR_COLUMNS], roundPrediction01 = TRUE) predictionTrainKfold <- model$prediction predictionTrainKfold[predictionTrainKfold>=0.5] <- 1 predictionTrainKfold[predictionTrainKfold<0.5] <- 0 #сравним результаты на тренировке и тесте, вышло 0.7279412 и 0.6521739, что как-бы неплохо, #но при этом лучший результат найденный генетикой даёт R2 = 0.2, это крайне мало, должно быть больше 0 и вообще как можно ближе к 1. #судя по результатам генетической оптимизации - точность >50% тут это скорее случайность чем заслуженное достижение. #например модель могла научиться всегда возвращать один и тотже класс как результат. cat("Accuracy on train data:", Accuracy(y_pred = predictionTrain, trainTable[,TARGET_COLUMN]), "\n") cat("Accuracy on train data (kfold):", Accuracy(y_pred = predictionTrainKfold, trainTable[,TARGET_COLUMN]), "\n") cat("Accuracy on test data:", Accuracy(y_pred = predictionTest, testTable[,TARGET_COLUMN]), "\n") #тернарное предсказание по методам Юрия Решетова predictionTernTrain <- elemnn_kfold_predict_reshetovstyle(model, trainTable[,PREDICTOR_COLUMNS]) predictionTernTest <- elemnn_kfold_predict_reshetovstyle(model, testTable[,PREDICTOR_COLUMNS])
Большая серьёзная статья на тему оптимизации параметров нейронки elmNN и создания ансамбля моделей - https://www.mql5.com/ru/articles/4227 (автор статьи: Vladimir Perervenko)
