Generate Observers for Dynamic Number of Inputs

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)

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)

R Shiny dealing with a dynamic observers list

Try this

  #now I want to disable the ones falling in the third category
  #question1: how to iterate on them?
  #question2: how to trigger this?
  
  observe({
    print(input$chk1)
    n <- nrow(mtcarsx())
    lapply(1:n, function(i){if(mtcarsx()$mytype[i]=="DISABLED"){  shinyjs::disable(paste0("chk",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.

How to add warnings to UI outputs generated dynamically in Shiny

I think you have a couple of problems here.

First, you have forgotten to add useShinyFeedback() to your UI definition.

ui = shinyUI(
  fluidPage(
    useShinyFeedback(),
    titlePanel("Compare"),
    ...

Second, you've put the observeEvents that monitor your first item values inside your renderUI. That's not going to work: R's standard scoping means that these observeEvents won't be available to monitor changes in the corresponding input widgets. The solution is to create a separate observeEvent to create your observers on the inputs:

  observeEvent(input$numitems, {
    lapply(1:(input$numitems), function(i) {
      observeEvent(input[[paste0('firstitem',i)]], {
        shinyFeedback::feedbackWarning(
          inputId = paste0('firstitem',i),
          show = input[[paste0('firstitem',i)]] > 100,
          text = "Number less than 100 required.",
          color="red"
        )
      })
    })
  })

Making these changes gives me, for example,

With regard to your final question about the Submit actionButton, and as a general observation, I think your life will be much easier if you use Shiny modules to solve this problem. This will allow you to delegate the error checking to the indivudual modules and remove the need to continually loop through the indices of the dynamic inputs. This will lead to shorter, simpler, and more understandable code.

One thing to bear in mind if you do this: make sure you put a call to useShinyFeedback in the definition of the module UI.

Dynamically created selectInputs not recognized in server

I've included this as a separate answer to avoid confusing the code.

This is a working version using modules and dynamic ui. note the use of ns <- session$ns within the modules. Also be careful with reactive functions. I would normally name variables rfVariableName to remind me that it is a reactive function rather than just a normal variable.

library(shiny)

# selctor Module ---------------
selectorUI <- function(id) {

  ns <- NS(id)

  uiOutput(ns("selectorPane"))

}

selector <- function(input, output, session, selection) {

  output$selectorPane <- renderUI({

    ns <- session$ns

    tagList(
      lapply(1:length(selection), function(selIdx){
        selName <- names(selection)[selIdx]
        selChoices <- selection[[selName]]
        selectInput(inputId = ns(selName), label = selName, choices = selChoices, multiple = F)
      })
    )

  })

  allInputs <- reactive({
    l <- lapply(1:length(selection), function(getid) {
      selName <- names(selection)[getid]
      input[[selName]]
    })
    names(l) <- names(selection)
    l
  })

  return(allInputs)

}

# Viewer Module ---------------
viewerUI <- function(id) {
  ns <- NS(id)

  uiOutput(ns("viewerPane"))

}

viewer <- function(input, output, session, inputValues) {

  output$viewerPane <- renderUI({

    ns <- session$ns

    if (length(inputValues()) > 0) {
      if (!is.null(inputValues()[["count"]])) {
        if (inputValues()[["count"]] > 0) {
          tagList(
            lapply(1:inputValues()[["count"]], function(idx){
              textInput(ns(paste("text",idx, sep = "_")), label = "", value = inputValues()[["colors"]])
            })
          )
        }
      }
    }

  })

}

# Main UI --------------
ui <- shinyUI(fluidPage(
  titlePanel("Sample App"),
  sidebarLayout(
    sidebarPanel(
      selectorUI("selectorModl")
    ),
    mainPanel(
      viewerUI("viewerModl")
    )
  )))

# Server 
server <- function(input, output, session) {

  selection <- list("count" = c(1,2,3,4,5), "colors" = c("blue", "green","red"))

  inputValues <- callModule(selector,"selectorModl", selection = selection)

  observeEvent(inputValues(),{

    if (length(inputValues()) > 0) {
      callModule(viewer, "viewerModl", inputValues = inputValues)
    }

  })

}

shiny::shinyApp(ui, server)

R Shiny - Dynamically adding dependent inputs using insertUI

Below is a working code. The main problem was your ctn reactive value initialized to NULL, because NULL + 1 = numeric(0) and numeric(0) + 1 = numeric(0).

library(shiny)

ui <- fluidPage(
  actionButton('add', 'Add'),
  div(id = 'placeholder')
)

server <- function(input, output, session) {

  ctn <- reactiveVal(0)
  Id <- reactive({
    function(id){
      paste0(id, ctn())
    }
  })

  observeEvent(input$add, {

    ctn(ctn() + 1)

    insertUI(
      selector = '#placeholder',
      ui = div(
        id = Id()('div'),
        selectInput(Id()('letter'), 'Letter:', LETTERS[1:2]),
        uiOutput(Id()('input'))
      )
    )

  })

  observeEvent(ctn(), {
    id <- Id()('input')
    selection <- Id()('letter')
    output[[id]] <- renderUI({
      req(input[[Id()('letter')]])
      switch(
        input[[selection]],
        'A' = textInput(Id()('text'), 'ENTER TEXT', ''),
        'B' = numericInput(Id()('numeric'), 'ENTER NUMBER', '')
      )
    })
  }, ignoreInit = TRUE)

}

---

Related Topics