使用模块和 tabPanels 在 Rshiny 中不渲染的绘图

Question

我的基本问题是，在对 UI 和服务器逻辑使用模块方法时，我无法让我的图在 tabPanels 中呈现。我正在尝试使用多个 tabPanel（在 navbarPage 和 navbarMenus 下）构建一个应用程序，用户在其中输入一些在选项卡之间具有相似结构的数据，然后应用程序生成并绘制特定于该选项卡上用户输入的数据。

这是我的应用程序的一个大大简化的版本，但这似乎会产生同样的问题：

# UI module
modUI <- function(id, label="inputvalues") {
  ns <- NS(id)
  tagList(
    numericInput(ns("mean"), "Mean",value = NULL),
    numericInput(ns("sd"),"Std. Dev.",value = NULL),
    actionButton(ns("draw"),"Draw plot")
  )
}

# Server Logic module
mod <- function(input, output, session){
  x <- reactiveValues(data=NULL)
  observeEvent(input$draw, {
    x$data <- data.frame(rnorm(100,input$mean,input$sd))
  })
  reactive({x})
}

# Plotting function
showPlot <- function(data){
  reactive({
  p <- ggplot(data, aes(x=data[,1])) +
    geom_histogram()
  p
  })
}

# UI call
ui <- navbarPage("Fancy Title",
          tabPanel("Panel1",
              sidebarPanel(
                modUI("input1")
              ),
              mainPanel(plotOutput("plot1"))
              ),
          tabPanel("Panel2",
              sidebarPanel(
                modUI("input2")
              ),
              mainPanel(plotOutput("plot2"))
          )
)

# Server call
server <- function(input, output) {
  y <- callModule(mod, "input1")
  output$plot1 <- renderPlot({ showPlot(y()) })

  z <- callModule(mod, "input2")
  output$plot2 <- renderPlot({ showPlot(z()) })
}

shinyApp(ui, server)

再次，我希望面板 1 根据用户在面板 1 中提供的输入显示图表，然后让面板 2 根据面板 2 中提供的内容显示第二个图表。当我输入数据我单击按钮，没有任何反应。我可以在面板之间来回翻转并且输入在那里，这很好，但没有情节。我没有收到任何错误消息，并且 browser() 并没有给我带来任何有用的地方。我怀疑我的问题是将绘图对象从绘图函数传递给renderPlot；但在拥有单独的功能时，我试图遵循this article 中提供的指导方针。

非常感谢任何指导，一如既往！

版本（R、RStudio、Rshiny）都是最新的。

Answer 1

我对您的代码做了一些更改：

• 您的代码在定义 UI Id 时在 moduleUI 中遗漏了 namespaces - 添加了它。
• 改变了从模块服务器返回响应值的方式
• 对 showplot 稍作调整（关于如何处理数据）

所以，您的问题不在于绘图，而是要绘制的输入数据。

更新代码：

library(shiny)

# UI module
modUI <- function(id, label="inputvalues") {
  ns <- NS(id)
  tagList(
    numericInput(ns("mean"), "Mean",value = NULL),
    numericInput(ns("sd"),"Std. Dev.",value = NULL),
    actionButton(ns("draw"),"Draw plot")
  )
}

# Server Logic module
mod <- function(input, output, session){
  x <- reactiveValues(data=NULL)
  observeEvent(input$draw, {
        x$data <- rnorm(100,input$mean,input$sd)
  })
  return(reactive({x$data}))
  }

# Plotting function
showPlot <- function(data){

    data <- data.frame(data = data)
    p <- ggplot(data, aes(x=data)) +
      geom_histogram()
    p

}

# UI call
ui <- navbarPage("Fancy Title",
                 tabPanel("Panel1",
                          sidebarPanel(
                            modUI("input1")
                          ),
                          mainPanel(plotOutput("plot1"))
                 ),
                 tabPanel("Panel2",
                          sidebarPanel(
                            modUI("input2")
                          ),
                          mainPanel(plotOutput("plot2"))
                 )
)

# Server call
server <- function(input, output, session) {
  y <- callModule(mod, "input1")



  output$plot1 <- renderPlot({ showPlot(data.frame(y())) })
  #output$plot1 <- renderPlot(plot(1:100))

  z <- callModule(mod, "input2")
  output$plot2 <- renderPlot({ showPlot(data.frame(z())) })
}

shinyApp(ui, server)