How to Create Dynamic Number of Observeevent in Shiny

How to create dynamic number of observeEvent in shiny?

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.

How to create dynamic number of observeEvent in another observeEvent?

This behaviour occurs because the custom UI element is re-rendered every time a new element is added to the list. Once you click "V2" and the new text element is added, the selectInput itself re-renders and resets to V1, which is noticed by the observer you've created.

The following might be a solution for you:

  observeEvent(input$addSeg,{
    new_id <- length(alld$ui) + 1
    sub_name <- paste0("addSub_", new_id)

    alld$ui[[new_id]] <- list(
      selectInput(sub_name,
                  "Add a variable",
                  choices = c("", "V1","V2"),
                  selected  = "")
      )

    observeEvent(input[[sub_name]], {
      if (input[[sub_name]] == "") return()
      new_text_id <- length(alld$ui[[new_id]]) + 1
      alld$ui[[new_id]][[new_text_id]] <- HTML(paste0("Variable ",input[[sub_name]]," added<br>"))
    }, ignoreInit = TRUE)
  })

What I've done here is add an empty option to your selectInputs, and a condition to the corresponding observer that it shouldn't do anything if the input is empty. This way, I'm harnessing the "resetting" behaviour to be useful instead of annoying.

Dynamic number of actionButtons tied to unique observeEvent

Your really close, just wrap the observeEvent part in local.

library(shiny)

ui <- basicPage(
  fluidRow(
    actionButton(inputId = "add_button",
                 label = "Add Button")
  ),
  uiOutput("more_buttons")
)

server <- function(input, output){

  rvs      <- reactiveValues(buttons = list(actionButton(inputId = "button1",
                                                    label = 1)))

  observeEvent(eventExpr = input$add_button,
               handlerExpr = {
                 len      <- length(rvs$buttons) + 1
                 rvs$buttons[[len]] <- actionButton(inputId = paste0("button",len),
                                                    label = len)
               })

  output$more_buttons <- renderUI({
    do.call(fluidRow, rvs$buttons)
  })

  observeEvent(rvs$buttons,{
    for(ii in 1:length(rvs$buttons)){
      local({
        i <- ii
        observeEvent(eventExpr = input[[paste0("button",i)]],
                     handlerExpr = {print(sprintf("You clicked btn number %d",i))})
      })
    }
  })

}

shinyApp(ui, server)

Dynamic UI - Creating observeEvents for Dynamically Created Tables

You can iteratively add observeEvents using lapply() as shown:

library(shiny)
library(dplyr)
library(rhandsontable)
library(purrr)
ui <- fluidPage(
    uiOutput("tables")
)

server <- function(input, output) {
    mtcars$slc <- sample(c("aaa", "bbb"), nrow(mtcars), replace = TRUE)
    df <- mtcars

    getSlice <- function(df_tmp, slca) {
        print(slca)
        df_tmp <- df_tmp %>% filter(slc == slca)
        df_tmp
    }

    output$tables <- renderUI({
        slices <- unique(df$slc)
        input_dfs <- map(slices, ~ getSlice(df, .x))

        for (i in 1:length(slices)) {
            local({
                i <- i
                print(input_dfs[[i]])
                output[[slices[i]]] <- renderRHandsontable(rhandsontable(input_dfs[[i]]))
            })
        }
        out <- map(slices, function(x) {
            rHandsontableOutput(x)
        })
        print(out)
        out
    })

    ### How do I create observeEvents for...
    # input$aaa$changes$changes
    # input$bbb$changes$changes
    # input$arbitrarySlice$changes$changes

    ### Iteratively add observeEvent()
    lapply(unique(df$slc), function(slice) {
        observeEvent(input[[slice]]$changes$changes, {
            print(paste(slice, "has been updated!"))
            print(input[[slice]][["changes"]])
        })
    })

}

shinyApp(ui = ui, server = server)

Shiny - Can dynamically generated buttons act as trigger for an event

You can also create observers dynamically. Just make sure that they are created only once, otherwise they will execute several times.

