向Shiny DT添加按钮以拉出模态框

Question

我正在尝试在数据表中添加一列按钮，单击这些按钮将弹出一个模式，但我在使用我在此处和此处在网上找到的示例时遇到了问题。

我的一些要求：

• 需要处理数据集中未知数量的行（可能是 5、可能是 10、可能是 500）
• 每个按钮都需要是唯一的 id，我可以用它来引用行（在示例中，您可以看到我将行号拉入模态 - 现实生活中，我使用行号来子集我的数据，并实际将信息放入模态）

代码：

library(shiny)
library(shinydashboard)
library(DT)

ui = dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    DTOutput('x1'),
    verbatimTextOutput("test")
    )
    )

server = function(input, output) {

  ##DATA TABLE WHERE I NEED A BUTTON##

  output$x1 = renderDT(
    iris,
    selection = 'single',
    options = list(
    )
  )

  ##MODAL CALLED BASED ON BUTTON CLICK

  observeEvent(input$x1_cell_clicked, {

    row = input$x1_cell_clicked$row

    if (is.null(row) || row == '') {} else{

      showModal(modalDialog(
        title = paste0("Timeline!",row),
        size = "s",
        easyClose = TRUE,
        footer = NULL
      ))
    }

  })

  output$test <- renderPrint({
    input$x1_cell_clicked$row
  })

}

shinyApp(ui, server)

Answer 1

在您的评论中，您询问了多个数据表的情况。是你想要的吗？

library(shiny)
library(DT)

button <- function(tbl){
  function(i){
    sprintf(
      '<button id="button_%s_%d" type="button" onclick="%s">Click me</button>', 
      tbl, i, "Shiny.setInputValue('button', this.id);")
  }
}

dat1 <- cbind(iris, 
              button = sapply(1:nrow(iris), button("tbl1")), 
              stringsAsFactors = FALSE)
dat2 <- cbind(mtcars, 
              button = sapply(1:nrow(mtcars), button("tbl2")), 
              stringsAsFactors = FALSE)

ui <- fluidPage(
  fluidRow(
    column(
      width = 6,
      DTOutput("tbl1", height = "500px")
    ),
    column(
      width = 6,
      DTOutput("tbl2", height = "500px")
    )
  )

)

server <- function(input, output){

  output[["tbl1"]] <- renderDT({
    datatable(dat1, escape = ncol(dat1)-1, fillContainer = TRUE)
  })

  output[["tbl2"]] <- renderDT({
    datatable(dat2, escape = ncol(dat2)-1, fillContainer = TRUE)
  })

  observeEvent(input[["button"]], {
    splitID <- strsplit(input[["button"]], "_")[[1]]
    tbl <- splitID[2]
    row <- splitID[3]
    showModal(modalDialog(
      title = paste0("Row ", row, " of table ", tbl, " clicked"),
      size = "s",
      easyClose = TRUE,
      footer = NULL
    ))
  })
}

shinyApp(ui, server)