2014-03-30 48 views
3

请考虑下面的例子(使用2个R会话):发送查询R服务器编程

1 R对话 - R服务器

library(svSocket) 
startSocketServer() 

右二会议 - R的客户

library(svSocket) 
con <- socketConnection(host = "localhost", port = 8888, blocking = FALSE) 

value<-"setosa" 
evalServer(con, tmp, value) # first call to the server 
evalServer(con, head(iris[iris$Species==tmp,])) # second call to the server 
    Sepal.Length Sepal.Width Petal.Length Petal.Width Species 
1   5.1   3.5   1.4   0.2 setosa 
2   4.9   3.0   1.4   0.2 setosa 
3   4.7   3.2   1.3   0.2 setosa 
4   4.6   3.1   1.5   0.2 setosa 
5   5.0   3.6   1.4   0.2 setosa 
6   5.4   3.9   1.7   0.4 setosa 

要发送上述查询,我​​需要一个两步过程,首先将我的参数保存在服务器中,然后使用它们查询表。

问题

仅在一个步骤中执行相同操作。例如,使用paste构建查询并将其发送到服务器,就像我在PHP + MySQL中那样。基本上,我需要避免不同的用户在第一次和第二次调用服务器之间覆盖tmp。上述命令将在30至50个用户同时连接的网络应用程序后面运行,所以我认为这可能会导致不便。

+0

看看[Rserve](http://www.rforge.net/Rserve/)。还有一个[php库](https://github.com/cturbelin/rserve-php)。我认为它会比'svSocket'更好地为你服务,因为它实际上是作为GUI后端连接的。另外,既然你熟悉R,为什么不使用Shiny? – hrbrmstr

+1

@hrbrmstr我已经有了一个rApache实现。我根本没有时间切换到不同的技术。我之所以选择这个,是因为它让R的行为像PHP和其他人一样,这意味着人们可以开始将R看作是一种通用语言......我真的很希望发生这种事情! – Michele

回答

2

一个可能的答案

$ query <- paste0('evalServer(con,"head(iris[iris$Species==\'', value,'\',])")') 
$ eval(parse(text=query)) 
    Sepal.Length Sepal.Width Petal.Length Petal.Width Species 
1   5.1   3.5   1.4   0.2 setosa 
2   4.9   3.0   1.4   0.2 setosa 
3   4.7   3.2   1.3   0.2 setosa 
4   4.6   3.1   1.5   0.2 setosa 
5   5.0   3.6   1.4   0.2 setosa 
6   5.4   3.9   1.7   0.4 setosa 

这做工作,但它是一种拨号的...该代码是非常混乱和难以阅读。

最终的解决方案:

我最终修改/简化evalServer。此版本只接受一个字符串与表达在服务器

evalServer2 <- function (con, expr) 
{ 
    if(!is.character(expr)) stop("expr must be a character string containing the expression to evaluate in the server.") 
    cat("..Last.value <- try(eval(parse(text = \"", expr, "\"))); .f <- file(); dump(\"..Last.value\", file = .f); flush(.f); seek(.f, 0); cat(\"\\n<<<startflag>>>\", gsub(\"<pointer: [0-9a-fx]+>\", \"NULL\", readLines(.f)), \"<<<endflag>>>\\n\", sep = \"\\n\"); close(.f); rm(.f, ..Last.value); flush.console()\n", 
     file = con, sep = "") 
    objdump <- "" 
    endloc <- NULL 
    while (!length(endloc)) { 
    obj <- readLines(con, n = 1000, warn = FALSE) 
    if (!length(obj)) { 
     Sys.sleep(0.01) 
     next 
    } 
    endloc <- grep("<<<endflag>>>", obj) 
    if (length(endloc)) 
     obj <- obj[0:(endloc[length(endloc)] - 1)] 
    objdump <- c(objdump, obj) 
    } 
    startloc <- grep("<<<startflag>>>", objdump) 
    if (!length(startloc)) 
    stop("Unable to find <<<startflag>>>") 
    objdump <- objdump[-(1:startloc[length(startloc)])] 
    nospace <- grep("[^ ]$", objdump) 
    nospace <- nospace[nospace < length(objdump)] 
    for (i in rev(nospace)) { 
    objdump[i] <- paste(objdump[i], objdump[i + 1], sep = "") 
    objdump[i + 1] <- "" 
    } 
    objcon <- textConnection(objdump) 
    on.exit(close(objcon)) 
    source(objcon, local = TRUE, echo = FALSE, verbose = FALSE) 
    return(..Last.value) 
} 

允许评估:

> x <- "5 + 4" 
> evalServer2(con, x) 
[1] 9 

相反,evalServer将检索一个名为x变量存储在R服务器

> evalServer(con, x, 23) 
[1] TRUE 
> evalServer(con, x) 
[1] 23 
> evalServer2(con, "x") 
[1] 23