向 Shiny DT 添加按钮以拉起模态

Question

我正在尝试在我的数据表中添加一列按钮，单击这些按钮会弹出一个模式，但我无法使用我在网上找到的示例 and here。

我的一些要求：

需要处理数据集中未知行数（可能是 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

能够使用 this 来解决问题。

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

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

server = function(input, output) {

  shinyInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }

  iris_rows <- nrow(iris)

  iris$Timeline = shinyInput(actionButton, iris_rows, 'button_', label = "Timeline", onclick = 'Shiny.setInputValue(\"select_button\", this.id, {priority: \"event\"})' )


  ##DATA TABLE WHERE I NEED A BUTTON##

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

  ##MODAL CALLED BASED ON BUTTON CLICK

  observeEvent(input$select_button, {

    row <- as.numeric(strsplit(input$select_button, "_")[[1]][2])

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

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

  })

  output$test <- renderPrint({
    as.numeric(strsplit(input$select_button, "_")[[1]][2])
  })

}

shinyApp(ui, server)

使用多个数据表编写代码以显示与所选答案不同的答案。

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

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

server = function(input, output) {

  shinyInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }

  iris2 <- iris

  iris_rows <- nrow(iris)
  iris$Timeline = shinyInput(actionButton, iris_rows, 'button_x1_', label = "Timeline", onclick = 'Shiny.setInputValue(\"select_button1\", this.id, {priority: \"event\"})' )

  iris2_rows <- nrow(iris2)
  iris2$Timeline = shinyInput(actionButton, iris2_rows, 'button_x2_', label = "Timeline", onclick = 'Shiny.setInputValue(\"select_button2\", this.id, {priority: \"event\"})' )


  ##DATA TABLE WHERE I NEED A BUTTON##

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

  output$x2 = renderDT(
    iris2,
    selection = 'single',
    escape = FALSE,
    options = list(
    )
  )


  ##MODAL CALLED BASED ON BUTTON CLICK

  observeEvent(input$select_button1, {

    row <- as.numeric(strsplit(input$select_button1, "_")[[1]][3])

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

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

  })

  observeEvent(input$select_button2, {

    row <- as.numeric(strsplit(input$select_button2, "_")[[1]][3])

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

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

  })

  output$test <- renderPrint({
    as.numeric(strsplit(input$select_button1,"_")[[1]][3])
  })

}

shinyApp(ui, server)

Answer 2

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

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)

向 Shiny DT 添加按钮以拉起模态

Adding buttons to Shiny DT to pull up modal

r

shiny

dt