CODEWITHSUNDEEP
rlapplyshiny
antuki
antuki

Reputation: 236

lapply function using a numericInput parameter around an observeEvent in RShiny

I would like to create many multiple selectize inputs which are connected with each other. In other words : if an item is selected in one of the selectizeinputs i would like that it disappears from the other selectizeinputs' choices. In addition, i would like that the number of selectize inputs corresponds to the number selected in a numericinput.

The example below is working. The only question I have left is on the following line :

  X = 1:100, ####### QUESTION HERE

Instead of 1:100, i would like to put something like 1:input$ui_number but I have the following error in R :

 Error in .getReactiveEnvironment()$currentContext() :  Operation not allowed without an active reactive context.

And if I put a "reactive" or an "observe" function around the lapply, the observeEvent does not work anymore. Any trick for me ?

Thank you for your help !

 modalities <- LETTERS[1:10]

 library(shiny)

 app <- shinyApp(
   ui = tabPanel("Change modalities",
            numericInput("ui_number", label="Number of modalities",min = 1, max = 4, value=3),
            uiOutput("renderui")
   ),


   server = function(input, output, session) {


     output$renderui <- renderUI({
       output = tagList()
       for(i in 1:input$ui_number){
         output[[i]] = tagList()
         output[[i]][[1]] = selectizeInput(paste0("ui_mod_choose",i), label=paste0("Modality ",i),choices=modalities, multiple = TRUE)
  }
  return(output)
})


 lapply(
  X = 1:100, ####### QUESTION HERE
  FUN = function(j){
    observeEvent({
      input[[paste0("ui_mod_choose",j)]]
    },
    {
      sapply(1:input$ui_number,function(i){
        vecteur <- do.call(c,lapply((1:input$ui_number)[-i],function(i){input[[paste0("ui_mod_choose",i)]]}))
        updateSelectizeInput(session,paste0("ui_mod_choose",i),choices=  modalities[!modalities %in% vecteur],selected = input[[paste0("ui_mod_choose",i)]])
      })
    },
    ignoreNULL = FALSE)

  }
)


observeEvent({
  input$ui_num
},
{
  sapply(1:nput$ui_num,function(i){ 
    updateSelectizeInput(session,paste0("ui_mod_choose",i),choice= modalities,selected=NULL)
       })
     }
     )

   }

 )
 runApp(app)

Upvotes: 1

Views: 585

Answers (1)

Aur&#232;le
Aur&#232;le

Reputation: 12839

You could have a single observe() instead of multiple observeEvent():

library(shiny)

modalities <- LETTERS[1:10]

ui = tabPanel("Change modalities",
              numericInput("ui_number", label = "Number of modalities",
                           min = 1, max = 4, value = 3),
              uiOutput("renderui"))

server = function(input, output, session) {

  # Generate modalities select lists
  output$renderui <- renderUI({
    output = tagList()
    for (i in seq_len(input$ui_number)) {
      output[[i]] = selectizeInput(paste0("ui_mod_choose", i), 
                                   label = paste0("Modality ", i),
                                   choices = modalities, multiple = TRUE)
    }
    return(output)
  })

  # Remove selected modalities from other select lists
  observe({
    n <- isolate(input$ui_number)
    for (i in seq_len(n)) {
      vecteur <- unlist(lapply((1:n)[-i], function(i) 
        input[[paste0("ui_mod_choose",i)]]))
      updateSelectizeInput(session, paste0("ui_mod_choose",i),
                           choices = setdiff(modalities, vecteur),
                           selected = input[[paste0("ui_mod_choose",i)]])
    }
  })

}

runApp(shinyApp(ui, server))

Upvotes: 1

Related Questions