Shiny - 動的に生成されたボタンがイベントのトリガーとして機能することができます

Question

numericInputからアクションボタンを生成する光沢のあるコードがあり、observeEventを使用してクリックするとプロットが生成されます。問題は、動的に生成されたボタンでイベントをトリガする方法がわからないことです。私が使用した回避策は、各ボタンのobserveEventを作成することでしたが、私が作成したobserEventsより多くのボタンを生成すると、動作しません。

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

}