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)

闪亮模块之间的通讯

2 个答案: