Отправлять запросы на R сервер программно

Пожалуйста, рассмотрите следующий пример (используя 2 сеанса R):

1-я сессия R - R Server

library(svSocket)
startSocketServer()

2-я сессия R - R Client

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 одновременно подключенными пользователями, поэтому я считаю, что это неудобство может произойти.

Источник

1 ответ

Решение

Один из возможных ответов

$ 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
Источник
Другие вопросы по тегам