在 R Shiny 中，如何实现反应函数？

Question

在下面的 MWE 代码中，我希望更改滑块输入的场景数量，以响应性地更改第一次呈现的场景 1（在单击“添加场景”操作按钮之前）。通过单击操作按钮（场景 2、3 等）添加另一个场景后，场景 1 将保持在更改滑块输入时的位置。底部显示的图像应该更好地解释：

• 图 1：首次调用应用程序时的默认视图。情景 1 是 自动生成 10 个随机样本（在 x 轴上绘制的样本数，在 y 轴上绘制随机数）。 10 是样本数的默认值。到目前为止一切顺利。
• 图 2：下一步：我将输入滑块移动到 6（没有触摸操作按钮），场景 1 保持在 10 个样本。 我希望场景 1 响应式地重新运行 6 个样本，而不是默认的 10 个。
• 图 3：上述步骤之后的下一步：显示单击“添加场景”操作按钮时所有其他操作如何正常工作。我移动滑块，根据输入滑块的值生成新场景。

（顺便说一句，不要担心这个操作按钮会触发一个空白模式对话框——我需要它以供以后使用）。

任何人都可以帮助使该滑块输入对场景 1 产生反应吗？

请注意，由于它当前有效，当单击“添加场景”时，场景的先前滑块输入正确运行“凝胶”（不要更改）。

MWE 代码：

library(shiny)
library(tidyverse)
library(ggplot2)

ui <- fluidPage(
  sliderInput('samples','Number of samples (X):',min=2,max=10,value=10),
  actionButton("add", "Add scenario"),
  plotOutput("plot"),
)

server <- function(input, output, session) {
  
  v <- reactiveValues(results=tibble(Scenario=1, X=1:10, Y=runif(10)))
  
  observeEvent(req(input$periods), {
    v <- reactiveValues(results=tibble(Scenario=1,X=1:input$samples,Y=input$samples))
  })
  
  observeEvent(input$add, {showModal(modalDialog(footer = modalButton("Close")))
    newData <- tibble(Scenario=max(v$results$Scenario)+1,X=1:input$samples,Y=runif(input$samples))
    v$results <- v$results %>% bind_rows(newData)
  })
  
  output$plot <- renderPlot({
    v$results %>% ggplot() + geom_line(aes(x=X, y=Y, colour=as.factor(Scenario)))
  })
}

shinyApp(ui, server)

Answer 1

看看这是否有效。理想情况下，您应该使用 map_dfr 或一些此类函数来生成小标题。但为了使代码易于理解，我只使用了一个 for 循环。

library(shiny)
library(tidyverse)
library(ggplot2)

ui <- fluidPage(
  sliderInput('samples','Number of samples (X):',min=2,max=10,value=10),
  actionButton("add", "Add scenario"),
  plotOutput("plot"),
)

server <- function(input, output, session) {
  
  numScenarios <- reactiveValues(numS=1)
  
  observeEvent(input$add, {showModal(modalDialog(footer = modalButton("Close")))
    numScenarios$numS <- (numScenarios$numS+1)
  })
  
  output$plot <- renderPlot({
    v <- tibble()
    for (i in 1: numScenarios$numS){
      results=tibble(Scenario=i,X=1:input$samples,Y=runif(input$samples))
      v <- bind_rows(v, results)
    }
    v %>% ggplot() + geom_line(aes(x=X, y=Y, colour=as.factor(Scenario)))
  })
}

shinyApp(ui, server)