Below is your code modified to create as many observers as buttons. Please note that if an observer for the button already exist, it should not be created. You can customize your observers too, so each observer could have its own behavior.

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic selectInput"),
  dashboardSidebar(
    sidebarMenu(
      menuItemOutput("menuitem")
    )
  ),
  dashboardBody(
    numericInput("go_btns_quant","Number of GO buttons",value = 1,min = 1,max = 10),
uiOutput("go_buttons"),
plotOutput("plot")
  )
)

server <- function(input, output, session) {
  output$menuitem <- renderMenu({
    menuItem("Menu item", icon = icon("calendar"))
  })

  # to store observers and make sure only once is created per button
  obsList <- list()

  output$go_buttons <- renderUI({
    buttons <- as.list(1:input$go_btns_quant)
    buttons <- lapply(buttons, function(i)
      {
        btName <- paste0("go_btn",i)
        # creates an observer only if it doesn't already exists
        if (is.null(obsList[[btName]])) {
          # make sure to use <<- to update global variable obsList
          obsList[[btName]] <<- observeEvent(input[[btName]], {
            cat("Button ", i, "\n")
            output$plot <-renderPlot({hist(rnorm(100, 4, 1),breaks = 50*i)})
          })
        }
        fluidRow(
          actionButton(btName,paste("Go",i))
        )
      }
    )
  })

}

Generate observers for dynamic number of inputs

In your example everything works fine so long an actionButton has been pressed only once. For instance, when I create 3 buttons/observers I get correct IDs printed in the console - there is one observer for each new generated actionButton. √

[1] "add_1"
[1] "add_2"
[1] "add_3"

However, when I choose the number other than 3 and then press submit again, the problem you described begins.

Say, I want now 4 actionButtons - I input 4 and press submit. After that, I press once each new generated button and I get a following output:

[1] "add_1"
[1] "add_1"
[1] "add_2"
[1] "add_2"
[1] "add_3"
[1] "add_3"
[1] "add_4"

By clicking on submit button, I created observers for three first buttons again - I have two observers for the first three buttons and only one for the new fourth button.

We can play this game on and on and going to get more and more observers for each button. It is very similar when we create a smaller number of buttons than previously.

---

The solution to this would be to keep track of which action buttons have been already defined and then to generate observers only for new ones. In the example below I depicted how you could do this. It may not be best programmed but it should serve well to show the idea.

Full example:

library("shiny")

ui <- fluidPage(
  numericInput("numButtons", "Number of buttons to generate",
                min = 1, max = 100, value = NULL),  
  actionButton("go", "Submit"), 
  uiOutput("ui")
)

server <- function(input, output) {

  # Keep track of which observer has been already created
  vals <- reactiveValues(x = NULL, y = NULL)

  makeObservers <- eventReactive(input$go, {

    IDs <- seq_len(input$numButtons)

    # For the first time you press the actionButton, create 
    # observers and save the sequence of integers which gives
    # you unique identifiers of created observers
    if (is.null(vals$x)) { 
      res <- lapply(IDs, function (x) {
        observeEvent(input[[paste0("add_", x)]], {
          print(paste0("add_", x))
        })
      })
      vals$x <- 1
      vals$y <- IDs
    print("else1")

    # When you press the actionButton for the second time you want to only create
    # observers that are not defined yet
    #

    # If all new IDs are are the same as the previous IDs return NULLL
    } else if (all(IDs %in% vals$y)) {
        print("else2: No new IDs/observers")
        return(NULL)

    # Otherwise just create observers that are not yet defined and overwrite 
    # reactive values 
    } else {
        new_ind <- !(IDs %in% vals$y)
        print(paste0("else3: # of new observers = ", length(IDs[new_ind])))
        res <- lapply(IDs[new_ind], function (x) {
          observeEvent(input[[paste0("add_", x)]], {
            print(paste0("add_", x))
          })
        })
        # update reactive values
        vals$y <- IDs
    }
    res
  })

  observeEvent(input$go, {

    output$ui <- renderUI({

      num <- as.numeric(isolate(input$numButtons))

      rows <- lapply(1:num, function (x) {

        actionButton(inputId = paste0("add_", x),
                     label = paste0("add_", x))

      })

      do.call(fluidRow, rows)

    })
    makeObservers()
  })

}
shinyApp(ui, server)

