Shiny 模块之间的通信

Question

我创建了一个应用程序（用于说明的压缩示例），其中包含一个无法正常通信的模块。

用户界面应通过单击“加载”按钮创建一些数据 (DataPack)（到目前为止，list 有两个元素）。然后应通过模块绘制数据，而每个模块绘图的 x 轴范围应由 ui 的sliderInput 控制。

尽管创建的数据绘制正确（仅在第一次运行时），但我面临的特殊问题是：

• 我假设restarting interrupted promise evaluation 警告正在创建时DataPack 尚未创建或传递给模块。因此，当Datapack 尚未创建但不是在第一次单击“加载”按钮之后，我理解警告。有没有办法避免这种情况？这种行为从何而来？
• 在通过单击“加载”按钮创建了一些数据 (DataPack) 后，滑块会正确更新，以反映所创建数据 (n) 的（常见）长度。但是，初始值集 (value = c(0, 150)) 被传递到模块的绘图，而在单击“加载”按钮后通过创建数据（即实际长度）更新的值（或之后的任何其他滑块位置）是不是。为什么？
• 应用程序在第一次运行后停止，无法再单击“加载”按钮。为什么？

谢谢你！

library(shiny)
library(TTR)

# module interface
Module_ui <- function(id) {

  ns <- NS(id)
  plotOutput(ns("Plot"))

}

# module server
Module_Server <- function(input, output, session,
                          DataPack, DataSetName, xlim) {

  output$Plot <- renderPlot({
    message(paste("Plot", DataSetName))
    plot(DataPack[[DataSetName]],
         xlim = c(xlim[1], xlim[2])) })

}



# app ui
ui <- fluidPage(

  fluidRow(
    column(
      6, fluidRow(h4("Data Generation")),
      fluidRow(actionButton("InputButton_GetData", "Load", width = "100%"))),

    column(
      6, fluidRow(h4("Update Plot")),
      sliderInput(
        "SliderInput_xAxis",
        label = NULL,
        min = 0,
        max = 150,
        value = c(0, 150),
        animate = TRUE))),

  Module_ui("Plot_1"),

  Module_ui("Plot_2")

)

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

  DataPack <- eventReactive(
    input$InputButton_GetData, {

      message("Creating DataPack")

      n <- round(runif(1, min = 100, max = 500))

      message(n)

      DataPack <- NULL
      DataPack$one <- rnorm(n)
      DataPack$two <- rnorm(n)^2

      updateSliderInput(
        session = session,
        inputId = "SliderInput_xAxis",
        value   = c(1, n),
        min     = 1,
        max     = n)

      return(DataPack)

    })

  callModule(Module_Server, "Plot_1",
             DataPack     = DataPack(),
             DataSetName  = "one",
             xlim         = input$SliderInput_xAxis)

  callModule(Module_Server, "Plot_2",
             DataPack     = DataPack(),
             DataSetName  = "two",
             xlim         = input$SliderInput_xAxis)

}



shinyApp(ui, server)

Answer 1

更喜欢将反应式直接传递给模块函数。

注意删除了 callModule(DataPack = DataPack, ....) 中的括号和包含在响应式中的输入，因此模块函数体中的 DataPack() 而不是 DataPack。

library(shiny)
library(TTR)

# module interface
Module_ui <- function(id) {
  
  ns <- NS(id)
  plotOutput(ns("Plot"))
  
}

# module server
Module_Server <- function(input, output, session,
                          DataPack, DataSetName, xlim) {
  
  output$Plot <- renderPlot({
    message(paste("Plot", DataSetName))
    plot(DataPack()[[DataSetName]],
         xlim = c(xlim()[1], xlim()[2])) })
  
}



# app ui
ui <- fluidPage(
  
  fluidRow(
    column(
      6, fluidRow(h4("Data Generation")),
      fluidRow(actionButton("InputButton_GetData", "Load", width = "100%"))),
    
    column(
      6, fluidRow(h4("Update Plot")),
      sliderInput(
        "SliderInput_xAxis",
        label = NULL,
        min = 0,
        max = 150,
        value = c(0, 150),
        animate = TRUE))),
  
  Module_ui("Plot_1"),
  
  Module_ui("Plot_2")
  
)

# app server
server <- function(input, output, session) {
  
  DataPack <- eventReactive(
    input$InputButton_GetData, {
      
      message("Creating DataPack")
      
      n <- round(runif(1, min = 100, max = 500))
      
      message(n)
      
      DataPack <- NULL
      DataPack$one <- rnorm(n)
      DataPack$two <- rnorm(n)^2
      
      updateSliderInput(
        session = session,
        inputId = "SliderInput_xAxis",
        value   = c(1, n),
        min     = 1,
        max     = n)
      
      return(DataPack)
      
    })
  
  SliderInput_xAxis_rx <- reactive(input$SliderInput_xAxis)

  callModule(Module_Server, "Plot_1",
             DataPack     = DataPack,
             DataSetName  = "one",
             xlim         = SliderInput_xAxis_rx)

  callModule(Module_Server, "Plot_2",
             DataPack     = DataPack,
             DataSetName  = "two",
             xlim         = SliderInput_xAxis_rx)
  
}



shinyApp(ui, server)

---

编辑：Shiny 版本 > 1.5 的推荐语法更新

Module_Server <- function(id, 
                          DataPack, DataSetName, xlim) {
  moduleServer(id,
    function(input, output, session) {
      output$Plot <- renderPlot({
        message(paste("Plot", DataSetName))
        plot(DataPack()[[DataSetName]],
             xlim = c(xlim()[1], xlim()[2])) })
    }
  )
}

server <- function(input, output, session) {
  DataPack <- eventReactive(input$InputButton_GetData, {
    message("Creating DataPack")
    n <- round(runif(1, min = 100, max = 500))
    message(n)
    DataPack <- NULL
    DataPack$one <- rnorm(n)
    DataPack$two <- rnorm(n)^2
    updateSliderInput(session = session,
      inputId = "SliderInput_xAxis",
      value = c(1, n), min = 1, max = n)
    return(DataPack)
  })
  
  SliderInput_xAxis_rx <- reactive(input$SliderInput_xAxis)
  
  Module_Server("Plot_1",
                DataPack     = DataPack, 
                DataSetName  = "one",
                xlim         = SliderInput_xAxis_rx)
  
  Module_Server("Plot_2",
                DataPack     = DataPack,
                DataSetName  = "two",
                xlim         = SliderInput_xAxis_rx)
  
}

Answer 2

我不确定应用程序应该做什么，但我认为您必须将反应导体 DataPack 传递给模块服务器，而不是它返回的值：

Module_Server <- function(input, output, session,
                          DataPack, DataSetName, xlim) {

  output$Plot <- renderPlot({
    message(paste("Plot", DataSetName))
    plot(DataPack()[[DataSetName]], # note the parentheses
         xlim = c(xlim[1], xlim[2])) })

}

  callModule(Module_Server, "Plot_1",
             DataPack     = DataPack, # no parentheses
             DataSetName  = "one",
             xlim         = input$SliderInput_xAxis)

  callModule(Module_Server, "Plot_2",
             DataPack     = DataPack, # no parentheses
             DataSetName  = "two",
             xlim         = input$SliderInput_xAxis)