Move javascript functionality of buttons to embedd

Question

Related to a previous question, I am stuck on how to get javascript functionality running on embedded buttons in a datatable. I suspect it has to do with initiation of the javascript versus the rendering of the buttons, but so far I failed to figure out how to get the functionality work with the embedded buttons..

In the app below I gave the embedded buttons a different name, but in testing it without the regular actionbuttons in the app, and giving the embedded ones the same name, the javascript does not react it seems

previous question

library(shiny)
library(DT)

initComplete <- c(
  "function(settings) {",
  "  var table = settings.oInstance.api();", 
  "  var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'",
  "  var checkmark = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-ok\"></i></span>'",
  "  $('#SubmitRemoval').on('click', function(){",
  "    table.$('tr.selected').addClass('x');",
  "    table.$('tr.selected')",
  "      .each(function(){$(this).find('td').eq(1).html(cross);});",
  "    var excludedRows = [];",
  "    table.$('tr').each(function(i, row){",
  "      if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}",
  "    });",
  "    Shiny.setInputValue('excludedRows', excludedRows);",
  "  });",
  "  $('#UndoRemoval').on('click', function(){",
  "    table.$('tr').removeClass('x');",
  "    table.$('tr')",
  "      .each(function(i){$(this).find('td').eq(1).html(checkmark);});",
  "    Shiny.setInputValue('excludedRows', null);",
  "  });",
  "}"
)

callback <- "
var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'
var xrows = [];
table.on('preDraw', function(e, settings) {
  var tbl = settings.oInstance.api();
  var nrows = tbl.rows().count();
  var rows = tbl.$('tr');
  var some = false; var r = 0;
  while(!some && r<nrows){
    if($(rows[r]).hasClass('x')){
      some = true
    }
    r++;
  }
  if(some){
    xrows = [];
    for(var i = 0; i < nrows; i++){
      if($(rows[i]).hasClass('x')){
        xrows.push(rows[i].getAttribute('id'));
      }
    }
  }
}).on('draw.dt', function(){
  for(var i=0; i<xrows.length; i++){
    var row = $('#' + xrows[i]);
    row.addClass('x').find('td').eq(1).html(cross);
  }
  xrows = [];
});
"

ui <- fluidPage(
  tags$head(
    tags$style(HTML(
      ".x { background-color: rgb(211,211,211) !important; font-style: italic}
       table.dataTable tr.selected.x td { background-color: rgb(211,211,211) !important;}"
    ))
  ),
  actionButton('SubmitRemoval', 'Exclude selected rows'),
  actionButton('UndoRemoval', 'Include full data'),
  br(),
  DTOutput('mytable')

)

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

  dat <- cbind(Selected = '<span style="color:red; font-size:18px"><i class="glyphicon glyphicon-ok"></i></span>', 
               mtcars[1:6,], id = 1:6)

  output[["mytable"]] <- renderDT({
    datatable(dat, 
              escape = -2, 
              callback = JS(callback),
              extensions = c('Buttons', 'Scroller'),

              options = list(
                initComplete = JS(initComplete),
                rowId = JS(sprintf("function(data){return data[%d];}", ncol(dat))), 
                columnDefs = list(
                  list(visible = FALSE, targets = ncol(dat)),
                  list(className = "dt-center", targets = "_all")
                ), 
                dom = 'frtipB',

                buttons = list('copy', 'csv',
                               list(
                                 extend = "collection",
                                 text = 'Deselect', 
                                 action = DT::JS("function ( e, dt, node, config ) {
                                       Shiny.setInputValue('SubmitRemovalEmb', true, {priority: 'event'});
                                     }")
                               ),
                               list(
                                 extend = "collection",
                                 text = 'Restore', 
                                 action = DT::JS("function ( e, dt, node, config ) {
                                       Shiny.setInputValue('UndoRemovalEmb', true, {priority: 'event'});
                                     }")
                               )
                )

              )
    )
  })

  proxy <- dataTableProxy("mytable")

  observeEvent(input[["UndoRemoval"]], { 
    proxy %>% selectRows(NULL)
  })

}

shinyApp(ui, server)

UPDATE2 working answer with modifications and corrections included. looking at last finishing touches based on last comment

