2016-08-15 48 views
6

我有我認爲是一個非常簡單的用戶案例,我一直無法找到解決方案:我希望Shiny生成用戶指定數量的輸入,動態創建每個觀察員。生成動態輸入數量的觀察者

在下面的最小可重現代碼中,用戶通過鍵入textInput小部件來指示所需的動作按鈕數量;他或她然後按下「提交」,這會產生動作按鈕。

我要的是爲用戶則可以點擊任何動作按鈕並生成特定的輸出到它(例如用於最小的情況下,只打印按鈕的名稱):

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) 

上面的代碼的問題是,不知何故創建了幾個觀察者,但它們都只將其傳遞給lapply的列表中的最後一項作爲它們的輸入。因此,如果我生成四個動作按鈕,並且點擊動作按鈕#4,則Shiny會打印其名稱四次,而其他所有按鈕都不會作出反應。

的想法使用lapply來自https://github.com/rstudio/shiny/issues/167#issuecomment-152598096

+0

這只是一張紙條,只有列表中的過去「lapply」的最後一個項目產生觀察員的問題是閃亮之間的兼容性和R版本我已經安裝了。使用最新版本的R,我的示例代碼的行爲就像下面的答案所表明的那樣,並且提供的解決方案可以工作。 –

回答

4

在你的榜樣一切產生觀察家正常工作這麼長時間的actionButton已被按下一次。例如,當我創建3按鈕/觀察者時,我會在控制檯中獲得正確的ID - 每個新生成的actionButton都有一個觀察者。 √

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

然而,當我選擇比3其他數,然後再按submit,您所描述的問題開​​始。

說,我想現在4 actionButtons - 我輸入4並按submit。在那之後,我按一次每一個新產生的按鈕,我得到了以下的輸出:

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

通過點擊submit按鈕,我創建了觀察員的三個第一按鈕再次 - 我有兩個觀察員前三個按鈕,只一個用於新的第四個按鈕。

我們可以一直玩這個遊戲,並將獲得更多的每個按鈕的觀察員。當我們創建比以前更少數量的按鈕時,它非常相似。


解決這將是保持這動作按鈕已經被定義的歌曲,然後只產生了新的觀察員。在下面的例子中,我描述了你如何做到這一點。它可能不是最好的編程,但它應該很好地展示這個想法。

完整的示例:

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)