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问题Object not found error when passing model formula to another function类似，但是无法通过将公式的环境分配给生成的函数的环境（即

）来解决此问题

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

我已经找到了该问题的部分答案-部分是因为它只能解决这种情况和not the linked SO question。问题似乎是在与调用with(train_data, lm(...))相对应的环境中评估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如此大地更改范围对我来说还是一个未知的问题，而且似乎是一个错误。

Answer 2

出于有趣的原因添加

switch.isEnabled = false

或更笼统地

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并分别进行评估：

...

Answer 3

以下对我有用：

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）环境（.fml）<-环境（）＃确保函数范围内的对象可访问＃否则它将找不到权重，但奇怪的是，它可以找到数据

2）传递公式和权重列名称作为参数。

我无法完全解释为什么这种组合有效……这是一个有趣的案例。我用不同的方法生成了lm模型，并且总是有麻烦。

在由函数工厂创建的函数中调用lm时，“找不到对象”

3 个答案: