[英]R Shiny Dashboard - uiOutput not rendering inside tab items
我正在构建一个 shiny 仪表板,并希望包含一个具有动态值范围的 slider 条。 为此,我在服务器上生成sliderInput
并使用renderUI
/ uiOuput
显示它。 在下面的示例中,如果我仅在一个tabPanel
上包含 slider ,则此方法可以正常工作。 但是,当我尝试将其添加到第二个tabPanel
时,它无法在其中任何一个上呈现。
这篇文章描述了一个类似的问题,但解决方案( suspendWhenHidden = FALSE
)对我不起作用。 我也尝试了这篇文章的解决方案,尽管问题有所不同。
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)
正如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 function 中传递反应值,请将其包装在observeEvent 中。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.