CODEWITHSUNDEEP
rshiny
Raja Saha
Raja Saha

Reputation: 509

How to create dynamic number of observeEvent in shiny?

Here I have tried to replicate my original problem. The following shiny code will create 'Sub Segment' button if you click on 'Add a Segment'.

Now 'Add a Sub Segment' button should give a single line text on each click. But what I have noticed, It creates (1 + number of 'Add a Segment' button after the clicked one) many lines.

For single observeEvent it is working (the code is commented out).

library(shiny)

ui <- fluidPage(
  verbatimTextOutput("txt",placeholder = T), #"It is Created for Testing"
  actionButton("addSeg", "Add a Segment"),
  uiOutput("myUI")
)

server <- function(input, output, session) {
  alld <- reactiveValues()
  alld$ui <- list()

  # Action to add new Segment
  observeEvent(input$addSeg,{
    alld$ui[[length(alld$ui)+1]] <- list(actionButton(paste0("addSub_",(length(alld$ui)+1)), "Add a Sub Segment"))
  })

  # Action to add new Sub Segment
  # observeEvent(input[[paste0("addSub_",1)]],{
  #   alld$ui[[1]][[length(alld$ui[[1]])+1]] <- paste0("addSub_",1)
  # })

  observeEvent(input$addSeg,{
    lapply(1:length(alld$ui), function(i){
      observeEvent(input[[paste0("addSub_",i)]],{
        alld$ui[[i]][[length(alld$ui[[i]])+1]] <- HTML(paste0("<br>addSub_",i,"<br>"))
      })
    })
  })

  output$myUI <- renderUI({alld$ui})

  output$txt <- renderText(class(alld$ui))
}

shinyApp(ui, server)

Please Help...

enter image description here

Upvotes: 5

Views: 2382

Answers (1)

A. Stam
A. Stam

Reputation: 2222

Very interesting question, and a very commendable reprex. I managed to find a solution. You can replace your server object with this:

server <- function(input, output, session) {
  alld <- reactiveValues()
  alld$ui <- list()

  # Action to add new Segment
  observeEvent(input$addSeg,{
    new_id <- length(alld$ui) + 1
    sub_name <- paste0("addSub_", new_id)

    alld$ui[[new_id]] <- list(
      actionButton(sub_name, "Add a Sub Segment")
    )

    observeEvent(input[[sub_name]], {
      new_text_id <- length(alld$ui[[new_id]]) + 1
      alld$ui[[new_id]][[new_text_id]] <- HTML(paste0("<br>addSub<br>"))
    })
  })

  output$myUI <- renderUI({alld$ui})

  output$txt <- renderText({
    capture.output(str(alld$ui))
  })
}

Let's talk about your original code. Your first observer works just fine. The second one, however, is causing the unwanted behaviour. It returns a list of new observers, one for every addSub button currently in the app. This means that on the first click, it creates an observer for addSub_1, and on the second click, it returns an observer for addSub_1 and addSub_2. However, the first addSub_1 observer still exists. This means that when you click addSub_1, there are two observers responding and the text is shown twice.

My solution is to combine your two observers into one. When you click addSeg, the button is created in the UI-list, and the observer that handles it is also created. This way, there are no duplicates and the app works as expected.

Upvotes: 6

Related Questions