Generowanie obserwatorów dla dynamicznej liczby wejść

Question

Mam to, co myślę, że jest całkiem prostym przypadkiem użytkownika, dla którego nie byłem w stanie znaleźć rozwiązania: Chcę, aby Shiny generował określoną przez użytkownika liczbę wejść, dynamicznie tworząc obserwator dla każdego.

W poniższym minimalnym odtwarzalnym kodzie użytkownik wskazuje liczbę przycisków czynności, które chce się wprowadzić, wpisując do widżetu textInput; następnie naciska przycisk "submit", który generuje przyciski akcji.

Co chcę jest dla użytkownika, aby następnie móc kliknąć na dowolny przycisk akcji i generuje wyjście specyficzne dla niego (np minimalnej przypadku, po prostu wydrukować nazwę przycisk):

library("shiny") 

ui <- fluidPage(textInput("numButtons", "Number of buttons to generate"), 
       actionButton("go", "Submit"), uiOutput("ui")) 

server <- function(input, output) { 

     makeObservers <- reactive({ 

       lapply(1:(as.numeric(input$numButtons)), function (x) { 

         observeEvent(input[[paste0("add_", x)]], { 

           print(paste0("add_", x)) 

         }) 

       }) 
     }) 

     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) 

Problem z powyższym kodem polega na tym, że w jakiś sposób tworzonych jest kilku obserwatorów, ale wszystkie jako ostatni przyjmują tylko ostatni element z listy przekazany do lapply. Więc jeśli wygeneruję cztery przyciski akcji i kliknę przycisk akcji # 4, Shiny wypisuje swoją nazwę cztery razy, podczas gdy wszystkie pozostałe przyciski nie reagują.

Pomysł wygenerować obserwatorów stosując lapply pochodzi z https://github.com/rstudio/shiny/issues/167#issuecomment-152598096

Answer 1

W przykładzie wszystko działa dobrze tak długo actionButton został naciśnięty tylko raz. Na przykład, kiedy tworzę przyciski/obserwatory 3 otrzymuję poprawne identyfikatory wydrukowane w konsoli - jest jeden obserwator dla każdego nowego wygenerowanego actionButton. √

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

Jednak, kiedy wybrać numer inny niż 3 a następnie naciśnij submit kolejny problem, który opisano zaczyna.

Powiedz, chcę teraz 4 actionButtons - wprowadzam 4 i naciśnij submit. Po tym, pędzę po każdym nowym generowane przycisk i otrzymuję następujący wynik:

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

Klikając submit przycisku, stworzyłem obserwatorów dla trzech pierwszych przycisków ponownie - Mam dwóch obserwatorów w pierwszych trzech przycisków i tylko jeden dla nowego czwartego przycisku.

Możemy grać w tę grę wielokrotnie, aby uzyskać więcej obserwatorów dla każdego przycisku. Jest bardzo podobny, gdy tworzymy mniejszą liczbę przycisków niż poprzednio.

---

rozwiązanie do tego byłoby śledzić przyciski akcji, które zostały już zdefiniowane, a następnie wygenerować obserwatorów tylko dla nowych. W poniższym przykładzie przedstawiłem, w jaki sposób można to zrobić. Może nie być najlepiej zaprogramowany, ale powinien dobrze służyć do pokazania idei.

Pełny przykład:

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)