Village.Idyot
Village.Idyot

Reputation: 2119

How to create a conditional panel using a reactive object that is passed from another module?

In the below R Shiny MWE module code, I am trying to replace the textOutput() in the mod30_ui_input and the renderText() in the mod30_server with a conditionalPanel() that essentially does the same thing. The conditionalPanel() would go in the mod30_ui_input. Note how in the module server I simply use common$tabsKey() (the reactive object passed to this module from another module) and it works fine when used with renderText(); I don't know how to define or reformat common$tabsKey() for use in a conditionalPanel(). How would I use the common$tabsKey() reactive object in a conditionalPanel()?

The common object is a reactive passed from another module to this MWE module. I use a ui and server section in this module (at the bottom) so I can run it independent of other modules for testing.

The below MWE is crude for brevity. Running the code as-is renders "PASS" in the sidebar panel. Changing the "ABC" in the common$tabsKey() == "ABC", for example to "AB", and running the code causes the "PASS" to not appear.

This is the module structure I've been using for the larger this MWE is condensed from. Here's the code:

library(shiny)

mod30_ui_input <- function(id) {
  ns <- NS(id)
  tagList(
    div(textOutput(ns("test_signal"))) 
  )
}

mod30_server <- function(id, common) { 
  moduleServer(id, function(input, output, session) {
    mod30_data <- reactiveValues()
    
    output$test_signal <- renderText({
      if(common$tabsKey() == "ABC") {"PASS"}
    })
    
  }) 
} 

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      h2("Sidebar"),
      mod30_ui_input("mod30")
    ),
    mainPanel(h2("Main Page"))
  )
)

server <- function(input, output, session) {
  common <- list(tabsKey = reactive("ABC")) # Change from "ABC" to something else to test
  mod30_data <- mod30_server("mod30", common)
}

shinyApp(ui, server)

Upvotes: 0

Views: 31

Answers (2)

Village.Idyot
Village.Idyot

Reputation: 2119

Following up on Limey's solution, I show Examples A, B, and C below. I took out the user input, instead for testing I manually change reactiveValues(tabsKey = ...) in the server to something other than TRUE.

The below works using conditionalPanel() -- Example A:

library(shiny)

mod30_ui_input <- function(id) {
  ns <- NS(id)
  tagList(
    tags$div(
      style = "display: none;",
      textInput(ns("tabsKey"), label = NULL, value = "FALSE")
    ),
    conditionalPanel(
      condition = paste0("input['", ns("tabsKey"), "'] == 'TRUE'"),
      "ABC",
      style = "display: none;"
    )
  )
}

mod30_server <- function(id, common) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    observe({
      updateTextInput(session, "tabsKey", value = common$tabsKey)
    })
  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      h2("Sidebar"),
      mod30_ui_input("mod30")
    ),
    mainPanel(
      h2("Main Page")
    )
  )
)

server <- function(input, output, session) {
  common <- reactiveValues(tabsKey = "TRUE")  # TRUE renders "ABC" in sidebar panel
  mod30_server("mod30", common)
}

shinyApp(ui, server)

Alternatively, using renderUI, Example B:

library(shiny)

mod30_ui_input <- function(id) {
  ns <- NS(id)
  tagList(
    uiOutput(ns("dynamicUI"))  
  )
}

mod30_server <- function(id, common) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    output$dynamicUI <- renderUI({
      if (common$tabsKey == "TRUE") {
        "ABC"
      } else {
        NULL  
      }
    })
  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      h2("Sidebar"),
      mod30_ui_input("mod30")
    ),
    mainPanel(
      h2("Main Page")
    )
  )
)

server <- function(input, output, session) {
  common <- reactiveValues(tabsKey = "TRUE")  # TRUE renders "ABC" in sidebar panel
  mod30_server("mod30", common)
}

shinyApp(ui, server)

The below works using conditionalPanel() and some scripts in java instead of the textInput()functions used in Example A, I also leave a user input in the server so the user can test this more easily -- Example C:

library(shiny)

# Module UI
mod30_ui_input <- function(id) {
  ns <- NS(id)
  tagList(
    conditionalPanel(
      condition = paste0("Shiny.shinyapp.$values['", ns("tabsKey"), "'] === 'TRUE'"),
      "ABC"
    ),
    tags$script(HTML(paste0(
      "Shiny.addCustomMessageHandler('updateTabsKey-", ns(""), "', function(value) {",
      "  Shiny.shinyapp.$values['", ns("tabsKey"), "'] = value;",
      "});"
    )))
  )
}

# Module Server
mod30_server <- function(id, tabsKey) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    # Send the value of tabsKey to the UI
    observe({
      session$sendCustomMessage(paste0("updateTabsKey-", ns("")), tabsKey())
    })
  })
}

# Parent UI
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      h2("Sidebar"),
      mod30_ui_input("mod30")
    ),
    mainPanel(
      h2("Main Page"),
      checkboxInput("toggle", "Show ABC?", value = TRUE)  # Checkbox to toggle tabsKey
    )
  )
)

# Parent Server
server <- function(input, output, session) {
  # Reactive value for tabsKey (passed to the module)
  tabsKey <- reactive({
    ifelse(input$toggle, "TRUE", "FALSE")
  })
  
  # Call the module
  mod30_server("mod30", tabsKey)
}

shinyApp(ui, server)

Upvotes: 0

Limey
Limey

Reputation: 12586

Try this.

I've added a checkboxInput to the main UI and server and changed common from a list to a reactiveValues. Checking the check box causes the module to display the text, unchecking it hides the text.

This isn't a conditionalPanel (your example doesn't have one), but you can use the same technique to control a conditionalPanel (or a uiOutput).

library(shiny)

mod30_ui_input <- function(id) {
  ns <- NS(id)
  tagList(
    div(textOutput(ns("test_signal")))
  )
}

mod30_server <- function(id, common) {
  moduleServer(id, function(input, output, session) {
    mod30_data <- reactiveValues()

    output$test_signal <- renderText({
      if(common$tabsKey == "ABC") {"PASS"}
    })
  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      h2("Sidebar"),
      mod30_ui_input("mod30")
    ),
    mainPanel(
      h2("Main Page"),
      checkboxInput("show", "Show text?", value = FALSE)
    )
  )
)

server <- function(input, output, session) {
  common <- reactiveValues(tabsKey = "XYZ") # Change from "ABC" to something else to test
  mod30_data <- mod30_server("mod30", common)

  observeEvent(input$show, {
    common$tabsKey <- ifelse(input$show, "XYZ", "ABC")
  })
}

shinyApp(ui, server)

You say that in your real app common is a reactive returned by another module. That's fine. Make your module return a reactive, not a list. Something like:

rv <- reactive({
  list(tabsKey = <some reactive value>)
})

return(rv)

Alternatively, I find using session$userData useful for inter module communication.

Upvotes: 1

Related Questions