library(shiny)
library(DT)


callback <- "
var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'
var xrows = [];
table.on('preDraw', function(e, settings) {
  var tbl = settings.oInstance.api();
  var nrows = tbl.rows().count();
  var rows = tbl.$('tr');
  var some = false; var r = 0;
  while(!some && r<nrows){
    if($(rows[r]).hasClass('x')){
      some = true
    }
    r++;
  }
  if(some){
    xrows = [];
    for(var i = 0; i < nrows; i++){
      if($(rows[i]).hasClass('x')){
        xrows.push(rows[i].getAttribute('id'));
      }
    }
  }
}).on('draw.dt', function(){
  for(var i=0; i<xrows.length; i++){
    var row = $('#' + xrows[i]);
    row.addClass('x').find('td').eq(1).html(cross);
  }
  xrows = [];
});
"

ui <- fluidPage(
  tags$head(
    tags$style(HTML(
      ".x { font-style: italic}"
    ))
  ),

  br(),
  DTOutput('mytable')

)

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

  dat <- cbind(Selected = '<span style="color:red; font-size:18px"><i class="glyphicon glyphicon-ok"></i></span>', 
               mtcars[1:6,], id = 1:6)

  output[["mytable"]] <- renderDT({
    datatable(dat, 
              escape = -2, 
              callback = JS(callback),
              extensions = c('Buttons', 'Scroller'),
              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")
                ), 
                dom = 'B',
                buttons = list('copy', 'csv',
                               list(
                                 extend = "collection",
                                 text = 'Deselect', 
                                 action = DT::JS(
                                   c(
                                     "function ( e, table, node, config ) {",
                                     "  var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'",
                                     "  table.$('tr.selected').addClass('x');",
                                     "  table.$('tr.selected')",
                                     "    .each(function(){$(this).find('td').eq(1).html(cross);}).removeClass('selected');",
                                     "    var excludedRows = [];",
                                     "    table.$('tr').each(function(i, row){",
                                     "      if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}",
                                     "    });",
                                     "    Shiny.setInputValue('excludedRows', excludedRows);",
                                     "}"
                                   )
                                 )   
                               ),
                               list(
                                 extend = "collection",
                                 text = 'Restore', 
                                 action = DT::JS(
                                   c(
                                     "function ( e, table, node, config ) {",
                                     "  var checkmark = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-ok\"></i></span>'",
                                     "    table.$('tr')",
                                     "      .each(function(i){$(this).find('td').eq(1).html(checkmark);});",
                                     "    table.$('tr').removeClass('x').removeClass('selected');",
                                     "    Shiny.setInputValue('excludedRows', null);",
                                     " }"
                                   )
                                 )
                               )

                )
              )
    )
  })

  proxy <- dataTableProxy("mytable")



  observeEvent(input[['excludedRows']], { 
    print(input[['excludedRows']])}, ignoreInit =  T)


}

shinyApp(ui, server)

ps to comment about select: i removed the css entirely, except for the italic part. I mean that after clicking deselect or restore, i would like to unselect the clicked rows, shown in this image in blue (the color they get when you click them)

UPDATE question

I'm trying to change the Selected column to hold T and Fvalues and I think I managed to get the remove and `restore codes working with that, but I am not sure how to get the new render function working. What I have so far is this:

render <- c(
  'function(data, type, row, meta){',
  '  if(type === "display"){',
  '    return "<span style=\\\"color:red; font-size:18px\\\"><i class=\\\"glyphicon glyphicon-remove\\\"></i></span>";',
  '  } else {',
  '    return "<span style=\\\"color:red; font-size:18px\\\"><i class=\\\"glyphicon glyphicon-ok\\\"></i></span>";',
  '  }',
  '}'
)

