【发布时间】：2020-09-22 02:43:38
【问题描述】：
我对 R shinydashboard dynamic tabItems 中的动态内容有疑问。
我能够成功生成动态侧边栏菜单和相应的动态正文选项卡。
但是，每次我创建新标签（或删除现有标签）时，现有动态标签中的动态内容都会丢失。
下面是一个 MWE，用户可以在其中添加和删除命名选项卡（来自Setup 选项卡）。在每个动态选项卡中，用户可以输入一些文本。如果用户在现有选项卡之间导航，则可以并且保留输入文本。但是，当用户添加或删除选项卡时，现有选项卡的动态内容会丢失。
我明白原因，每次修改动态选项卡列表时，都会重新生成所有动态内容，但我不知道解决方法。据我所知，shinydashboard 没有插入/删除选项卡功能，例如 insertTab 和 removeTab for shiny::tabsetPanel。
# credit: adapted from https://mgei.github.io/post/dynamic-shinydashboard/
library(shiny)
library(shinydashboard)
# ui
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenuOutput("mysidebar")
),
dashboardBody(
uiOutput("mycontent")
)
)
# server
server <- function(input, output, session) {
# This is to get the desired menuItem selected initially.
# selected=T seems not to work with a dynamic sidebarMenu.
observeEvent(session, {
updateTabItems(session, "tabs", selected = "setup")
})
# store dynamic tab list and dynamic contents
local <- reactiveValues(
subitems = list(),
dynamic_tabs = list()
)
# dynamic sidebar menu #
output$mysidebar <- renderMenu({
sidebarMenu(
id = "tabs",
menuItem(
"Setup", tabName = "setup",
icon = icon("gear"), selected = T
),
menuItem(
"Subs", id = "subs", tabName = "subs",
icon = icon("dashboard"), startExpanded = T,
lapply(local$subitems, function(x) {
menuSubItem(x, tabName = paste0("sub_", x))
})
)
)
})
# dynamic content #
output$mycontent <- renderUI({
# concatenate with static tabs
items <- c(
list(
tabItem(
tabName = "setup",
textInput("add_subitem", "Add subitem"),
actionButton("add", "add!"),
selectInput("rm_subitem", "Remove subitem",
choices = local$subitems),
actionButton("rm", "remove!")
)
),
unname(local$dynamic_tabs)
)
# render
do.call(tabItems, items)
})
# add a tab
observeEvent(input$add, {
req(input$add_subitem)
subitem <- input$add_subitem
local$subitems <- append(local$subitems, subitem)
updateTabItems(session, "tabs", selected = "setup")
# dynamic tab list update
local$dynamic_tabs[[ subitem ]] <- tabItem(
tabName = paste0("sub_", subitem),
uiOutput(paste0("sub_", subitem))
)
# dynamic content in the dynamic subitem
output[[ paste0("sub_", subitem) ]] <- renderUI ({
list(
fluidRow(
box("hello ", subitem),
box(
textInput(
paste0("tell_me_", subitem),
label = "tell me"
),
verbatimTextOutput(
paste0("print_", subitem),
placeholder = TRUE
)
)
)
)
})
# update dynamic content in the created subitem
observe({
req(input[[ paste0("tell_me_", subitem) ]])
output[[ paste0("print_", subitem) ]] <- renderText({
input[[ paste0("tell_me_", subitem) ]]
})
})
})
# remove a tab
observeEvent(input$rm, {
req(input$rm_subitem)
subitem <- input$rm_subitem
local$subitems = local$subitems[-which(local$subitems == subitem)]
updateTabItems(session, "tabs", selected = "setup")
# dynamic tab list
local$dynamic_tabs[[ subitem ]] <- NULL
})
}
shinyApp(ui, server)
Edit1：我简化了 MWE。而且我知道output$mycontent <- renderUI({ ... }) 会在创建/删除一个选项卡时重新创建所有选项卡。我目前的解决方法是创建一个静态选项卡列表，并动态填充它们/将它们添加到侧边栏菜单。
【问题讨论】：
标签： r shiny shinydashboard