Shiny中有一个事件处理程序的多个操作按钮？

Question

我想在一个页面上拥有可变数量的相同 actionButton()，全部由一个 observeEvent() 函数处理。

例如，在一个可变长度的表格表格中，我希望每个内部表格都有一个按钮，可以链接到该表格的更多信息。

在标准 HTML 中，您可以使用简单的表单来执行此操作，其中使用隐藏的输入来指定内部表格编号，如下所示：

<form ...>
  <input id="table_number" type="hidden" value="1"/>
  <input type="submit" value="Examine"/>
</form>

当一个按钮被按下时，您可以检查隐藏的输入以查看它是哪一个。

有没有办法在 Shiny 中做到这一点？我想出的唯一解决方案是给每个 actionButton() 它自己的 inputId。这需要每个按钮都有一个单独的 observeEvent()。这些必须提前创建，并强制设置最大数量的按钮。

Answer 1

我只花了几年时间，但我现在对这个问题有了更好的答案。您可以使用 JavaScript/jQuery 函数在文档中的每个按钮上放置一个单击事件处理程序，然后使用 Shiny.onInputChange() 函数传递按钮的 ID (<button id="xxx"... ) 已在您的 Shiny 代码中单击到单个观察者。

在One observer for all buttons in Shiny using JavaScript/jQuery上有完整的代码示例说明

Answer 2

关于使用 Shiny 模块来回答我原来的问题...

我想要的是一种在页面上有多个按钮的方法，可以由单个 observeEvent() 处理，这对于传统的 HTML 表单很容易做到，如原始问题所示。

GyD 使用 Shiny 模块的演示代码几乎解决了这个问题，但它实际上并没有将按下哪个按钮返回给主服务器。我花了很长时间，但我终于想出了如何编写一个让主服务器知道按下了哪个按钮的模块：

actionInput <- function(id) {
   ns <- NS(id)
   tagList(
      textInput(ns("text"), label=NULL, value=id),
      actionButton(ns("button"), "OK")
   )
}

action <- function(input, output, session) {
   eventReactive(input$button, {
      return(input$text)
   })
}

ui <- fluidPage(fluidRow(column(4, actionInput("b1")),
                         column(4, actionInput("b2")),
                         column(4, uiOutput("result"))))

server <-function(input, output, session) {
   b1 <- callModule(action, "b1")
   observeEvent(b1(), {
      output$result = renderText(b1())
   })
   b2 <- callModule(action, "b2")
   observeEvent(b2(), {
      output$result = renderText(b2())
   })
}

shinyApp(ui = ui, server = server)

（在实际应用程序中，我会让textInputs 不可见，因为它们只是为了提供按下按钮的 id。）

此解决方案仍需要在主服务器中为每个按钮提供一个observeEvent()。也许可以通过其他方式使用模块来解决问题，但我一直无法弄清楚。

我最初的替代方案是在主服务器中为每个按钮使用单独的observeEvent()，实际上比扩展此演示代码为一百个或更多按钮要简单得多。

Answer 3

您可以为此使用闪亮的模块：您可以拥有可变数量的actionButton，它们是相同的。这些在ab_moduleUI 部分中定义。它们由它们自己的observeEvent 处理，但它只能在ab_module 部分中定义一次。

使用lapply 可以创建任意数量的actionButton。

编辑：您不必事先指定按钮的数量：使用renderUI 在服务器端生成 UI 元素。

出于演示目的，我添加了numericInput 来增加/减少要渲染的模块数量。

# UI part of the module
ab_moduleUI <- function(id){
  ns <- NS(id)
  tagList(
    fluidRow(
      actionButton(ns("btn"), paste("ActionButton", id, sep="-")),
      textOutput(ns("txt"))
    )
  )
}

# Server part of the module
ab_module <- function(input, output, session){
  observeEvent(input$btn,{
    output$txt <- renderText("More information shown")
  })
}


# UI
ui <- fluidPage(
  # lapply(paste0("mod", 1:no_btn), ab_moduleUI)
  numericInput("num", "Number of buttons to show" ,value = 5, min = 3, max = 10),
  uiOutput("ui")
)

# Server side
server <- function(input, output, session){
  observeEvent(input$num, {
    output$ui <- renderUI({
      lapply(paste0("mod", 1:input$num), ab_moduleUI)
    })

    lapply(paste0("mod", 1:input$num), function(x) callModule(ab_module, x))
  })

}

shinyApp(ui, server)

阅读更多关于闪亮模块here