«Объект не найден» при вызове lm внутри функции, созданной фабрикой функций

Question

Я пытаюсь построить общую структуру для быстрой оценки различных моделей.Я пытаюсь использовать фабричный шаблон для генерации функций «модельного тренера», которые берут фрейм данных и возвращают обученную модель.Однако я сталкиваюсь с неожиданным поведением встроенной функции R lm в этой среде.

gen_lm_model_trainer <- function(formula, weights_col = NULL) {
  function(train_data) {
    trained_lm <- lm(formula = formula,
                     data = train_data,
                     weights = train_data[[weights_col]])

    pred_func <- function(test_data) {
      prediction <- predict(trained_lm, newdata = test_data)
      return(prediction)
    }

    return(list(predict = pred_func, info = trained_lm))
  }
}

mtcars$random_weights <- rbeta(nrow(mtcars), shape1 = 5, shape2 = 2)
trainer <- gen_lm_model_trainer(formula = mpg ~ ., weights_col = 'random_weights')
trained_model <- trainer(mtcars)

Ответ на этот код следующий:

Error in eval(extras, data, env) : object 'train_data' not found

Этоаналогично другому вопросу SO, Ошибка объекта не найдена при передаче формулы модели в другую функцию , но эта проблема не решается путем назначения среды формулы для среды сгенерированной функции, то есть

gen_lm_model_trainer <- function(formula, weights_col = NULL) {
  function(train_data) {
    scoped_formula <- as.formula(formula, env = environment())
    trained_lm <- lm(formula = scoped_formula,
                     data = train_data,
                     weights = train_data[[weights_col]])

    pred_func <- function(test_data) {
      prediction <- predict(trained_lm, newdata = test_data)
      return(prediction)
    }

    return(list(predict = pred_func, info = trained_lm))
  }
}

Решение, которое работает последовательно для обеих проблем, будет наиболее ценно.

Answer 1

По интересным причинам добавление

random_weights <- train_data[[weights_col]]

или, более обобщенно,

assign(weights_col, train_data[[weights_col]])

в начало вашего function(train_data) { и передача random_weights как weights в lm исправит это, результирующая функция будет выглядеть следующим образом:

gen_lm_model_trainer <- function(formula, weights_col = NULL) {
  function(train_data) {
    assign(weights_col, train_data[[weights_col]])
    trained_lm <- lm(formula = formula, data = train_data, weights = random_weights)

    pred_func <- function(test_data) {
      prediction <- predict(trained_lm, newdata = test_data)
      return(prediction)
    }

    return(list(predict = pred_func, info = trained_lm))
  }
}

mtcars$random_weights <- rbeta(nrow(mtcars), shape1 = 5, shape2 = 2)
trainer <- local(gen_lm_model_trainer(formula = mpg ~ ., weights_col = 'random_weights'))
trained_model <- trainer(mtcars)

Причина:

Основная причина заключается в том, что веса передаются в stats::model.frame.default как часть... и оценивается отдельно:

  env <- environment(formula)
  # ...
  # more code
  # ...
  extras <- substitute(list(...))
  extranames <- names(extras[-1L])
  extras <- eval(extras, data, env)

Answer 2

У меня сработало следующее:

gen_lm_model_trainer <- function(formula, weights_col = NULL) {
  function(train_data, .fml = formula, .wts = weights_col) {
    w <- train_data[[.wts]]
    environment(.fml) <- environment()
    trained_lm <- lm(formula = .fml,
                     data = train_data,
                     weights = w)
    pred_func <- function(test_data) {
      predict(trained_lm, newdata = test_data)
    }
  list(predict = pred_func, info = trained_lm)
  }
}

mtcars$random_weights <- rbeta(nrow(mtcars), shape1 = 5, shape2 = 2)
trainer <- gen_lm_model_trainer(formula = mpg ~ ., weights_col = 'random_weights')
trained_model <- trainer(mtcars)

Возможно, я сделал некоторые косметические изменения, но есть только два реальных изменения:

1) environment (.fml) <- environment () # чтобы убедиться, что объект в области видимости функции доступен # в противном случае он не найдет вес, но, что любопытно, он может найти данные </p>

2) Передав имена столбцов формулы и весов в качестве аргументов.

Я не могу объяснить, почему эта комбинация работает ... это интересный случай.Я создал модели lm с другим подходом, и с ним всегда есть проблемы.

Answer 3

Я нашел частичный ответ на вопрос - частичный в том, что он решает только этот случай, а не связан с вопросом SO .Кажется, проблема в том, что аргументы lm оцениваются в среде, которая соответствует вызову with(train_data, lm(...)).Следовательно, должно быть безопасно использовать parent.frame() для перехода в среду вызывающей функции («модельный тренер»).Это соответствует глубине n = 1 - в этом случае я думаю, что n = 1 - это среда фрейма данных, n = 2 - это среда eval, а n = 3 - это среда, из которой lmзвонил.

gen_lm_model_trainer <- function(formula, weights_col = NULL) {
  function(train_data) {
    trained_lm <- lm(formula = formula,
                     data = train_data,
                     weights = get('train_data', parent.frame(3))[[get('weights_col', parent.frame(3))]])

    pred_func <- function(test_data) {
      prediction <- predict(trained_lm, newdata = test_data)
      return(prediction)
    }

    return(list(predict = pred_func, info = trained_lm))
  }
}

mtcars$random_weights <- rbeta(nrow(mtcars), shape1 = 5, shape2 = 2)
trainer <- gen_lm_model_trainer(formula = mpg ~ ., weights_col = 'random_weights')
trained_model <- trainer(mtcars)

Почему lm меняет сферу так необычно, мне не понятно и похоже на ошибку.