How to keep content when dynamically updating shinydashboard tabItems

user_5143653 0
Viewed 466

I have a question regarding dynamic content inside R shinydashboard dynamic tabItems.

I am successfully able to generate dynamic sidebar menu and corresponding dynamic body tabs.

However, each time I create a new tab (or remove an existing ones), dynamic content inside existing dynamic tabs is lost.

Below is a MWE where the user can add and remove named tabs (from Setup tab). Inside each dynamic tab, the user can enter some text. If the user navigates between existing tabs, it is ok and the input text is kept. But, when the user adds or removes a tabs, the dynamic content of existing tabs is lost.

I understand the reason, each time the dynamic tab list is modified, all dynamic contents are regenerated, but I do not know a workaround. To my knowledge, shinydashboard does not have insert/remove tab functions, like insertTab and 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: I simplified the MWE. And I understand that output$mycontent <- renderUI({ ... }) recreates all tabs whenever one is created/deleted. My current workaround would be to create a static list of tabs, and dynamically fill them/add them to the sidebar menu.

shinydashboard shiny r
1 Answers

Here is a MWE for a workaround that consists in setting up a static list of tabs, which are not shown in the sidebarMenu by default.

When the user "adds" a tabs, it is made available and appears in the sidebarMenu.

When the user "removes" a tab, it is removed from the sidebarMenu and its input is reset so it can be used again (if the user decides to add a new tab).

The Setup page is now dynamic to account for tab names.

Advantages:

  • We have tabs with pseudo-dynamic behavior, where input is not lost when updating tab list (which answers my initial question).

Problems:

  • The max number of tabs is predefined.
  • The server has to manage a "pseudo-queue" of empty and used tabs.
# 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)
user_51436530
Related