将 R 模型保存在内存中以供 Rest API

Question

我们有一个大小约为 2 GB 的 GLM R 模型。我们正在使用此模型为 REST API 提供服务。我们需要

在高层次上：

1. 为 REST API 提供服务。

2. 在内存中保留数 GB 的模型。

3. 将响应时间保持在 3 秒以下。

我们尝试过但不起作用的东西：

1. 缩小模型的大小。我们的数据科学家说，这是他能做到的。

2. 我在 saveRDS 上尝试过压缩和其他设置。我能做的最好的事情是 12 秒从文件中加载模型。

3. 我们尝试了 Microsoft R Server。所有 Web API 请求都将被重定向到同一个会话。问题是我们必须围绕保持会话活动包装大量代码。即使那样它也会经常剥落。

4. Microsoft R Server Real Time 已过时，因为它只接受 ScaleR 生成的模型。我知道 ScaleR 有 GLM 功能，但有人告诉我它不是一个选项。

5. 更快的 IO 似乎没有帮助。看来瓶颈是 rData 文件的反序列​​化。 R 是单线程并没有帮助。

编辑： 问题是 REST API 库/服务的 R 将允许我们在调用之间有状态地将模型保存在内存中。

Answer 1

继续我上面的评论以及@TenniStats 的建议，最好的方法是减小 GLM 的大小。考虑以下几点：

#generating some sample data that's fairly large
sample.data <- data.frame('target' = sample(c(1:10), size = 5000000, replace = T),
                          'regressor1' = rnorm(5000000),
                          'regressor2' = rnorm(5000000),
                          'regressor3' = rnorm(5000000),
                          'regressor4' = rnorm(5000000),
                          'regressor5' = rnorm(5000000),
                          'regressor6' = rnorm(5000000),
                          'regressor7' = rnorm(5000000),
                          'regressor8' = rnorm(5000000),
                          'regressor9' = rnorm(5000000),
                          'regressor10' = rnorm(5000000))

#building a toy glm - this one is about 3.3 GB
lm.mod <- glm(sample.data, formula = target ~ ., family = gaussian)

#baseline predictions
lm.default.preds <- predict(lm.mod, sample.data)

#extracting coefficients
lm.co <- coefficients(lm.mod)

#applying coefficients to original data set by row and adding intercept
lightweight.preds <- lm.co[1] +
  apply(sample.data[,2:ncol(sample.data)],
        1,
        FUN = function(x) sum(x * lm.co[2:length(lm.co)]))

#clearing names from vector for comparison
names(lm.default.preds) <- NULL

#taa daa
all.equal(lm.default.preds, lightweight.preds)

那么我们可以做以下事情：

#saving for our example and starting timing
saveRDS(lm.co, file = 'myfile.RDS')
start.time <- Sys.time()

#reading from file
coefs.from.file <- readRDS('myfile.RDS')
#scoring function
light.scoring <- function(coeff, new.data) {
  prediction <- coeff[1] + sum(coeff[2:length(coeff)] * new.data)
  names(prediction) <- NULL
  return(prediction)
}

#same as before
light.scoring(coefs.from.file, sample.data[1, 2:11])
#~.03 seconds on my machine
Sys.time() - start.time