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

}