2

我在闪亮中创建了一个应用程序（用于说明的精简示例），其中包含一个通信无法正常工作的模块。

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

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

  • 我假设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)
4

2 回答 2

2

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

注意删除了括号和包裹在反应式中的输入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)
  
}
于 2020-04-07T07:32:58.267 回答
1

我不确定应用程序应该做什么，但我认为您必须将反应导体传递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)
于 2020-04-07T07:41:27.227 回答