仅从 lm() 调用中提取预测函数

mpe*_*tis 1 r

我可以通过将 的输出分配lm()给一个名称来生成拟合线性模型的预测,例如fit_lm,然后使用predict()该拟合生成对新数据的预测(参见下面的 reprex)。

通过大回归,lm()对象可能会变大,因为它们携带适合它们的原始数据以及其他一些潜在的大数据。当我在许多数据集上以自动化方式执行此操作时,单个lm对象可能会占用大量空间,而我不想随身携带整个lm对象。我想从我可以存储和用于预测的拟合中提取一个预测函数。有没有一种简单的方法可以从拟合中提取/构建一个进行预测的函数?在我的 reprex 注释的最底部是我如何设想代码工作的一个例子。

# Do a lm fit
set.seed(1234)
df <- data.frame(x = 1:9, y = 2 * 1:9 + 3 + rnorm(9, sd = 0.5))
fit <- lm(y ~ x, df)
summary(fit)
#> 
#> Call:
#> lm(formula = y ~ x, data = df)
#> 
#> Residuals:
#>     Min      1Q  Median      3Q     Max 
#> -1.0125 -0.1178 -0.1007  0.3780  0.6995 
#> 
#> Coefficients:
#>             Estimate Std. Error t value Pr(>|t|)    
#> (Intercept)   2.8519     0.4035   7.068 0.000199 ***
#> x             1.9969     0.0717  27.851 1.98e-08 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 0.5554 on 7 degrees of freedom
#> Multiple R-squared:  0.9911, Adjusted R-squared:  0.9898 
#> F-statistic: 775.7 on 1 and 7 DF,  p-value: 1.976e-08

# Predict it
predict(fit, data.frame(x = 5:6))
#>        1        2 
#> 12.83658 14.83351

# Like to see that I could extract the fit as a function that could be used:
#
# f <- regressionFunction(fit)
# vector_of_fits <- f(data.frame(x = 5:6))
#
# vector_of_fits would equal: 
#>        1        2 
#> 12.83658 14.83351
Run Code Online (Sandbox Code Playgroud)

reprex 包(v0.3.0)于 2020 年 1 月 7 日创建

Axe*_*man 6

首先,我们从另一个问题中借用了一个函数来减小lm对象的大小。

clean_model = function(cm) {
  # just in case we forgot to set
  # y=FALSE and model=FALSE
  cm$y = c()
  cm$model = c()

  cm$residuals = c()
  cm$fitted.values = c()
  cm$effects = c()
  cm$qr$qr = c()
  cm$linear.predictors = c()
  cm$weights = c()
  cm$prior.weights = c()
  cm$data = c()

  # also try and avoid some large environments
  attr(cm$terms,".Environment") = c()
  attr(cm$formula,".Environment") = c()

  cm
}
Run Code Online (Sandbox Code Playgroud)

然后编写一个简单的包装器来减少模型并返回预测函数:

prediction_function <- function(model) {
  stopifnot(inherits(model, 'lm'))
  model <- clean_model(model)
  function (...) predict(model, ...)
}
Run Code Online (Sandbox Code Playgroud)

例子:

set.seed(1234)
df <- data.frame(x = 1:9, y = 2 * 1:9 + 3 + rnorm(9, sd = 0.5))
fit <- lm(y ~ x, df)
f <- prediction_function(fit)
f(data.frame(x = 5:6))
Run Code Online (Sandbox Code Playgroud)
       1        2 
12.83658 14.83351 
Run Code Online (Sandbox Code Playgroud)

检查尺寸:

object.size(fit)
# 16648 bytes

object.size(prediction_function)
# 8608 bytes
Run Code Online (Sandbox Code Playgroud)

对于这个小例子,我们节省了一半的空间。

让我们使用一些更大的数据:

data(diamonds, package = 'ggplot2')

fit2 <- lm(carat ~ price, diamonds)
predict(fit2, data.frame(price = 200))
f2 <- prediction_function(fit2)
f2(data.frame(price = 200))

print(object.size(fit2), units = 'Mb'); 
object.size(f2)
Run Code Online (Sandbox Code Playgroud)

现在我们从 13 Mb 增加到 5376 字节。