Shiny - Can Dynamically Generated Buttons Act as Trigger for an Event

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))
        )
      }
    )
  })

}

Shiny - observe() triggered by dynamicaly generated inputs

I'm not an expert in Shiny, but It seems that it's not possible to trigger one observer with dynamically generated inputs. My workaround is based on this answer: R shiny - last clicked button id.

The idea is to keep track of the last selection on all the dynamicallygenerated selectInput's using a JavaScript function. That function will update a shiny input variable with the id of the last selectedInput used.

Below is you code modified with the solution. Please note that because we need to distinguish between the dynamically generated selectInput's and others selectInput's, I wrapped those selectInput's in a div with a dummy class. The JavaScript function will only react to those that are inside that div. Also, the functions will generate a random number inside the JavaScript function to make the observer react to changes in the same selectInput.

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic selectInput"),
  dashboardSidebar(
    sidebarMenu(
      menuItemOutput("menuitem")
    )
  ),
  dashboardBody(
    # keep track of the last selection on all selectInput created dynamically
    tags$script("$(document).on('change', '.dynamicSI select', function () {
                              Shiny.onInputChange('lastSelectId',this.id);
                              // to report changes on the same selectInput
                              Shiny.onInputChange('lastSelect', Math.random());
                             });"),            
    numericInput("graph_tytle_num","Number of Graph Title elements",value = 1,min = 1,max = 10),
    uiOutput("graph_title"),
    plotOutput("plot")
  )
)

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

  #elements of graphic titles  
  output$graph_title <- renderUI({
    buttons <- as.list(1:input$graph_tytle_num)
    # use a div with class = "dynamicSI" to distinguish from other selectInput's
    div( class = "dynamicSI",
      lapply(buttons, function(i)
        column(3,
          selectInput(inputId = paste0("title_element",i),
                      label = paste("Title element",i),
                      choices = paste0(LETTERS[i],seq(1,i*2)),
                      selected = 1)
        )
      )
    )
  })

  # react to changes in dynamically generated selectInput's
  observe({
    input$lastSelect

    if (!is.null(input$lastSelectId)) {
      cat("lastSelectId:", input$lastSelectId, "\n")
      cat("Selection:", input[[input$lastSelectId]], "\n\n")
    }

    isolate({ #I dont want to have the numericInput input$graph_tytle_num to be a trigger
      #Create the graph title
      title <- c()
      for(i in 1:input[["graph_tytle_num"]]){
        title <- paste(title,input[[paste0("title_element",i)]])
      }

      output$plot <-renderPlot({hist(rnorm(100,4,1),
                                     breaks = 10,
                                     main = title)})
    })

  })  

}

shinyApp(ui, server)

Finally, you can extend this approach to any other Shiny widget just by modifying the selector on the JavaScript function. For instance, if you want to have actionButton's you can change the event and the selector from change and select to click and button.

R/Shiny: can changing a value of a reactive trigger an event?

At the request of @starja and @Eric...

A reactive is simply a function

> shiny::reactive
function (x, env = parent.frame(), quoted = FALSE, ..., label = NULL, 
    domain = getDefaultReactiveDomain(), ..stacktraceon = TRUE) 
{
    check_dots_empty()
    x <- get_quosure(x, env, quoted)
    fun <- as_function(x)
    formals(fun) <- list()
    label <- exprToLabel(get_expr(x), "reactive", label)
    o <- Observable$new(fun, label, domain, ..stacktraceon = ..stacktraceon)
    structure(o$getValue, observable = o, cacheHint = list(userExpr = zap_srcref(get_expr(x))), 
        class = c("reactiveExpr", "reactive", "function"))
}
<bytecode: 0x7fdbfa6cb8d8>
<environment: namespace:shiny>

(as are observeEvent and the like). If you want observeEvent (or similar) to react to a change, you need to pass it something that changes. myReactive is simply the function itself, which does not change. myReactive() is the current value of the function, which does. So

observeEvent(myReactive(), { ... })

works, but

observeEvent(myReactive, { ... })

does not.

The only time (that I can think of) where you would use the reactive rather than its value is when passing additional parameters to a module server function: you pass the reactive (myReactive) as a parameter and call it (myReactive()) in the body of the server.

Or operator in observe event

Yes, observeEvent has other arguments such as ignoreInit, just set it to TRUE

library(shiny)

ui <- fluidPage(
  actionButton("act1", "Action1"),
  actionButton("act2", "Action2"),
  htmlOutput("gh")
)

server <- function(input, output, session) {
  
  
  observeEvent((input$act1 | input$act2),{
    output$gh <- renderUI({
      "Clicked"
    })
  },ignoreInit = TRUE)
  
}

shinyApp(ui, server)

How to identify which observer is being triggered in Shiny when multiple dynamic observers are in use

Geovany's comment helped. I was also helped by this link.
The trick was to associate just one observer with each Submit button.

Here is the code that works, in case it is useful for anyone

library(shiny)
library(purrr)
options(shiny.reactlog = TRUE)
ui <- fluidPage(
  actionButton("generate_tab", "Generate Tabs"),
  tabsetPanel(id = "tabs",
              uiOutput('tabsN')),
  verbatimTextOutput("rvInput")

)

server <- function(input, output, session) {
  # browser()
  rv <- reactiveValues(no_of_tabs = 0L,
                       inputs = list()
                       )

  #generating the UI dynamically
  observeEvent(input$generate_tab, {
    rv$no_of_tabs <- rv$no_of_tabs + 1
    appendTab(inputId = "tabs",
              tabPanel(
                title = paste0("Tab_", rv$no_of_tabs),
                selectInput(
                  paste0("Input", rv$no_of_tabs),
                  paste0("Input", rv$no_of_tabs),
                  choices = c('', LETTERS),
                  selected = NULL
                ),
                actionButton(paste0("submit_input", rv$no_of_tabs), "submit input")
              ))
  })

  observe({
    lapply(1:rv$no_of_tabs, function(x) {
      observeEvent(input[[paste0("submit_input", x)]], {
        rv$inputs[[x]] <- input[[paste0("Input", x)]]
      })
    })
  })

  output$rvInput <- renderPrint({
    rv$inputs
  })

}

shinyApp(ui, server)

---

Related Topics