Benchmark of R's http framework

benchmark.R

microbenchmark:::microbenchmark(system('curl http://127.0.0.1:9123/predict?val=190'))
microbenchmark:::microbenchmark(system('curl http://127.0.0.1:9124/predict?val=190'))

model.R

library(xgboost)
library(ElemStatLearn)
x <- as.matrix(spam[, -ncol(spam)])
y <- as.numeric(spam$spam) - 1
m <- xgboost(data = x, label = y, nrounds = 5, objective = 'binary:logistic')
saveRDS(m, file = "model.rds")

plumber_app.R

suppressPackageStartupMessages(library(rredis))
rredis::redisConnect(host = "localhost", port = 9736)
model <<- readRDS("model.rds")
message("Model loaded")

getdata <- function(id = '1'){
  id <- as.character(id)
  z <- numeric(57)
  d <- as.numeric(unlist(rredis::redisHKeys(id)))
  z[d] <- t(as.numeric(rredis::redisHVals(id)))
  # rredis::redisClose()
  return(as.matrix(t(z)))
}


#* @get /predict
web_console <- function(val){
  res <- list()
  res$v  <-  xgboost:::predict.xgb.Booster(object = model, newdata = getdata(val))
  res$url <- paste("http://cc.bjt.name/data?v=", round(res$v, 5), "&id=", val, sep = '')
  res
}

test_fiery.R

## 加载需要的扩展包，静默加载

suppressPackageStartupMessages(library(fiery))
suppressPackageStartupMessages(library(utils))
suppressPackageStartupMessages(library(jsonlite))
suppressPackageStartupMessages(library(shiny))
suppressPackageStartupMessages(library(xgboost))
suppressPackageStartupMessages(library(rredis))

app <- Fire$new() # 开启一个fiery实例

app$host <- "127.0.0.1"
app$port <- 9123 # 设置服务 ip 地址和端口号
rredis::redisConnect(host = "localhost", port = 9736)

model <- NULL

## 将预先训练好的模型加载到全局变量中
## 预训练模型通过 saveRDS 函数保存，此处略过

app$on("start", function(server, ...) {
  message(sprintf("Running on %s:%s", app$host, app$port))
  model <<- readRDS("model.rds")
  message("Model loaded")
})

## 开启 request的监听
## 初始化定义 response 的 headers 和 body

app$on('request', function(server, id, request, ...) {
  
  response <- list(
    status = 200L,
    headers = list('Content-Type'='text/html'),
    body = ""
  )
  
  ## 获取请求的 path，一旦判断为 /predict 则进行预测
  path <- get("PATH_INFO", envir = request)
  if (grepl("^/predict", path)) {
    
    ## 获取 query string，我们期待的结果是 val=##
    
    query  <- get("QUERY_STRING", envir = request)
    
    ## 解析query, 大概传递的是类似这个：parseQueryString("?foo=1&bar=b%20a%20r")
    ## 一般在前端需要 encoding，input 解析出来是 list 对象
    
    input <- shiny::parseQueryString(query)
    message(sprintf("Input: %s", input$val))
    
    ## 声明获取数据的函数
    ## 这里依旧模拟了从redis缓存取数的逻辑，但并未判断异常情况
    ## 读者可以在此做未获得数据的异常判断
    
    getdata <- function(id = '1'){
      id <- as.character(id)
      z <- numeric(57)
      d <- as.numeric(unlist(rredis::redisHKeys(id)))
      z[d] <- t(as.numeric(rredis::redisHVals(id)))
      return(as.matrix(t(z)))
    }
    
    ## 进入模型预测环节
    ## 声明返回 res 是一个 list，传递参数为 input$val
    
    res <- list()
    res$v <-  xgboost:::predict.xgb.Booster(object = model, newdata = getdata(input$val))
    
    ## 增加埋点信息
    
    res$url <- paste("http://cc.bjt.name/data?v=", round(res$v, 5), "&id=", input$val, sep = '')
    
    # 返回JSON
    response$headers <- list("Content-Type"="application/json")
    response$body <- jsonlite::toJSON(res, auto_unbox = TRUE, pretty = TRUE)
    
  }
  
  response
  
})

app$ignite(showcase=FALSE) # 启动服务

test_plumber.R

suppressPackageStartupMessages(library(xgboost))
library(plumber)
r <- plumb('plumber_app.R')
p = 9124
r$run(port=p, host='0.0.0.0')

Test commands:

Rscript model.R    # create a model first

$ redis-server --port 9736    # redis server

$ Rscript test_fiery.R             # fiery server

$ Rscript test_plumber.R      # plumber server

$ Rscript benchmark.R