kyleGrealis
kyleGrealis

Reputation: 61

`conditionalPanel` and `renderUI` within Shiny modules

I'm trying to get my Shiny app to work using the rhino package. I have successfully created a data module that allows the user to select a dataset to be imported. This next problem module is supposed to accept the dataset (it does) and dynamically render selectInput()s based on the variable names in the dataset (it does, but not properly when using conditionalPanel).

The goal: create an app that will complete a case-control matching algorithm. Have the user upload a dataset and select the participant ID variable, case-control variable, and 3 other matching criteria variables. I would like to have the next successive input only render once the previous value evaluates !is.null() and != "".

I am including the problematic inputs.R module. You can see my 2 attempts at getting the condition to work correctly, but it won't with either method.

#' @export
ui <- function(id) {
  ns <- NS(id)
  useShinyjs()
  tagList(
    uiOutput(ns("idVariable")),
    conditionalPanel(
      # condition = paste0("input['", ns("idVariable"), "'] == ''"),
      condition = "input['idVariable-idVariable'] == ''",
      "This is a test and should show once the data is loaded." # not showing
    ),
    conditionalPanel(
      condition = paste0("input['", ns("idVariable"), "'] != ''"),
      ns = ns,
      uiOutput(ns("caseControl")) # currently displays after data is loaded
    )
  )
}

#' @export
server <- function(id, newFile) {
  moduleServer(id, function(input, output, server) {

    message("Module ", id, " has been activated.")
    ns <- NS(id)

    output$idVariable <- renderUI({
      if (is.null(newFile())) {
        return(NULL)
      }
      selectInput(
        ns("idVariable"), "Choose ID variable.",
        choices = c("", names(newFile())),
        selected = ""
      )
    })

    output$caseControl <- renderUI({
      if (is.null(newFile())) {
        return(NULL)
      }
        selectInput(
          ns("caseControl"),
          span("Choose case-control variable.", bs_icon("info-circle-fill")),
          choices = c(
            "",
            setdiff(
              newFile() |> purrr::keep(is.numeric) |> names(),
              c(input$idVariable)
            )
          )
        )
    })

  })
}

This app works outside of the module format (i.e.-- one longer app.R style script). Also, removing the conditionalPanel displays all of the inputs at once. This can be used, but I'm so far down the rabbit hole of NOT understanding how the pieces work together that I would love to know where I'm falling short.

NEEDS:

  1. dynamically render the case-control input
  2. learn how and why the namespacing happens like this inside of modules
  3. understand the JS evaluation of the condition = inside of conditionalPanels when using modules.

Any help is greatly appreciated!

Upvotes: 0

Views: 85

Answers (1)

stefan
stefan

Reputation: 123783

To fix your conditionalPanels provide the namespace via the ns= argument as you already did for the second panel. After doing so you could simply use input.idVariable for the condition. Also, when using renderUI it is recommended to get the namespace from the session object, i.e. inside the module server use ns <- session$ns instead of ns <- NS(id) (see https://shiny.posit.co/r/articles/improve/modules/).

Here is a minimal working app using iris as example data where I added a simple ggplot for testing.

#' @export
module_ui <- function(id) {
  ns <- NS(id)
  tagList(
    uiOutput(ns("idVariable")),
    conditionalPanel(
      condition = "input.idVariable === ''",
      ns = ns,
      "This is a test and should show once the data is loaded." # not showing
    ),
    conditionalPanel(
      condition = "input.idVariable !== ''",
      ns = ns,
      uiOutput(ns("caseControl")) # currently displays after data is loaded
    ),
    plotOutput(ns("plot"))
  )
}

#' @export
module_server <- function(id, newFile) {
  moduleServer(id, function(input, output, session) {
    message("Module ", id, " has been activated.")
    ns <- session$ns

    output$idVariable <- renderUI({
      if (is.null(newFile())) {
        return(NULL)
      }
      selectInput(
        ns("idVariable"), "Choose ID variable.",
        choices = c("", names(newFile())),
        selected = ""
      )
    })

    output$caseControl <- renderUI({
      if (is.null(newFile())) {
        return(NULL)
      }
      selectInput(
        ns("caseControl"),
        span("Choose case-control variable."),
        choices = c(
          "",
          setdiff(
            newFile() |> purrr::keep(is.numeric) |> names(),
            c(input$idVariable)
          )
        )
      )
    })

    output$plot <- renderPlot({
      req(input$caseControl)
      ggplot(
        newFile(),
        aes(x = .data[[input$caseControl]], fill = .data[[input$idVariable]])
      ) +
        geom_histogram()
    })
  })
}

library(shiny)
library(ggplot2)

ui <- fluidPage(
  module_ui("mod")
)

server <- function(input, output, session) {
  dat <- reactive({
    iris
  })
  module_server("mod", dat)
}

shinyApp(ui, server)

enter image description here

enter image description here

Upvotes: 2

Related Questions