使用 Shiny Server 处理用户并发，保持变量独立

Question

您好，

我们在 Shiny Server 免费版上有一个 Shiny 应用程序运行。当我们对其进行测试时，我们意识到一个用户所做的输入更改会影响另一个用户的会话。我知道每个应用程序只有一个 R 进程运行，但似乎应该有一种方法可以为各个用户会话保持变量分离。

我在下面创建了一个更简单的示例。请注意，我们的滑块具有一些内置的相互依赖性 - 更改一个滑块会影响其他滑块。完成此操作的方法是跟踪 'old' 和 'new' 值，并按差异的一定比例修改另一个滑块 - sliderB 由对 [= 的任何更改的一小部分进行修改14=]，例如。

我怀疑 <<- 和全局变量的使用，但我想不出另一种方法来让它工作。我有一个想法是通过 Javascript 以某种方式在用户端存储变量，但我的想法远远超出了我通常的框框，我不太确定该怎么做。

请注意，我们预计用户总数相对较低，网站启动时可能最多 ~100，通常远低于此。

global.R

a_new <- 10
b_new <- 10
c_new <- 10

a_old <- a_new
b_old <- b_new

server.R

library(shiny)

shinyServer(function(input, output, session) {

  vals <- reactive({
    df <- data.frame(a = input$sliderA,
                     b = input$sliderB,
                     c = input$sliderC)
  })

  observe({
    a_new <- input$sliderA
    print(paste("a_new:", a_new, "a_old:", a_old))
    b_new <- isolate(input$sliderB) + .5 * (a_new - a_old)
    updateSliderInput(session, "sliderB", value = b_new)
    a_old <<- a_new
  })

  observe({
    b_new <- input$sliderB
    print(paste("b_new:", b_new, "b_old:", b_old))
    c_new <- isolate(input$sliderC) + .5 * (b_new - b_old)
    updateSliderInput(session, "sliderC", value = c_new)
    b_old <<- b_new
  })

  output$mytable <- renderTable({
    data.frame(vals())
  })

})

ui.R

library(shiny)

shinyUI(fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput("sliderA",
                  "A:",
                  min = -50,
                  max = 50,
                  value = a_new),
      sliderInput("sliderB",
                  "B:",
                  min = -50,
                  max = 50,
                  value = b_new),
      sliderInput("sliderC",
                  "C:",
                  min = -50,
                  max = 50,
                  value = c_new)
    ),

    mainPanel(
      tableOutput("mytable")
    )
  )
))

代码也可以在这里找到：https://github.com/brianstamper/ShinyApps/tree/master/reactive

Answer 1

下面是一个示例，其中每个会话的所有值和更改都是唯一的。请注意，我将您的 old 变量包装在 reactiveValues() 中。我也改为 observeEvent 因为我认为它更适合你的情况。请注意，更改 sliderA 会导致 sliderB 发生变化，因此 sliderC 也会更新。如果您有任何问题，请告诉我

rm(list = ls())
library(shiny)

a_new <- 10
b_new <- 10
c_new <- 10

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput("sliderA","A:",min = -50,max = 50,value = a_new),
      sliderInput("sliderB","B:",min = -50, max = 50,value = b_new),
      sliderInput("sliderC","C:",min = -50,max = 50,value = c_new)),
    mainPanel(
      tableOutput("mytable")
    )
  )
)

server <- function(input, output, session) {

  old <- reactiveValues()

  old$a <- 10
  old$b <- 10
  old$c <- 10

  vals <- reactive({
    df <- data.frame(a = input$sliderA,b = input$sliderB,c = input$sliderC)
  })

  observeEvent(input$sliderA,{
    a_new <- input$sliderA
    b_new <- input$sliderB + (.5 * (a_new - old$a))
    updateSliderInput(session, "sliderB", value = b_new)
    old$a <- a_new
  })

  observeEvent(input$sliderB,{
    b_new <- input$sliderB
    c_new <- input$sliderC + (.5 * (b_new - old$b))
    updateSliderInput(session, "sliderC", value = c_new)
    old$b <- b_new
  })

  output$mytable <- renderTable({
    data.frame(vals())
  }) 
}
shinyApp(ui, server)

Answer 2

事实证明，真正需要的只是更改我声明变量的位置。

根据 Scoping rules for Shiny apps,

The function that you pass to shinyServer() is called once for each session. [...] Everything within this function is instantiated separately for each session.

所以我所要做的就是将 a_old 和 b_old 的声明放入服务器函数并将它们从 global.R 中删除：

server.R

library(shiny)

shinyServer(function(input, output, session) {
  a_old <- a_new
  b_old <- b_new

  [...]

并发问题确实与使用 reactiveValues 或 observeEvent 无关，但是我很高兴了解这些，因为它确实让我不必使用 <<-赋值，即使在将变量声明移入服务器函数后仍然需要赋值。但这里的重要部分是了解哪些变量在所有用户会话之间共享，哪些变量单独实例化，这仅取决于变量的声明位置。

使用 Shiny Server 处理用户并发，保持变量独立

Handle user concurrency with Shiny Server, keeping variables separate

r

global-variables

shiny

shiny-server

global.R

server.R

ui.R

server.R