rshinyshinyjsmodularization

How to show and hide a user input triggered by a reactive from another module?


I've been showing/hiding UI items using Shiny conditionalPanel() and shinyjs show, hide, and toggle functions. However, in this multi-module example I'm stuck. I'm trying to show/hide the selectInput() in the second module (mod2), triggered by the action button "Calculate" in the first module (mod1). Until the "Calculate" action button is clicked, I would like the "Select Series" selectInput() to be hidden. As shown in the below illustration.

Below is a skeleton version of my 2-module code. What I am having difficulty with is how to hide selectInput() in the mod2_ui when the unhide is to be triggered by the reactive common$calc_click which comes from the mod1_server. Essentially, I'm trying to have actions from the mod1_ui govern actions in other modules too. Any suggestions? I'm trying to avoid renderUI() because of the problems it presents (speed, invocation flashing, etc.) but perhaps that is unavoidable. Maybe some else has better ideas?

enter image description here

Code:

library(shiny)

seriesTrm <- data.frame('Series_1' = c(1,2,3),row.names = c("A","B","C"))

mod1_ui <- function(id) {
  ns <- NS(id)
  list(
    calcBttn = actionButton(ns("calculate"), "Calculate"), 
    allocTable = textOutput(ns("alloc_tbl")),
    info_text = uiOutput(ns("click_warn_1"))
  )
}

mod1_server <- function(id, common, input) {
  moduleServer(id, function(input, output, session) {
    calc_click <- reactiveVal(FALSE)  
    allocData <- reactiveVal()
    
    observeEvent(input$calculate, {
      calc_click(TRUE)
      common$mod1_data <- allocData  
    }) 
    
    output$click_warn_1 <- renderText(if(!calc_click()){"Click Calculate to render mod1 table"}) 
    observe({common$calc_click <- calc_click()})
    output$alloc_tbl <- renderText({if(calc_click()){"Mod1 table appears here"}})
  }) 
}

mod2_ui <- function(id) {
  ns <- NS(id)
  list(
    seriesSelect = selectInput(ns("seriesSelect"), "Select Series", choices = NULL),
    mod2Output = textOutput(ns("series_tbl")),
    info_text = uiOutput(ns("click_warn_2"))
  )
}

mod2_server <- function(id, common, input) {
  moduleServer(id, function(input, output, session) {
    reactive_choices <- reactive({colnames(common$seriesTbl_1())})
    observe({updateSelectInput(session, "seriesSelect", choices = reactive_choices())})
    calc_click <- reactive(common$calc_click)
    output$click_warn_2 <- renderText(if(!calc_click()){"Click Calculate to render mod2 table"})
    output$series_tbl <- renderText({if(calc_click()){"Mod2 table appears here"}})
  })
}

ui <- fluidPage(
 tableOutput('hottable_1'),br(),
 mod1_ui("mod1")$calcBttn,br(),br(),
 mod1_ui("mod1")$info_text,
 mod1_ui("mod1")$allocTable, br(),
 mod2_ui("mod2")$info_text,br(),
 mod2_ui("mod2")$seriesSelect, br(),
 mod2_ui("mod2")$mod2Output 
) 

server <- function(input,output,session)({
  seriesTbl_1 <- reactiveVal(seriesTrm) 
  observeEvent(input$hottable_1, {seriesTbl_1(hot_to_r(input$hottable_1))})
  
  output$hottable_1 <- renderTable({seriesTbl_1()})
  
  common <- reactiveValues(seriesTbl_1 = reactive(seriesTbl_1()))
  mod1_data <- mod1_server("mod1", common, input)
  mod2_server("mod2", common, input)
}) 

shinyApp(ui, server)

Solution

  • Following Build a dynamic UI that reacts to user input one option would be to use a helper output to store the value of calc_click which can then be used in the condition of a conditionalPanel like so:

    mod2_ui <- function(id) {
      ns <- NS(id)
      list(
        seriesSelect =
          conditionalPanel(
            condition = "output.show_series",
            selectInput(
              ns("seriesSelect"), "Select Series",
              choices = NULL
            ),
            ns = ns
          ),
        mod2Output = textOutput(ns("series_tbl")),
        info_text = uiOutput(ns("click_warn_2"))
      )
    }
    
    mod2_server <- function(id, common, input) {
      moduleServer(id, function(input, output, session) {
        reactive_choices <- reactive({
          colnames(common$seriesTbl_1())
        })
        observe({
          updateSelectInput(session, "seriesSelect",
            choices = reactive_choices()
          )
        })
        calc_click <- reactive(common$calc_click)
        output$click_warn_2 <- renderText(if (!calc_click()) {
          "Click Calculate to render mod2 table"
        })
        output$series_tbl <- renderText({
          if (calc_click()) {
            "Mod2 table appears here"
          }
        })
        output$show_series <- reactive({ calc_click() })
        outputOptions(output, "show_series", suspendWhenHidden = FALSE)
      })
    }
    

    enter image description here

    enter image description here