如何添加一列用于删除行的单选按钮？

Question

在此示例中，我使用

datatable

删除

checkboxGroupInput

的行，但我更喜欢在表格本身中有一列单选按钮来选择要删除的行。我尝试阅读其他人发布的文档和示例，但我无法解读其中的任何内容。我该如何解决这个问题？

library(shiny)
library(DT)

mtcars[["cars"]] <- row.names(mtcars)
example_mtcars <- head(mtcars, n = 5)
ui <- fluidPage(
  checkboxGroupInput("mtcars_update", "Select Cars to Remove", choices = example_mtcars$cars),
  shiny::dataTableOutput("mtcars_dt")
)

server <- function(input, output, session) {
  output$mtcars_dt <- shiny::renderDataTable({
    if (length(input$mtcars_update) == 0) {
      example_mtcars
    } else {
      example_mtcars |>
        dplyr::filter(cars != input$mtcars_update)
    }
  })
}

shinyApp(ui, server)

^{创建于 2024-03-16，使用 reprex v2.1.0}

Answer 1

library(shiny)
library(DT)

mtcars[["cars"]] <- row.names(mtcars)
example_mtcars <- head(mtcars, n = 5) |>
    dplyr::mutate(Remove = sprintf(
        paste0('<input type="radio" id = "radioB', dplyr::row_number(), '"/>')
    ),
    .before = mpg)

js <- c(
    "table.rows().every(function(i, tab, row) {",
    "    var $this = $(this.node());",
    "    $this.attr('id', this.data()[0]);",
    "    $this.addClass('shiny-input-radiogroup');",
    "});",
    "Shiny.unbindAll(table.table().node());",
    "Shiny.bindAll(table.table().node());",
    "$('[id^=radioB]').on('click', function(){",
    "  Shiny.setInputValue('dtable_radioButtonClicked:DT.cellInfo', null);",
    "  var i = $(this).closest('tr').index() + 1;",
    "  var info = [{row: i}];",
    "  Shiny.setInputValue('dtable_radioButtonClicked:DT.cellInfo', info);",
    "})"
)

ui <- fluidPage(
    DT::dataTableOutput("mtcars_dt")
)

server <- function(input, output, session) {
    my_mtcars <- reactiveValues(df = example_mtcars)
    
    output$mtcars_dt <- DT::renderDataTable(
        my_mtcars$df,
        callback = JS(js),
        selection = 'none',
        escape = FALSE,
        server = FALSE
    )
    
    observeEvent(input[["dtable_radioButtonClicked"]], {
        rowToDelete <- input[["dtable_radioButtonClicked"]]$row
        my_mtcars$df <- my_mtcars$df[-rowToDelete]
    }, ignoreNULL = TRUE)
}

shinyApp(ui, server)