动态更新shinydashboard tabItems时如何保留内容？

问题描述 投票：0回答：1

我有一个关于R的动态内容的问题 shinydashboard动态 tabItems.

我可以成功地生成动态侧栏菜单和相应的动态主体标签。

然而，每次我创建一个新的标签（或删除一个现有的）。现有动态标签内的动态内容丢失.

下面是一个 MWE，用户可以在其中添加和删除命名标签（从 Setup tab).在每个动态标签内，用户可以输入一些文字。在每个动态标签内，用户可以输入一些文本。如果用户在现有的标签页之间进行导航，则没有问题，输入的文本将被保留。但是，当用户增加或删除一个标签时，现有标签的动态内容就会丢失。

我明白原因，每次修改动态标签页列表时，所有的动态内容都会重新生成，但我不知道有什么变通的办法。据我所知，shinydashboard并没有insertremove标签的功能，就像 insertTab 和 removeTab 对于 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)

编辑1: 我简化了MWE. 我也明白 output$mycontent <- renderUI({ ... }) 每当有一个标签被创建和删除时，就会重新创建所有的标签。我目前的解决方法是创建一个静态的标签列表，然后动态地将它们添加到侧栏菜单中。

r shiny shinydashboard
1个回答
0
投票

这里有一个MWE的变通方法，包括设置一个静态的标签列表，它不显示在 sidebarMenu 默认情况下是这样的。

当用户 "添加 "一个标签页时，它就会变得可用，并出现在 sidebarMenu.

当用户 "删除 "一个标签时，它就会从 sidebarMenu 它的输入会被重置，因此可以再次使用（如果用户决定添加一个新的标签）。

该 Setup 页面现在是动态的，以说明标签名称。

优点：我们有了具有伪动态行为的标签，在更新标签列表时，输入不会丢失。

  • 我们有了具有伪动态行为的标签，在更新标签列表时不会丢失输入（这回答了我最初的问题）。

问题：我们有了伪动态行为的标签页，在更新标签页列表时，输入不会丢失（这回答了我最初的问题）。

  • 标签的最大数量是预定义的。
  • 服务器必须管理一个 "伪队列 "的空标签和使用过的标签。
# credit: adapted from https://mgei.github.io/post/dynamic-shinydashboard/
library(shiny)
library(shinydashboard)
library(shinyjs)

options(stringsAsFactors = FALSE)

# static tab list
tab_list_ui <- function() {
    # concatenate static tabs
    items <- c(
        list(
            tabItem(
                tabName = "setup",
                uiOutput("mysetup")
            )
        ),
        lapply(1:10, function(id) {
            tabItem(
                tabName = paste0("tab_", id), 
                uiOutput(paste0("sub_", id))
            )
        })
    )
    # render
    do.call(tabItems, items)
}

# dynamic sub menu
update_submenu <- function(local) {
    lapply(split(local$subitems, seq(nrow(local$subitems))), function(x) {
        menuSubItem(x$name, tabName = paste0("tab_", x$id))
    })
}

# ui
ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(
        sidebarMenuOutput("mysidebar")
    ),
    dashboardBody(
        tab_list_ui()
    )
)

# 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")
    })

    # render setup
    output$mysetup <- renderUI({
        tagList(
            textInput("add_subitem", "Add subitem"),
            actionButton("add", "add!"),
            selectInput("rm_subitem", "Remove subitem",
                        choices = local$subitems$name),
            actionButton("rm", "remove!")
        )
    })

    # store dynamic tab list and dynamic contents
    local <- reactiveValues(
        empty_tabs = as.list(1:10),
        current_tabs = list(),
        subitems = data.frame(id = integer(), name = character())
    )

    # 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,
                update_submenu(local)
            )
        )
    })

    # debugging
    observe({
        print(paste0("current tabs = ", 
                     paste0(unlist(local$current_tabs), collapse = " ")))
        print(paste0("empty tabs = ", 
                     paste0(unlist(local$empty_tabs), collapse = " ")))
    })

    # add a tab
    observeEvent(input$add, {
        req(input$add_subitem)
        req(length(local$empty_tabs) > 0)
        # id of next tab to fill
        id <- min(unlist(local$empty_tabs))
        # update empty/current tab lists
        local$empty_tabs <- local$empty_tabs[-which(local$empty_tabs == id)]
        local$current_tabs <- append(local$current_tabs, id)
        # tab name
        subitem <- input$add_subitem
        local$subitems <- rbind(local$subitems, 
                                data.frame(id = id, name = subitem))
        updateTabItems(session, "tabs", selected = "setup")

        # dynamic content in the dynamic subitem
        output[[ paste0("sub_", id) ]] <- renderUI ({
            list(
                fluidRow(
                    box("hello ", subitem),
                    box(
                        textInput(
                            paste0("tell_me_", id), 
                            label = "tell me"
                        ),
                        verbatimTextOutput(
                            paste0("print_", id), 
                            placeholder = TRUE
                        )
                    )
                )
            )
        })

        # update dynamic content in the created subitem
        observe({
            req(input[[ paste0("tell_me_", id) ]])
            output[[ paste0("print_", id) ]] <- renderText({
                input[[ paste0("tell_me_", id) ]]
            })
        })
    })

    # remove a tab
    observeEvent(input$rm, {
        req(input$rm_subitem)
        req(length(local$empty_tabs) < 10)
        # id of tab to fill
        subitem_ind <- which(local$subitems$name == input$rm_subitem)
        subitem <- local$subitems[subitem_ind,]
        # update empty/current tab lists
        local$empty_tabs <- append(local$empty_tabs, subitem$id)
        local$current_tabs <- local$current_tabs[-which(local$current_tabs == subitem$id)]
        # reset deleted tab
        shinyjs::reset(paste0("sub_", subitem$id))
        # tab name
        local$subitems <- local$subitems[-subitem_ind,]
        updateTabItems(session, "tabs", selected = "setup")
    })
}

shinyApp(ui, server)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.