R Shiny - dynamically created actionButtons either all firing at once (observeEvent) or not firing at all (eventReactive)

This works with the code below.

• the drawCallback option runs Shiny.bindAll on the table; it tells Shiny that new inputs are added
• the use of local in the for loop is needed, otherwise the value of i would be the same across all instances in the loop (it would be the last i)

---

server <- function(input, output, session) {
  observeEvent(input$run, {
    iris_data <- iris[1:input$rows,]
    row.names(iris_data) <- paste0("<button id='details_", 1:nrow(iris_data),"' type='button' class='btn btn-default action-button'", ">Details</button>")
    output$iris <- renderDT({
      datatable(iris_data, selection="single", escape=FALSE, 
                options = list(
                  drawCallback = JS(
                    "function(){",
                    "  Shiny.bindAll(this.api().table().node());",
                    "}"
                  )
                )
      )
    })
    appendTab(inputId="navbar", tabPanel("Data", DTOutput("iris")))
  })

  observeEvent(input$rows, {
    for(j in 1:input$rows){
      local({
        i <- j
        observeEvent(input[[paste0("details_",i)]], {
          showModal(
            modalDialog(
              fluidPage(
                fluidRow(h3(strong("Details"), align="center")), hr(),
                fluidRow(splitLayout(strong("Sepal Length: "), iris[i,1])),
                fluidRow(splitLayout(strong("Sepal Width: "), iris[i,2])),
                fluidRow(splitLayout(strong("Petal Length: "), iris[i,3])),
                fluidRow(splitLayout(strong("Petal Width: "), iris[i,4])),
                fluidRow(splitLayout(strong("Species: "), iris[i,5])),
                size="l"))
          )
        })
      })
    }
  })

}

---

Here is an alternative way:

library(shiny)
library(shinyBS)
library(DT)

ui<-navbarPage(
  title="Title", id="navbar",
  tabPanel("Main",
           selectInput(inputId="rows", label="# of Rows", choices=c(5,10,25)),
           actionButton(inputId="run", "Run")),
  tabPanel("Data", 
           DTOutput("iris"),
           uiOutput("modals"))
)

server <- function(input, output, session) {
  output$iris <- renderDT({
    if(input$run > 0){
      iris_data <- iris[1:input$rows,]
      row.names(iris_data) <- sapply(1:input$rows, function(i){
        paste0("<button type='button' class='btn btn-default action-button'",
               " onclick = \"", sprintf("$('#modal%d').modal('show');\"", i),
               ">Details</button>")
      }) 
      datatable(iris_data, selection="single", escape=FALSE)
    }
  })

  output$modals <- renderUI({
    modals <- lapply(1:input$rows, function(i){
      bsModal(
        id = paste0("modal",i), 
        title = paste0("Details of row ", i),
        trigger = "",
        fluidPage(
          fluidRow(splitLayout(strong("Sepal Length: "), iris[i,1])),
          fluidRow(splitLayout(strong("Sepal Width: "), iris[i,2])),
          fluidRow(splitLayout(strong("Petal Length: "), iris[i,3])),
          fluidRow(splitLayout(strong("Petal Width: "), iris[i,4])),
          fluidRow(splitLayout(strong("Species: "), iris[i,5]))
        )
      )
    })
    do.call(tagList, modals)
  })

}

shinyApp(ui=ui, server=server)

How to listen for more than one actionbutton within a Shiny observeEvent to reload shiny

You can add req to the observeEvent:

library(shiny)
ui <- shinyUI(
    bootstrapPage(
        p('cbldwbvkdj'),
        uiOutput('aa')
    )
)

server <- shinyServer(function(input, output, session) {
    
    output$aa <- renderUI({
        tagList(
            actionButton("test1", "test1"),
            actionButton("test2", "test2")
        )
    })
    
    observeEvent(list(input$test1, input$test2),{
        req(input$test1!=0 | input$test2 !=0)
        session$reload()
    }, ignoreInit = TRUE,ignoreNULL = TRUE)
})

shinyApp(ui, server)

---

Related Topics