1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
| ## 加载需要的扩展包，静默加载
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 地址和端口号
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)
rredis::redisConnect(host = "10.0.2.70", port = 9736, password = '')
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)))
}
## 进入模型预测环节
## 声明返回 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) # 启动服务
|