rdataframeshinyshinyappsshiny-reactivity

How to get result from a module only when a button of this module is clicked?


Context

Here is an app with a module where you can select the column of a data frame. The module returns the data frame with only the selected column.

Question

How to modify this example to make the renderDataTable updated only when the Go! button is clicked inside the module?

Code

library(shiny)
library(dplyr)

## Module
return_df_UI <- function(id, df) {
  ns <- NS(id)
  tagList(
    selectInput(ns("column"),
                label = "Choose a column",
                choices = names(df)),
    actionButton("go",
                 label = "Go!")
  )
}

return_df_Server <- function(id, df) {
  moduleServer( id, function(input, output, session) {
      reactive(dplyr::select(df, dplyr::all_of(input$column)))
  })
}

## App
ui <- fluidPage(
  return_df_UI("rdf", mtcars),
  dataTableOutput("out")
)

server <- function(input, output, session) {
  selection <- return_df_Server("rdf", mtcars)
  output$out <- renderDataTable({
    selection()
  })
}

shinyApp(ui, server)

Effort

I have tried to add req(input$go) inside the reactive returned by the moduleServer but then the renderDataTable is never updated :

return_df_Server <- function(id, df) {
  moduleServer( id, function(input, output, session) {
      reactive({
        req(input$go)
        dplyr::select(df, dplyr::all_of(input$column))
        })
  })
}

Solution

  • First rule I learnt about shiny modules: If the UI is not working as expected, check for missing calls to ns.

    1. You have a missing call to ns on the button id.
    2. Bind the (re)-calculations of the reactive to the button using bindEvent.

    Here's the updated code:

    library(shiny)
    library(dplyr)
    
    ## Module
    return_df_UI <- function(id, df) {
      ns <- NS(id)
      tagList(
        selectInput(ns("column"),
                    label = "Choose a column",
                    choices = names(df)),
        actionButton(ns("go"),
                     label = "Go!")
      )
    }
    
    return_df_Server <- function(id, df) {
      moduleServer( id, function(input, output, session) {
        reactive(dplyr::select(df, dplyr::all_of(input$column))) |> bindEvent(input$go)
      })
    }
    
    ## App
    ui <- fluidPage(
      return_df_UI("rdf", mtcars),
      dataTableOutput("out")
    )
    
    server <- function(input, output, session) {
      selection <- return_df_Server("rdf", mtcars)
      output$out <- renderDataTable({
        selection()
      })
    }
    
    shinyApp(ui, server)