Search code examples
rshinyshinydashboardshinywidgetsshinymodules

updatePickerInput after updateTabItem call in modularized R Shiny App


Goal:

I would like to select a row in the DT Table, switch tabs, and have the pickerInput value update to the value in the table's row.

Issue:

I am able to switch tabs just fine (thanks to another post's advice on using the parent session); however, I cannot seem to figure out how to get the updatePickerInput to work properly. I believe there is an issue in the session and inputId arguments. It would make sense that the session for the updatePickerInput would not be the parent session but more like the "child" session from the updateTabItem call.

Reprex:

Below is a single file app.r script that has the two panels' modules as global functions.

sessionInfo():

R version 4.0.3 (2020-10-10)

Platform: x86_64-apple-darwin17.0 (64-bit)

Running under: macOS Big Sur 10.16

# Dependencies ----
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
library(DT)

# Picker Module ----
# Picker UI
picker_ui <- function(id){
    box(width = 12
        , uiOutput(NS(id, "picker"))
    )
}
# Picker Server
picker_server <- function(id){
    moduleServer(id, function(input, output, session){
        # render pickerInput
        output$picker <- renderUI({
            ls_choices <- c("One", "Two", "Three")
            pickerInput(NS(id, "pickerInput")
                        , choices = ls_choices
                        , selected = NULL)
        })
    })
}

# Table Module ----
# Table UI
table_ui <- function(id){
    fluidPage(
        box(width  = 12
            , DTOutput(NS(id, "table"))
        )
    )
}
# Table Server
table_server <- function(id, parent){
    moduleServer(id, function(input, output, session){
        output$table <- renderDT({
            data <- c("One", "Two", "Three")
            df <- tibble("Labels" = data)
            datatable(df, rownames = F, selection = "single", options = list(dom = 'tip'))
        })
        observeEvent(input$table_cell_clicked, {
            req(input$table_cell_clicked$value)
            updateTabItems(session = parent, inputId = "tabs", selected = "picker")
            ################
            #### ISSUE #####
            ################
            updatePickerInput(session = session, inputId = "pickerInput", selected =  input$table_cell_clicked$value)
        })
    }) 
}

# Shiny App----
# UI
ui <- dashboardPage(
    dashboardHeader(title = "Demo")
    , dashboardSidebar(
        sidebarMenu(
            id = "tabs"
            , menuItem("Table", tabName = "table")
            , menuItem("Picker Input", tabName = "picker")
        )
    )
    , dashboardBody(
        tabItems(
            tabItem(tabName = "table"
                    , table_ui("table")
            )
            , tabItem(tabName = "picker"
                      , picker_ui("picker")
            )
        )
    )
)

# Server
server <- function(input, output, session) {
    table_server("table", session)
    picker_server("picker")
}

# Run App ----
shinyApp(ui, server)


Solution

  • You're trying to use table module session to update the picker (which is actually in picker module session)

    1. Return the picker module session from the picker moduleServer:
    # Picker Server
    picker_server <- function(id){
      moduleServer(id, function(input, output, session){
        # render pickerInput
        output$picker <- renderUI({
          ls_choices <- c("One", "Two", "Three")
          pickerInput(NS(id, "pickerInput")
                      , choices = ls_choices
                      , selected = NULL)
        })
        return(session)
      })
    }
    
    1. Get it in the app server and pass it to the table module:
    # Server
    server <- function(input, output, session) {
      picker_session = picker_server("picker")
      table_server("table", session, picker_session)
    }
    
    1. Use it in the table module to update the picker
    # Table Server
    table_server <- function(id, parent, picker_session){
      moduleServer(id, function(input, output, session){
        output$table <- renderDT({
          data <- c("One", "Two", "Three")
          df <- tibble("Labels" = data)
          datatable(df, rownames = F, selection = "single", options = list(dom = 'tip'))
        })
        observeEvent(input$table_cell_clicked, {
          req(input$table_cell_clicked$value)
          updateTabItems(session = parent, inputId = "tabs", selected = "picker")
          ################
          #### ISSUE #####
          ################
          updatePickerInput(session = picker_session, inputId = "pickerInput", selected =  input$table_cell_clicked$value)
        })
      }) 
    }