閃亮 - 可以動態生成的按鈕作爲事件的觸發器

Question

我有一個閃亮的代碼，可以從numericInput生成動作按鈕，每個這些動作按鈕在使用observeEvent單擊時會生成一個圖。問題是我不知道如何用動態生成的按鈕觸發事件。我使用的解決方法是爲每個按鈕創建一個observeEvent，但如果我生成的按鈕超過了我創建的observer，它將無法工作。

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


    output$go_buttons <- renderUI({ 
    buttons <- as.list(1:input$go_btns_quant) 
    buttons <- lapply(buttons, function(i) 
     fluidRow(
     actionButton(paste0("go_btn",i),paste("Go",i)) 
    ) 
    ) 
    }) 

    #Can this observeEvents be triggerd dynamicly? 
    observeEvent(input[[paste0("go_btn",1)]],{output$plot <-renderPlot({hist(rnorm(100,4,1),breaks = 10)})}) 
    observeEvent(input[[paste0("go_btn",2)]],{output$plot <- renderPlot({hist(rnorm(100,4,1),breaks = 50)})}) 
    observeEvent(input[[paste0("go_btn",3)]],{output$plot <- renderPlot({hist(rnorm(100,4,1),breaks = 100)})}) 
    observeEvent(input[[paste0("go_btn",4)]],{output$plot <- renderPlot({hist(rnorm(100,4,1),breaks = 200)})}) 
    observeEvent(input[[paste0("go_btn",5)]],{output$plot <- renderPlot({hist(rnorm(100,4,1),breaks = 500)})}) 

} 

shinyApp(ui, server) 

Answer 1

您也可以動態創建觀察者。只要確保它們只創建一次，否則它會執行多次。

下面是您的代碼修改爲創建儘可能多的觀察員作爲按鈕。請注意，如果該按鈕的觀察者已經存在，則不應創建該按鈕。你也可以自定義你的觀察者，所以每個觀察者都可以有自己的行爲。

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

}