首页 文章

闪亮 - 动态生成的按钮可以充当事件的触发器

提问于
浏览
4

我有一个闪亮的代码,它从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)

1 回答

  • 2

    您也可以动态创建观察者 . 只需确保它们只创建一次,否则它将执行几次 .

    下面是您修改的代码,以创建与按钮一样多的观察者 . 请注意,如果按钮的观察者已存在,则不应创建该按钮 . 您也可以自定义观察者,因此每个观察者都可以拥有自己的行为 .

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

相关问题