R Shiny Dashboard - uiOutput 未在选项卡项内呈现

Question

我正在构建一个闪亮的仪表板，并希望包含一个具有动态值范围的滑块。为此，我在服务器上生成sliderInput 并使用renderUI/uiOuput 显示它。在下面的示例中，如果我只在一个tabPanel 上包含滑块，则此方法可以正常工作。但是，当我尝试将其添加到第二个 tabPanel 时，两者都无法呈现。

This post 描述了一个类似的问题，但解决方案 (suspendWhenHidden = FALSE) 对我不起作用。我也尝试了this post 的解决方案，尽管问题有所不同。

library(shinydashboard)
library(shiny)
ui <- dashboardPage(
  dashboardHeader(title = "Demo dashboard"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Overview", tabName = "overview", icon = icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "overview",
        fluidRow(
          column(width = 6,
            tabBox(
             title = "Tab box",
             width = "100%",
             id = "tabset1", height = "250px",
             tabPanel("Tab 1",
              img(src = "test_img.jpg", height="100%", width="100%", align="center"),
              # the slider is rendered properly if only included in a single tab
              uiOutput("out_slider")
             ),
             tabPanel("Tab 2",
              img(src = "test_img.jpg", height="100%", width="100%", align="center"),
              # however, uncommenting below causes the slider to not render on *either* tab 
              #uiOutput("out_slider")
             )
            )
          )
        )
      )
    )
  )
)


server <- function(input, output) {
  
  
  startDate <- as.Date("2019-01-01","%Y-%m-%d")
  endDate <- as.Date("2020-01-01","%Y-%m-%d")
  
  # from https://stackoverflow.com/q/36613018/11434833 ... does not seem to fix problem
  # output$out_slider <- renderUI({})
  # outputOptions(output, "out_slider", suspendWhenHidden = FALSE)
  
  output$out_slider <- renderUI({
    sliderInput("slider1", label = h3("Slider"), min = startDate, 
                max = endDate, value = endDate,timeFormat="%e %b, %y")
  })
  
}

shinyApp(ui, server)

Answer 1

正如YBS所说，ID有冲突。 尝试创建如下所示的模块。

library(shinydashboard)
library(shiny)

slider<-function(id){
  ns<-NS(id)
  tagList(
    uiOutput(ns("out_slider"))
  )
}

sliderServer<-function(id, label, min, 
                      max , value, timeFormat="%e %b, %y"){
  moduleServer(
    id,
    function(input,output,session){
      output$out_slider <- renderUI({
        sliderInput("slider", label , min, 
                    max, value, timeFormat="%e %b, %y")
      })
    }
  )
}


ui <- dashboardPage(
  dashboardHeader(title = "Demo dashboard"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Overview", tabName = "overview", icon = icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "overview",
              fluidRow(
                column(width = 6,
                       tabBox(
                         title = "Tab box",
                         width = "100%",
                         id = "tabset1", height = "250px",
                         tabPanel("Tab 1",
                                  img(src = "test_img.jpg", height="100%", width="100%", align="center"),
                                  # the slider is rendered properly if only included in a single tab
                                  slider("tab1")
                         ),
                         tabPanel("Tab 2",
                                  img(src = "test_img.jpg", height="100%", width="100%", align="center"),
                                  # however, uncommenting below causes the slider to not render on *either* tab 
                                  slider("tab2")
                         )
                       )
                )
              )
      )
    )
  )
)


server <- function(input, output) {
  
  
  startDate <- as.Date("2019-01-01","%Y-%m-%d")
  endDate <- as.Date("2020-01-01","%Y-%m-%d")
  
  sliderServer("tab1",label = h3("Slider"), min = as.Date("2019-01-01","%Y-%m-%d"), 
               max = as.Date("2020-01-01","%Y-%m-%d"), value = as.Date("2020-01-01","%Y-%m-%d"), timeFormat="%e %b, %y")
  
  sliderServer("tab2", label = h3("Slider"), min = as.Date("2019-01-01","%Y-%m-%d"), 
               max = as.Date("2020-01-01","%Y-%m-%d"), value = as.Date("2020-01-01","%Y-%m-%d"), timeFormat="%e %b, %y")
  

  
}

shinyApp(ui, server)

如果您打算在sliderServer函数中传递反应值，请将其包装在observeEvent中。