Format a vector of rows in italic and red font in R DT (datatable)

Question

A bit similar to this question: How to give color to a given interval of rows of a DT table?

but in my case I would like to let the user select rows in the table, th

Answer 1

Here is a variant. Instead of using a button to mark the selected rows as removed, the user clicks on the icons.

library(shiny)
library(DT)

callback <- c(
  "table.on('click', 'td:nth-child(2)', function(){",
  "  var td = this;",
  "  var cell = table.cell(td);",
  "  if(cell.data() === 'ok'){",
  "    cell.data('remove');",
  "  } else {",
  "    cell.data('ok');",
  "  }",
  "  var $row = $(td).closest('tr');",
  "  $row.toggleClass('excluded');",
  "  var excludedRows = [];",
  "  table.$('tr').each(function(i, row){",
  "    if($(this).hasClass('excluded')){",
  "      excludedRows.push(parseInt($(row).attr('id')));",
  "    }",
  "  });",
  "  Shiny.setInputValue('excludedRows', excludedRows);",
  "})"
)

restore <- c(
  "function(e, table, node, config) {",
  "  table.$('tr').removeClass('excluded').each(function(){",
  "    var td = $(this).find('td').eq(1)[0];", 
  "    var cell = table.cell(td);", 
  "    cell.data('ok');",
  "  });",
  "  Shiny.setInputValue('excludedRows', null);",
  "}"
)

render <- c(
  'function(data, type, row, meta){',
  '  if(type === "display"){',
  '    return "";',
  '  } else {',
  '    return data;',
  '  }',
  '}'
)

ui <- fluidPage(
  tags$head(
    tags$style(HTML(
      ".excluded { color: rgb(211,211,211); font-style: italic; }"
    ))
  ),
  fluidRow(
    column(
      6, 
      tags$label("Excluded rows"),
      verbatimTextOutput("excludedRows")
    ),
    column(
      6, 
      tags$label("Included rows"),
      verbatimTextOutput("includedRows")
    )
  ),
  br(),
  DTOutput('mytable')
)

server <- function(input, output,session) {

  dat <- cbind(Selected = "ok", mtcars[1:6,], id = 1:6)

  output[["mytable"]] <- renderDT({
    datatable(dat, 
              extensions = c("Select", "Buttons"), 
              selection = "none", 
              callback = JS(callback),
              options = list(
                rowId = JS(sprintf("function(data){return data[%d];}", ncol(dat))), 
                columnDefs = list(
                  list(visible = FALSE, targets = ncol(dat)),
                  list(className = "dt-center", targets = "_all"),
                  list(className = "notselectable", targets = 1),
                  list(targets = 1, render = JS(render)) 
                ),
                dom = "Bt",
                buttons = list("copy", "csv",
                               list(
                                 extend = "collection",
                                 text = 'Select all rows', 
                                 action = JS(restore)
                               )
                ),
                select = list(style = "single", selector = "td:not(.notselectable)")
              )
    )
  }, server = FALSE)

    output$excludedRows <- renderPrint({
      input[["excludedRows"]]
    })

    output$includedRows <- renderPrint({
      setdiff(1:nrow(dat), input[["excludedRows"]])
    })

}

shinyApp(ui, server)