|
## 加载需要的扩展包,静默加载 |
|
|
|
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) # 启动服务 |
This comment has been minimized.
Test commands:
Rscript model.R # create a model first