Пользовательский показатель производительности при построении моделей с млр-пакетом

Question

Я только что переключился с caret на mlr для конкретной c проблемы, над которой я сейчас работаю. Мне интересно, знаком ли кто-нибудь здесь с указанием пользовательских показателей производительности в функции resample().

Вот пример воспроизводимого кода:

library(mlr)
library(mlbench)

data(BostonHousing, package = "mlbench")

task_reg1  <- makeRegrTask(id = "bh", data = BostonHousing, target = "medv")
lrn_reg1   <- makeLearner(cl = "regr.randomForest",
                        predict.type = "response",
                        mtry=3) 
cv_reg1 <- makeResampleDesc("RepCV", folds = 5, reps = 5)

regr_1 <- resample(learner = lrn_reg1,
                     task = task_reg1,
                     resampling = cv_reg1,
                     measures = mlr::rmse)

Вместо вычисления RMSE, я хочу вычислить Средняя абсолютная масштабная ошибка , MASE. Функция для этого может, например, быть найдена в пакете Metrics: Metrics::mase().

Я пытался включить measures = Metrics::mase непосредственно в вызов resample(), но это было, как и ожидалось, немного оптимистично c и я получил следующую ошибку: Error in checkMeasures(measures, task) : Assertion on 'measures' failed: Must be of type 'list', not 'closure'.

Я обнаружил, что в пакете mlr есть функция для создания пользовательских метрик производительности, которая называется makeMeasure() (* 1023). *). Я попытался немного поэкспериментировать с этим, но ничего не получилось. У меня нет большого опыта работы с пользовательскими функциями, поэтому я надеялся, что кто-то здесь сможет мне помочь или предоставить ресурсы для подобных вещей.

Приветствия!

Answer 1

Вам необходимо создать функцию, которая может быть применена в makeMeasure(), которая имеет вид function(task, model, pred, extra.args). Мы можем просто написать оболочку вокруг Metrics::mase(), чтобы вы могли использовать эту функцию в resample(), и вы можете сделать то же самое для любой другой метри c, которую вы найдете.

mase_fun <- function(task, model, pred, feats, extra.args) {
  Metrics::mase(pred$data$truth, pred$data$response, step_size = extra.args$step_size)
}

mase_measure <- makeMeasure(id = "mase", 
                            minimize = T,
                            properties = c("regr", "req.pred", "req.truth"),
                            fun = mase_fun,
                            extra.args = list(step_size = 1))

resample(learner = lrn_reg1,
         task = task_reg1,
         resampling = cv_reg1,
         measures = mase_measure)