1

I'm attempting to display tab2, from within a server module, upon clicking a dynamically generated button.

Although the message is displayed, I'm unable to understand why the tab2 is not appearing again...

Can anyone provide guidance on how to modify the code so that when the user clicks on the tbl1 button, tab2 is displayed again?

Reproducible example, below:

library(data.table)
library(dplyr)
library(shiny)
library(DT)

# Function to get data
get_project_list <- function() {
  df <- iris
  cbind(df,
        button = sapply(1:nrow(df), make_button("tab2")),
        stringsAsFactors = FALSE)
}

# Function to create button HTML for the table on the catalog page
make_button <- function(tab){
  function(i){
    sprintf(
      '<button id="btn_%s_%d" type="button" class="btn btn-light"
       onclick="%s"><span class="glyphicon glyphicon-search"></span> </button>', 
      tab, i, "Shiny.setInputValue('tab1_page-button', this.id); ")
  }
}

# Catalog server module
catalog_server <- function(input, output, session) {
  
  # Create a reactive value for the project list
  df_list_projects <- shiny::reactiveVal({
    get_project_list()
  })
  
  # Render the data table
  output[["tbl1"]] = DT::renderDT(
    DT::datatable(df_list_projects(), escape = F)
  )
  
  # Show modal and unhide Tab2 when button is clicked
  observeEvent(input$button, {
    
    # THIS IS NOT WORKING
    shiny::showTab(inputId = "navbar_page",
                   target = "Tab2",
                   session = session)
    
    # Show modal dialog
    showModal(modalDialog(
      title = "Showing tab2",
      size = "s",
      easyClose = TRUE,
      footer = NULL
    ))
    
  })
}

# Catalog UI module
catalog_ui <- function(id) {
  ns <- NS(id)
  div(style = "height: 100%",
      class = "jumbotron",
      id = ns("project_panel"),
      shinyWidgets::useSweetAlert(),
      fluidRow(
        column(12,
               column(12, DT::DTOutput(outputId = ns("tbl1")))
        )
      ))
}

# Shiny app UI
ui <- shiny::tagList(
  navbarPage(id = "navbar_page",
             title = "test",
             
             collapsible = TRUE,
             tabPanel("Tab1",
                      catalog_ui(id = "tab1_page")),
             
             tabPanel("Tab2",
                      catalog_ui(id = "tab2_page"))
  ))

# Shiny app server
server <- function(input, output, session) {
  
  # Call the catalog server module for Tab1
  shiny::moduleServer(id = "tab1_page",
                      module = catalog_server, session)
  
  # Hide Tab2 initially
  shiny::hideTab(inputId = "navbar_page",
                 target = "Tab2",
                 session = session)
  
}

# Run the app
shinyApp(ui, server)
Stéphane Laurent
  • 75,186
  • 15
  • 119
  • 225
Quizicall
  • 133
  • 6

1 Answers1

2

See my comments for the explanantions.

Since you are using two times the module catalog_ui in the main UI you have to use two times the module catalog_server in the main server.

library(data.table)
library(dplyr)
library(shiny)
library(DT)

# Function to get data
get_project_list <- function() {
  df <- iris
  cbind(df,
        button = sapply(1:nrow(df), make_button("tab2")),
        stringsAsFactors = FALSE)
}

# Function to create button HTML for the table on the catalog page
make_button <- function(tab){
  function(i){
    sprintf(
      '<button id="btn_%s_%d" type="button" class="btn btn-light"
       onclick="%s"><span class="glyphicon glyphicon-search"></span> </button>', 
      tab, i, "Shiny.setInputValue('button', this.id); ")
  }
}

table_server <- function(id, data) {
  moduleServer(
    id,
    function(input, output, session) {
      # Render the data table
      output[["tbl1"]] = DT::renderDT(
        DT::datatable(data(), escape = FALSE)
      )
    }
  )  
}

# Catalog server module
catalog_server <- function(id) { 
  moduleServer(
    id, 
    function(input, output, session) {
      
      # Create a reactive value for the project list
      df_list_projects <- shiny::reactiveVal({
        get_project_list()
      })
      
      # datatable
      table_server(id = "tabl", data = df_list_projects)

    }
  )
}
  
table_ui <- function(id) {
  ns <- NS(id)
  DTOutput(outputId = ns("tbl1"))
}

# Catalog UI module
catalog_ui <- function(id) {
  ns <- NS(id)
  div(
    style = "height: 100%",
    class = "jumbotron",
    id = ns("project_panel"),
    shinyWidgets::useSweetAlert(),
    fluidRow(
      column(
        12,
        column(
          12, 
          table_ui(id = ns("tabl"))
        )
      )
    )
  )
}

# Shiny app UI
ui <- tagList(
  navbarPage(
    id = "navbar_page",
    title = "test",
    collapsible = TRUE,

    tabPanel(
      "Tab1",
      catalog_ui(id = "tab1_page")
    ),
    
    tabPanel(
      "Tab2",
      catalog_ui(id = "tab2_page")
    )
  )
)

# Shiny app server
server <- function(input, output, session) {
  
  # Call the catalog server modules 
  catalog_server(id = "tab1_page")
  catalog_server(id = "tab2_page")
  
  # Hide Tab2 initially
  shiny::hideTab(inputId = "navbar_page",
                 target = "Tab2",
                 session = session)
  
  # Show modal and unhide Tab2 when button is clicked
  observeEvent(input$button, {
    # THIS IS WORKING
    shiny::showTab(inputId = "navbar_page",
                   target = "Tab2",
                   session = session)
    # Show modal dialog
    showModal(modalDialog(
      title = "Showing tab2",
      size = "s",
      easyClose = TRUE,
      footer = NULL
    ))
  })
  
}

# Run the app
shinyApp(ui, server)
Stéphane Laurent
  • 75,186
  • 15
  • 119
  • 225