Re-using a Module in `nav_menu`/ `nav_panel`

115 views Asked by At

In my shiny app, I want to allow the user to select one subject and then display some information on that subject.

The information looks similar for each subject and is defined in a shiny module, subj_ui() / subj_srv(). The user can select the subject using nav_menu/nav_panel.

The current approach "instantiates" a module for each subject, like this:

subj_ui <- function(id) {
    ns <- shiny::NS(id)
    bslib::page(
        bslib::value_box(
            title = "Position",
            value = shiny::textOutput(ns("pos")),
            max_height = "200px",
            width="25%"
        )
    )
}
subj_srv <- function(id) shiny::moduleServer(id, function(input, output, session) {
    output$pos <- shiny::renderText(which(LETTERS==id))
})

ui <- bslib::page_navbar(
    id="nav",
    title="Static Menu",
    selected="A",
    bslib::nav_menu("Subject", 
        bslib::nav_panel(title="A", value="A", subj_ui("A")),
        bslib::nav_panel(title="B", value="B", subj_ui("B")),
        bslib::nav_panel(title="C", value="C", subj_ui("C"))
    )
)

server <- function(input, output, session) {
    subj_srv("A")
    subj_srv("B")
    subj_srv("C")
}

shiny::shinyApp(ui, server)

This creates a server module for each subject. However, in my app, the number of subjects is higher (around 20) and ui and server functions are more complex (involving database queries).

So I wonder if I can "instantiate" only one module and reuse it for all subjects?.

(When working with shinydashboard, I could define menuItems that include the subject information (like "subj_A", observe input$tabs and set a reactive to the subject and call updateTabItems manually. Is there a similar route for bslib?)

1

There are 1 answers

0
Karsten W. On BEST ANSWER

Finally figured out a solution. Not very elegant, still interested in best practices.

Note that the nav_panel_hidden object is NOT inside a nav_menu. If it were, the menu would stay open when the user selects an menu item. See here for a discussion.

subj_ui <- function(id) {
    ns <- shiny::NS(id)
    bslib::page(
        bslib::value_box(
            title = "Position in the Alphabet",
            value = shiny::textOutput(ns("pos")),
            max_height = "200px",
            width="25%"
        )
    )
}
subj_srv <- function(id, subj) shiny::moduleServer(id, function(input, output, session) {
    # message("subj=", subj())
    output$pos <- shiny::renderText({
        shiny::req(shiny::isTruthy(subj$val))
        which(LETTERS==subj$val)
    })
})

ui <- bslib::page_navbar(
    id="nav",
    title="Dynamic Menu",
    selected="subj",
    bslib::nav_panel(value="start", title="Start", shiny::p("Some introductory notes.")),
    bslib::nav_menu("Subject", 
        bslib::nav_panel(value="subj_A", title="A"),
        bslib::nav_panel(value="subj_B", title="B"),
        bslib::nav_panel(value="subj_C", title="C")
    ),
    bslib::nav_panel_hidden(value="subj", subj_ui("subj"))
)

server <- function(input, output, session) {
    curr_subject <- shiny::reactiveValues()
        
    shiny::observeEvent(input$nav, {
        if(grepl("^subj_", input$nav)) {
            curr_subject$val <- gsub("^subj_", "", input$nav)
            bslib::nav_select("nav", "subj")
        }
    })
    
    subj_srv("subj", subj=curr_subject)
    
}

shiny::shinyApp(ui, server)