How to dynamically update dropdown within a modulized shinyalert for each iteration of a for loop, when using html = TRUE?

374 Views Asked by At

I'm creating a shiny module, where I wish to display some pop-up messages to the user via shinyalerts and include dropdown menus via htlm = TRUE and shinyWidgets::pickerInput. For each shinyalert the options should be different and the alerts should appear right after each other when the user has selected the relevant option. However, when running the shinyalerts within a for loop, only the first alert shows the drop-down, the following does not. Please have a look at the example below and screenshots. Any ideas what I'm doing wrong?

Module UI:

mod_match_columns_ui <- function(id){
  ns <- NS(id)
  tagList(
    shinyalert::useShinyalert(),
    actionButton(ns("run"), label = "Start!")
  )
}

Module server:

mod_match_columns_server <- function(input, output, session){
  ns <- session$ns
  
  options <- list(c("option_1","option_2"),
       c("option_3","option_4"))
  
  observeEvent(input$run, {
    for(col in 1:2){
      nms <- options[[i]]
      output[[paste0("dropdown",col)]] <- renderUI({
        shinyWidgets::pickerInput(
          inputId = ns(paste0("options",col)),
          label = "Options listed below", 
          choices = nms,
          selected = "",
          multiple = FALSE,
          options = shinyWidgets::pickerOptions(size = 15)
        )
      })
      shinyalert::shinyalert(
        title = "Pick an option!",
        html = TRUE,
        text = tagList(
          uiOutput(ns(paste0("dropdown", col)))
        ),
        inputId = ns(paste0("modal", col))
      )
    }
  })
}

Run module:

library(shiny)

ui <- fluidPage(
  mod_match_columns_ui("match_columns_ui_1")
)

server <- function(input, output, session) {
  callModule(mod_match_columns_server, "match_columns_ui_1")
}

shinyApp(ui = ui, server = server)

First iteration: This is what I want

Second iteration: Dropdown is not shown

Why is the dropdown not shown in the second iteration?? Thanks

1

There are 1 best solutions below

1
YBS On

Try this

library(shiny)
library(shinyalert)

mod_match_columns_ui <- function(id){
  ns <- NS(id)
  tagList(
    shinyalert::useShinyalert(),
    actionButton(ns("run"), label = "Start!")
  )
}

mod_match_columns_server <- function(id) {
  moduleServer(id,
    function(input, output, session) {

      ns <- session$ns

      options <- list(c("option_1","option_2"),
                      c("option_3","option_4"))

      lapply(1:2, function(col){
        
        output[[paste0("dropdown",col)]] <- renderUI({
          shinyWidgets::pickerInput(
            inputId = ns(paste0("options",col)),
            label = paste("Options",col,"listed below"),
            choices = options[[col]],
            selected = "",
            multiple = FALSE,
            options = shinyWidgets::pickerOptions(size = 15)
          )
        })
        
      })
      
      observeEvent(input$run, {
 
        shinyalert::shinyalert(
          title = "Pick an option!",
          html = TRUE,
          text = tagList(
            lapply(1:2, function(i){uiOutput(ns(paste0("dropdown",i)))})
          )
          # callbackR = function(x) { message("Hello ", x) },
          # inputId = ns(paste0("modal"))
        )
          
      })
      
      observe({
        print(input$options1)
        print(input$options2)
        print(input$shinyalert)
      })

    })
}

ui <- fluidPage(
  tagList(
    mod_match_columns_ui("match_columns_ui_1")
  )
)

server <- function(input, output, session) {
  mod_match_columns_server("match_columns_ui_1")
}

shinyApp(ui = ui, server = server)