Reputation: 61
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:
condition =
inside of conditionalPanel
s when using modules.Any help is greatly appreciated!
Upvotes: 0
Views: 85
Reputation: 123783
To fix your conditionalPanel
s 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)
Upvotes: 2