R Shiny - 动态创建的actionButtons一次全部触发（observeEvent）或者根本不触发（eventReactive）

Question

我正在构建一个Shiny应用程序，并根据这篇文章对其中的一部分进行建模：[https://antoineguillot.wordpress.com/2017/03/01/three-r-shiny-tricks-to-make-your-shiny-app-shines-33-buttons-to-delete-edit-and-compare-datatable-rows/] ...

我在数据表的行名称中动态创建actionButtons（在用户输入后创建，并在单击“运行”后输出到新选项卡）。单击这些actionButtons时，我希望弹出一个模式以提供该行的更多详细信息。我能够根据上面文章中的代码创建按钮，但是我无法正常启动它们...

我开始为每个按钮创建一个observeEvent。但是，它们都在创建表时触发（而不是等待单击按钮），之后只有最后一行的模态处于活动状态。然后在解雇该模态后没有按钮工作。当我尝试使用eventReactive而不是observeEvent时，它们根本不会被触发，即使被点击也是如此。

这是我正在尝试的简单版本：

ui<-navbarPage(title="Title", theme=shinytheme("cosmo"), id="navbar",
           tabPanel("Main",
                    selectInput(inputId="rows", label="# of Rows", choices=c(5,10,25)),
                    actionButton(inputId="run", "Run"))
           )

server<-function(input, output, session) {
  observeEvent(input$run, {
    iris_data<-iris[1:input$rows,]
    row.names(iris_data)<-paste0("<button id='details_", 1:nrow(iris_data),"' type='button' class='btn btn-default action-button shiny-bound-input'", ">Details</button>")
    output$iris<-renderDT({
      datatable(iris_data, selection="single", escape=FALSE,
      )
    })
    for (i in 1:nrow(iris_data)) {
      eventReactive(paste0("input$details_",i), {
        showModal(
          modalDialog(
            fluidPage(
              fluidRow(h3(strong("Details"), align="center")), hr(),
              fluidRow(splitLayout(strong("Sepal Length: "), iris_data[i,1])),
              fluidRow(splitLayout(strong("Sepal Width: "), iris_data[i,2])),
              fluidRow(splitLayout(strong("Petal Length: "), iris_data[i,3])),
              fluidRow(splitLayout(strong("Petal Width: "), iris_data[i,4])),
              fluidRow(splitLayout(strong("Species: "), iris_data[i,5])),
          size="l"))
        )}
      )}
    appendTab(inputId="navbar", tabPanel("Data", dataTableOutput("iris")))
  })
}

shinyApp(ui=ui, server=server)

我可以在上面的代码中更改什么来确保这些按钮在单击时（并且仅当它们被点击时）触发？谢谢！

Answer 1

这适用于下面的代码。

• drawCallback选项在桌面上运行Shiny.bindAll;它告诉Shiny添加了新的输入
• 需要在for循环中使用local，否则i的值在循环中的所有实例中都是相同的（它将是最后一个i）

---

server <- function(input, output, session) {
  observeEvent(input$run, {
    iris_data <- iris[1:input$rows,]
    row.names(iris_data) <- paste0("<button id='details_", 1:nrow(iris_data),"' type='button' class='btn btn-default action-button'", ">Details</button>")
    output$iris <- renderDT({
      datatable(iris_data, selection="single", escape=FALSE, 
                options = list(
                  drawCallback = JS(
                    "function(){",
                    "  Shiny.bindAll(this.api().table().node());",
                    "}"
                  )
                )
      )
    })
    appendTab(inputId="navbar", tabPanel("Data", DTOutput("iris")))
  })

  observeEvent(input$rows, {
    for(j in 1:input$rows){
      local({
        i <- j
        observeEvent(input[[paste0("details_",i)]], {
          showModal(
            modalDialog(
              fluidPage(
                fluidRow(h3(strong("Details"), align="center")), hr(),
                fluidRow(splitLayout(strong("Sepal Length: "), iris[i,1])),
                fluidRow(splitLayout(strong("Sepal Width: "), iris[i,2])),
                fluidRow(splitLayout(strong("Petal Length: "), iris[i,3])),
                fluidRow(splitLayout(strong("Petal Width: "), iris[i,4])),
                fluidRow(splitLayout(strong("Species: "), iris[i,5])),
                size="l"))
          )
        })
      })
    }
  })

}

---

这是另一种方式：

library(shiny)
library(shinyBS)
library(DT)

ui<-navbarPage(
  title="Title", id="navbar",
  tabPanel("Main",
           selectInput(inputId="rows", label="# of Rows", choices=c(5,10,25)),
           actionButton(inputId="run", "Run")),
  tabPanel("Data", 
           DTOutput("iris"),
           uiOutput("modals"))
)

server <- function(input, output, session) {
  output$iris <- renderDT({
    if(input$run > 0){
      iris_data <- iris[1:input$rows,]
      row.names(iris_data) <- sapply(1:input$rows, function(i){
        paste0("<button type='button' class='btn btn-default action-button'",
               " onclick = \"", sprintf("$('#modal%d').modal('show');\"", i),
               ">Details</button>")
      }) 
      datatable(iris_data, selection="single", escape=FALSE)
    }
  })

  output$modals <- renderUI({
    modals <- lapply(1:input$rows, function(i){
      bsModal(
        id = paste0("modal",i), 
        title = paste0("Details of row ", i),
        trigger = "",
        fluidPage(
          fluidRow(splitLayout(strong("Sepal Length: "), iris[i,1])),
          fluidRow(splitLayout(strong("Sepal Width: "), iris[i,2])),
          fluidRow(splitLayout(strong("Petal Length: "), iris[i,3])),
          fluidRow(splitLayout(strong("Petal Width: "), iris[i,4])),
          fluidRow(splitLayout(strong("Species: "), iris[i,5]))
        )
      )
    })
    do.call(tagList, modals)
  })

}

shinyApp(ui=ui, server=server)