Search code examples
rshinyradio-buttondt

How to add a column of radio buttons for deleting rows?

In this example, I'm removing rows of the datatable using checkboxGroupInput, but I'd prefer to have a column of radio buttons in the table itself to select which rows to remove. I've tried reading the documentation and examples that others have posted, but I can't decipher any of it. How can I solve this?

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)

Created on 2024-03-16 with reprex v2.1.0

Solution

  • enter image description here

    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)