The problem is that I don't know what to change the obviously incorrect IF statement for: ' if(type === "display"){',

Answer 1

The argument dt of the button action function (function(e,dt,node,config)) is the DataTables instance API for the host DataTable: https://datatables.net/reference/option/buttons.buttons.action

In the initComplete function function(settings), this object is settings.oInstance.api(), which is named table in the JS code (var table = settings.oInstance.api();).

So replace function(e,dt,node,config) with function(e,table,node,config), and move the JS code to the body of the button action function:

action = DT::JS(
  c(
    "function ( e, table, node, config ) {",
    "  var cross = '<span style=\"color:red; font-size:18px\"><i class=\"glyphicon glyphicon-remove\"></i></span>'",
    "  table.$('tr.selected').addClass('x');",
    "  table.$('tr.selected')",
    "    .each(function(){$(this).find('td').eq(1).html(cross);});",
    "}"
  )
)    

EDIT

Here is the full code for the updated solution:

library(shiny)
library(DT)

removal <- c(
  "function(e, table, node, config) {",
  "  table.$('tr.selected').addClass('x').each(function(){",
  "    var td = $(this).find('td').eq(1)[0];", 
  "    var cell = table.cell(td);", 
  "    cell.data('remove');",
  "  });",
  "  table.rows().deselect();",
  "  var excludedRows = [];",
  "  table.$('tr').each(function(i, row){",
  "    if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}",
  "  });",
  "  Shiny.setInputValue('excludedRows', excludedRows);",
  "}"
)

restore <- c(
  "function(e, table, node, config) {",
  "  table.$('tr').removeClass('x').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 "<span style=\\\"color:red; font-size:18px\\\"><i class=\\\"glyphicon glyphicon-" + data + "\\\"></i></span>";',
  '  } else {',
  '    return data;',
  '  }',
  '}'
)

ui <- fluidPage(
  tags$head(
    tags$style(HTML(
      ".x { 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"),
              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(targets = 1, render = JS(render)) 
                ),
                dom = "B",
                buttons = list("copy", "csv",
                               list(
                                 extend = "collection",
                                 text = 'Deselect', 
                                 action = JS(removal)
                               ),
                               list(
                                 extend = "collection",
                                 text = 'Restore', 
                                 action = JS(restore)
                               )
                )
              )
    )
  }, server = FALSE)

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

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

}

shinyApp(ui, server)

---

"Deselect" from shiny server: example

library(shiny)
library(DT)
library(shinyjs)

js <- paste(
  "var table = $('#mytable').find('table').DataTable();",
  "var rowsindices = [%s];",
  "for(var i=0; i<rowsindices.length; ++i){",
  "  var idx = rowsindices[i];",
  "  table.cell(idx, 1).data('remove');",
  "  table.row(idx).select();",
  "}",
  "$('.dt-button.buttons-collection').eq(0).click();", 
  sep = "\n"
)

removal <- c(
  "function(e, table, node, config) {",
  "  table.$('tr.selected').addClass('x').each(function(){",
  "    var td = $(this).find('td').eq(1)[0];", 
  "    var cell = table.cell(td);", 
  "    cell.data('remove');",
  "  });",
  "  table.rows().deselect();",
  "  var excludedRows = [];",
  "  table.$('tr').each(function(i, row){",
  "    if($(this).hasClass('x')){excludedRows.push(parseInt($(row).attr('id')));}",
  "  });",
  "    Shiny.setInputValue('excludedRows', excludedRows);",
  "}"
)

restore <- c(
  "function(e, table, node, config) {",
  "  table.$('tr').removeClass('x').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 "<span style=\\\"color:red; font-size:18px\\\"><i class=\\\"glyphicon glyphicon-" + data + "\\\"></i></span>";',
  '  } else {',
  '    return data;',
  '  }',
  '}'
)

ui <- fluidPage(
  useShinyjs(),
  tags$head(
    tags$style(HTML(
      ".x { 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(), 
  actionButton("go", "Deselect rows 1, 2, 3"),
  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"),
              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(targets = 1, render = JS(render)) 
                ),
                dom = "B",
                buttons = list("copy", "csv",
                               list(
                                 extend = "collection",
                                 text = 'Deselect', 
                                 action = JS(removal)
                               ),
                               list(
                                 extend = "collection",
                                 text = 'Restore', 
                                 action = JS(restore)
                               )
                )
              )
    )
  }, server = FALSE)

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

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

  observeEvent(input[["go"]], {
    rows <- c(1,2,3) - 1
    runjs(sprintf(js, paste0(rows, collapse=",")))
  })

}

shinyApp(ui, server)