How do you get get reactive UI elements in a modal with modules.

shiny
, ,
1

I'm designing an app that will have multiple tabs that all have basic ui features on the side, but hid various advanced UI options in a pop-up modal button. Some of these options are responsive to the dataset, for example choosing which rows to use.

I want to use modules to design the app, but am running into trouble getting reactive UI elements into the modals.

I think modalUI1 is getting the right namespace, but when I call uiOutput on the reactive ui element made by settingsServer1 it doesn't show up.

The closest slack post I found did something similar, but the modal they had static UI.
It can be found Here

Below is the reproducible code:

# Basic View Functions ----------------------------------------------------
# These modules setup the basic view for each analysis

simpleui <- function(id){
  ns <- NS(id)
  selectData <- selectInput(ns("d"), "Dataset:",
                    c("iris",
                      "mtcars",
                      "iris3"))
  outputRows <- verbatimTextOutput(ns("df"))
  settingsButton<-
    actionButton(
      ns("settings"),
      "Settings")
  tabPanel(id,
  tagList(
    p(),
    selectData,
    p(),
    outputRows,
    p(),
    settingsButton
  )
  )

}
view1 <- function(input, output, session) {
  reactiveDf <-  reactive({
    switch(input$d,
           "iris" = iris,
           "mtcars" = mtcars,
           "iris3"= iris3)
  })
  output$df <-  renderText({nrow(reactiveDf())})
  callModule(settingsServer1, "settings", reactiveDf)
  observeEvent(input$settings, {
    showModal(settngsModal(session$ns))
  })

  settngsModal <- function(ns) {
    # ns <- NS(id) ### This is inner UI so passed namespace from outer
    modalDialog(
      modalUI1("settings"), ### Call innerModalUI.
      # withTags({  # UI elements for the modal go in here
      #   fluidRow(
      #     column(4, "Inputs","Sectionnormal",uiOutput("nrowSlide")),
      #     column(4, "Inputs","Sectionnormal",uiOutput(ns("nrowSlide")))
      #   )}
      ,
      title = "Settings",
      footer = modalButton("Dismiss"),
      size = "l",
      easyClose = FALSE,
      fade = TRUE)
  }
}


# Advanced settings hidden in modal ---------------------------------------
# These functions should hide the advanced UI settings in a Modal.
modalUI1 <- function(ns) {
  ### Several UI elements 1 of which chooses which first N Rows.
  ### The slider is reactive
  # reactiveSlider <-  uiOutput("nrowSlide")
  withTags({  # UI elements for the modal go in here
    fluidRow(
      # print(ns("nrowSlide")),
      # print(input),
      column(4, "---------",uiOutput(("nrowSlide")), "---------")
    )
  })
}
settingsServer1 <- function(input, output, session, reactiveDf){
  output$nrowSlide <- renderUI({
    sliderInput("obs", "Number of observations:",
                min = 1, max = nrow(reactiveDf()), value = 1)
  })
}



# Basic Setup -------------------------------------------------------------
ui <- shinyUI(navbarPage("My Application",
                         simpleui("v1"),
                         simpleui("v2")
))


server <- function(input, output, session) {
  callModule(view1, "v1")
  callModule(view1, "v2")
  ### Also look for event to create a modal.
  ### This modal will have reactive items.



}

shinyApp(ui, server)
2

I would highly recommend using the newer style of modules described in https://mastering-shiny.org/scaling-modules.html — it makes it much easier to see what your modules are doing and hence easier to debug any problems that might come up.

3

I need to work on something else now, so here's my progress. It still doesn't work, but I think it's a little easier to understand what's going on:

library(shiny)
# https://mastering-shiny.org/scaling-modules.html
moduleServer <- function(id, module) callModule(module, id)

# Advanced settings hidden in modal ---------------------------------------
settingsUi <- function(id) {
  modalDialog(
    uiOutput(NS(id, "controls")),
    title = "Settings",
    footer = modalButton("Dismiss"),
    size = "l",
    easyClose = FALSE,
    fade = TRUE
  )
}
settingsServer <- function(id, df) {
  stopifnot(is.reactive(df))
  
  moduleServer(id, function(input, output, session) {
    output$controls <- renderUI({
      sliderInput(NS(id, "obs"), "Number of observations", min = 1, max = 100, value = 1)
    })
  })
}

# Simple view of dataset --------------------------------------------------
simpleUi <- function(id) {
  tabPanel(NS(id, "panel"),
    tagList(
      selectInput(NS(id, "d"), "Dataset:", c("iris", "mtcars", "iris3")),
      verbatimTextOutput(NS(id, "df")),
      actionButton(NS(id, "show_settings"), "Settings")
    )
  )
}

simpleServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    df <- reactive({
      switch(input$d,
        "iris" = iris,
        "mtcars" = mtcars,
        "iris3" = iris3
      )
    })
    output$df <- renderPrint(dim(df()))
    
    observeEvent(input$show_settings, {
      showModal(settingsUi(NS(id, "settings")))
    })
    settingsServer(NS(id, "settings"), df)
  })
}

# Basic Setup -------------------------------------------------------------
ui <- shinyUI(
  navbarPage(
    "My application",
    simpleUi("v1"),
    simpleUi("v2")
  )
)
server <- function(input, output, session) {
  simpleServer("v1")
  simpleServer("v2")
}
shinyApp(ui, server)
1 Like
4

@LionelD, your code almost worked. Here are the differences:

37c38
<     showModal(settngsModal(session$ns))
---
>     showModal(settngsModal())
40c41
<   settngsModal <- function(ns) {
---
>   settngsModal <- function() {
43c44
<       modalUI1("settings"), ### Call innerModalUI.
---
>       modalUI1(session$ns("settings")), ### Call innerModalUI.
61c62,63
< modalUI1 <- function(ns) {
---
> modalUI1 <- function(id) {
>   ns <- NS(id)
69c71
<       column(4, "---------",uiOutput(("nrowSlide")), "---------")
---
>       column(4, "---------",uiOutput(ns("nrowSlide")), "---------")

I've done a couple of things differently, but the main thing is that you forgot to wrap with ns() in a couple of places.

@hadley the only problem with yours was the line settingsServer(NS(id, "settings"), df), that should just be settingsServer("settings", df) (because moduleServer/callModule will automatically qualify the id with the current namespace).

1 Like
5

Thanks for taking a look. I didn't know about the new module format. This is easier to understand. I'll take a look.

Working code pasted below for completeness thanks to hadley and jcheng.

# Basic View Functions ----------------------------------------------------
# These modules setup the basic view for each analysis

simpleui <- function(id){
  ns <- NS(id)
  selectData <- selectInput(ns("d"), "Dataset:",
                            c("iris",
                              "mtcars",
                              "iris3"))
  outputRows <- verbatimTextOutput(ns("df"))
  settingsButton<-
    actionButton(
      ns("settings"),
      "Settings")
  tabPanel(id,
           tagList(
             p(),
             selectData,
             p(),
             outputRows,
             p(),
             settingsButton
           )
  )
  
}
view1 <- function(input, output, session) {
  reactiveDf <-  reactive({
    switch(input$d,
           "iris" = iris,
           "mtcars" = mtcars,
           "iris3"= iris3)
  })
  output$df <-  renderText({nrow(reactiveDf())})
  callModule(settingsServer1, "settings", reactiveDf)
  observeEvent(input$settings, {
    showModal(settngsModal())
  })
  
  settngsModal <- function() {
    # ns <- NS(id) ### This is inner UI so passed namespace from outer
    modalDialog(
      modalUI1(session$ns("settings")), ### Call innerModalUI.
      # withTags({  # UI elements for the modal go in here
      #   fluidRow(
      #     column(4, "Inputs","Sectionnormal",uiOutput("nrowSlide")),
      #     column(4, "Inputs","Sectionnormal",uiOutput(ns("nrowSlide")))
      #   )}
      ,
      title = "Settings",
      footer = modalButton("Dismiss"),
      size = "l",
      easyClose = FALSE,
      fade = TRUE)
  }
}


# Advanced settings hidden in modal ---------------------------------------
# These functions should hide the advanced UI settings in a Modal.
modalUI1 <- function(id) {
  ns <- NS(id)
  ### Several UI elements 1 of which chooses which first N Rows.
  ### The slider is reactive
  # reactiveSlider <-  uiOutput("nrowSlide")
  withTags({  # UI elements for the modal go in here
    fluidRow(
      # print(ns("nrowSlide")),
      # print(input),
      column(4, "---------",uiOutput(ns("nrowSlide")), "---------")
    )
  })
}
settingsServer1 <- function(input, output, session, reactiveDf){
  output$nrowSlide <- renderUI({
    sliderInput("obs", "Number of observations:",
                min = 1, max = nrow(reactiveDf()), value = 1)
  })
}



# Basic Setup -------------------------------------------------------------
ui <- shinyUI(navbarPage("My Application",
                         simpleui("v1"),
                         simpleui("v2")
))


server <- function(input, output, session) {
  callModule(view1, "v1")
  callModule(view1, "v2")
  ### Also look for event to create a modal.
  ### This modal will have reactive items.
  
  
  
}

shinyApp(ui, server)
7

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.