Задача мультиклассификации с помощью пакета mlr

Задачи машинного обучения, где надо прогнозировать больше, чем два класса, называются задачами мультиклассификации.

Показываю, как я решаю задачу мультиклассификации с помощью пакета mlr.

Нам понадобится датасет survey пакета HRanalytics (установить см. Пакет R HR analytics для HR аналитиков).
Пост посвящаю последнему семинару по HR-аналитике в R, на котором мы не успели рассмотреть задачу мультиклассификации в R

Постановка задачи

Данный датасет представляет ответы респондентов об одном из своих мест работы + некоторые из респондентов проходили тесты на интеллект и Big5 - личностный опросник.
В качестве целевой переменной я беру вопрос "Как часто Ваш руководитель Вам обратную связь" с четырьмя вариантами ответа:

1. ежедневно;
2. еженедельно;
3. реже, чем раз в неделю;
4. никогда

Я хочу ответить на вопрос, можем ли мы на основе знания о респонденте предсказать, какой вариант ответа об обратной связи от руководителя он выберет. Под знаниями о респонденте я понимаю результаты тестов.
Т.е. можем ли мы сказать, что интеллект, интроверсия и т.п.. определяют, укажет ли респондент давал ли ему руководитель ежедневную связь или не давал никогда.

Код 

Для начала укажем необходимые пакеты

library(mlr)
library(dplyr)
library(data.table)
library(mltools)
library(ROCR)

давайте выберем необходимые переменные

data = dplyr::select(survey, feedback=Как.часто.Ваш.руководитель.давал..дает..Вам.обратную.связь,
       iq=Ш1...ОБЩИЙ.БАЛЛ., intro = Ш6...ИНТРОВЕРСИЯ...ЭКСТРАВЕРСИЯ.,
      impls = Ш8...ИМПУЛЬСИВНОСТЬ...САМОКОНТРОЛЬ.,
      independ = Ш7...НЕЗАВИСИМОСТЬ...СОГЛАСИЕ.) 

У нас много пропущенных значений, поэтому просто оставим полные

data = data[complete.cases(data), ] 

Фишка мультиклассификации в пакете mlr в том, что целевая переменная принимается в one hot encoding и притом еще тип переменной - logical :)
Поэтому я делаю так

data[, c('day', 'everyweek', 'never', 'moreweek')] = one_hot(as.data.table(data$feedback))
data[, c('day', 'everyweek', 'never', 'moreweek')] =lapply(data[, c('day', 'everyweek', 'never', 'moreweek')], as.logical)

Это выглядит так

head(data[, c('day', 'everyweek', 'never', 'moreweek')])
     day everyweek never moreweek
1  FALSE     FALSE  TRUE    FALSE
2  FALSE     FALSE  TRUE    FALSE
15 FALSE      TRUE FALSE    FALSE
16 FALSE      TRUE FALSE    FALSE
24 FALSE     FALSE  TRUE    FALSE
25 FALSE      TRUE FALSE    FALSE 

Далее приводим данные в необходимый формат mlr

data = data[, -1]
labels = c('day', 'everyweek', 'never', 'moreweek')
data.task = makeMultilabelTask(id = "multi", data = data[, -1], target = labels)

Обратите внимание, я беру data[, -1], потому что первая переменная эта наша "сырая" целевая переменная,с ней наш прогноз будет очень точным:) Хотя он и так будет точным, потому что я не буду разбивать на трейн / тест сплит, думаю, вы это сделаете сами. Далее указываем учителя

mrf = makeLearner("multilabel.randomForestSRC",  predict.type = "prob")
getParamSet("multilabel.randomForestSRC") 

Обращаю внимание, ниже я даю ссылку на источник, там вы можете увидеть вариант, как можно решать задачи мультиклассификации в mlr с помощью учителя бинарного классификатора. Задаем параметры (я даю мало, вы же сами выбираете то, что вам нра.

mrf_param = makeParamSet(
  
  makeIntegerParam("ntree",lower = 50, upper = 500),
  makeIntegerParam("mtry", lower = 1, upper = 6)
  
) 

Далее обычные операции подготовки данных

rancontrol = makeTuneControlRandom(maxit = 7L) # мы ограничимся 5 итерациями, вы пробуйте больше от 50  
set_cv = makeResampleDesc("CV", stratify = FALSE, iters = 3) 

А здесь важно обратить вминание, что stratify = TRUE не работает, и методы кросс валидации мультиклассификации в mlr отличаются от просто классификации и регрессии (см. ниже по ссылке).

Тренируем

rf_tune = tuneParams(learner = mrf, resampling = set_cv, task = data.task, 
                      par.set = mrf_param, control = rancontrol) 
mrf.tree = setHyperPars(mrf, par.vals = rf_tune$x)
mrforest = mlr::train(mrf.tree, data.task) 
getLearnerModel(mrforest)

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

mrfmodel = predict(mrforest, data.task)
head(mrfmodel$data)
getMultilabelBinaryPerformances(mrfmodel, measures = list(acc, mmce, auc))
          acc.test.mean mmce.test.mean auc.test.mean
day           0.9486964     0.05130362     0.9882470
everyweek     0.9276703     0.07232969     0.9821936
never         0.9520606     0.04793944     0.9902949
moreweek      0.9091674     0.09083263     0.9787145

Вам главный вопрос: почему мы получили такие хорошие метрики качества? Нарисую ROC AUC для вариант day - площадь под кривой того, что руководитель будет давать обратную связь каждый день

 
ROCRpred1 = prediction(mrfmodel$data$prob.day , mrfmodel$data$truth.day  ) #  as.integer(data$day)
as.numeric(ROCR::performance(ROCRpred1, "auc")@y.values)
ROCRperf1 = ROCR::performance(ROCRpred1, "tpr", "fpr")
par(cex.axis=1, cex=1) 
plot(ROCRperf1 , colorize=TRUE, lwd = 6, print.cutoffs.at=seq(0,1,by=0.1), text.adj=c(-0.2,1.7), cex.axis=2)
grid(nx=NULL, ny=NULL, lwd = 3)
lines(x = c(0,1), y = c(0,1), lty=5)

Картинка такая

Это все, что я хотел показать. 

Ссылки

При подготовке я пользовался материалом Multilabel Classification with R Package mlr Также обращаю внимание, я не смог показать фиче импортанс переменных, у меня выдает ошибку. На Гитхабе есть соответствующий коммит см. Feature importance multi-label classification. Я оставил там свой коммент, но сам коммит был оставлен 28 февраля этого года, поэтому сами оценивайте шансы получить ответ:) Можно пойти другим путем, может быть я напишу про это отдельный пост.
Или если вы знаете ответ, напишите, буду вам благодарен.

__________________________________________________________



На этом все, читайте нас в фейсбуке, телеграмме и вконтакте