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

Question

Я только что переключился с caret к mlrпо конкретной проблеме, над которой я работаю в данный момент. Мне интересно, знаком ли кто-нибудь здесь с указанием настраиваемых показателей производительности в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() вызов, но это, как и ожидалось, было немного оптимистичным, и я получил следующую ошибку:Error in checkMeasures(measures, task) : Assertion on 'measures' failed: Must be of type 'list', not 'closure'.

Я обнаружил, что в mlr пакет для создания специальных показателей производительности, называемый makeMeasure()(https://rdrr.io/cran/mlr/man/makeMeasure.html). Я попробовал немного поэкспериментировать, но ничего не получилось. У меня нет большого опыта в работе с пользовательскими функциями, поэтому я надеялся, что кто-то здесь сможет мне помочь или предоставить ресурсы для подобных вещей.

Ура!

Answer 1

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

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)