Use several selection colors in DT::datatable?

I have set:

output$tableId <- 
   DT::renderDataTable({DT::datatable(..., selection = "multiple")})

And I would like the background color of the selection to vary depending on of it's the first selection, or the second, etc.

It should be possible to use length(input$tableId_rows_selected) (which is described here) to obtain this behaviour? I'm guessing in combination with creating some CSS modifying this:

.table.dataTable tbody td.active, .table.dataTable tbody tr.active td {
   background-color: #007bff;
   color: white;
}

I know very little CSS, HTML, and JavaScript, so I find these things difficult.

EDIT 2022-02-14:

After @StéphaneLaurent initial answer below, I want to change my question slightly:

The logic I would prefer the most is:

1. We have m unique colors. n < m previous rows have been selected.
2. The n+1th row gets selected and is then coloured in the n+1th color and keeps this color until deselected.
3. When m rows are currently selected, no more selections are possible. Alternatively, I would also be interested in: When the m+1th row gets selected, it gets coloured in the first color, and other row occupying this color gets deselected. m+1 rows are now chosen, and when the m+2th row gets selected, it gets coloured in the second color, and the other row occupying this color gets deselected. And so on.

Moreover:

• Since my app will be running through an iframe on a website, and the underlying data of the app will have 10 to 100 million observations, I think a solution where DT::renderDataTable({...}, server = TRUE) would be good.
• I also want the solution to work with the DT::datatable(..., selection = list(mode = "multiple", selected = 1:3, target = "row")) option.

I will try to implement the above using @StéphaneLaurent answer, combined with the tools @YihuiXie illustrate here (app from page linked earlier).

If you use the following CSS, then the first row will be red if you select it, the second will be green, the third will be blue:

#dtable tbody tr.selected:nth-of-type(1) td {
  box-shadow: inset 0 0 0 9999px red;
}
#dtable tbody tr.selected:nth-of-type(2) td {
  box-shadow: inset 0 0 0 9999px green;
}
#dtable tbody tr.selected:nth-of-type(3) td {
  box-shadow: inset 0 0 0 9999px blue;
}

Here dtable is the id.

library(shiny)
library(DT)

css <- "
#dtable tbody tr.selected:nth-of-type(1) td {
  box-shadow: inset 0 0 0 9999px red;
}
#dtable tbody tr.selected:nth-of-type(2) td {
  box-shadow: inset 0 0 0 9999px green;
}
#dtable tbody tr.selected:nth-of-type(3) td {
  box-shadow: inset 0 0 0 9999px blue;
}
"

ui <- fluidPage(
  tags$head(
    tags$style(
      HTML(css)
    )
  ),
  br(), br(),
  DTOutput("dtable")
)

server <- function(input, output, session) {
  
  output[["dtable"]] <- renderDT({
    datatable(iris, selection = "multiple")
  })
  
}

shinyApp(ui, server)

Here is how to generate the CSS for 100 rows with a random color, using the sass package. Save the following scss file, say mystyle.scss:

$s-min: 20;
$s-max: 70;
$l-min: 30;
$l-max: 90;

@for $i from 1 through 100 {
  #dtable tbody tr.selected:nth-of-type(#{$i}) td {
    box-shadow: inset 0 0 0 9999px hsl(random(360),$s-min+random($s-max+-$s-min),$l-min+random($l-max+-$l-min));
  }
}

Now compile it to a CSS file:

library(sass)
sass(sass_file("mystyle.scss"), output = "mystyle.css")

Put the file mystyle.css in the www subfolder of the app, and then include it in the app as follows:

ui <- fluidPage(
  tags$head(
    tags$link(
      href = "mystyle.css", rel = "stylesheet"
    )
  ),
  ......

EDIT : jQuery solution

library(shiny)
library(DT)

js <- '
var colors = ["red", "green", "blue", "yellow", "purple"];
table.on("select", function(e, dt, type, indexes) {
  var count = table.rows({selected: true}).count();
  for(var i = 0; i < count; i++) {
    $("#dtable tbody tr.selected").eq(i).find("td").css(
      "box-shadow", "inset 0 0 0 9999px " + colors[i]
    );
  }
}).on("deselect", function(e, dt, type, indexes) {
  for(var i = 0; i < indexes.length; i++) {
    $("#dtable tbody tr").eq(indexes[i]).find("td").css(
      "box-shadow", ""
    );
  }
  var count = table.rows({selected: true}).count();
  for(var i = 0; i < count; i++) {
    $("#dtable tbody tr.selected").eq(i).find("td").css(
      "box-shadow", "inset 0 0 0 9999px " + colors[i]
    );
  }
});
'

ui <- fluidPage(
  br(), br(),
  DTOutput("dtable")
)

server <- function(input, output, session) {
  
  output[["dtable"]] <- renderDT({
    datatable(
      iris, 
      extensions = "Select",
      selection = "none", 
      callback = JS(js),
      options = list(
        "select" = "multi" 
      )
    )
  }, server = FALSE)
  
}

EDIT: correction of previous edit

Here is the correct JS code:

js <- '
var colors = ["red", "green", "blue", "yellow", "purple"];
var stack = [];
table.on("select", function(e, dt, type, indexes) {
  stack.push(indexes[0]);
  for(var i = 0; i < stack.length; i++) {
    $("#dtable tbody tr").eq(stack[i]).find("td").css(
      "box-shadow", "inset 0 0 0 9999px " + colors[i]
    );
  }
}).on("deselect", function(e, dt, type, indexes) {
  var i0 = stack.indexOf(indexes[0]);
  $("#dtable tbody tr").eq(stack[i0]).find("td").css(
    "box-shadow", ""
  );
  stack.splice(i0, 1);
  for(var i = 0; i < stack.length; i++) {
    $("#dtable tbody tr").eq(stack[i]).find("td").css(
      "box-shadow", "inset 0 0 0 9999px " + colors[i]
    );
  }
});
'

EDIT: without the 'Select' extension

js <- '
var colors = ["red", "green", "blue", "yellow", "purple"];
var stack = [];
table.on("click", "tr", function() {
  var $rows = $("#dtable tbody tr"); // SIMONSIMON I moved this line
  var $row = $(this);
  var idx = $row.index();
  if($row.hasClass("selected")) {
    stack.push(idx);
    for(var i = 0; i < stack.length; i++) {
      $rows.eq(stack[i]).find("td").css(
        "box-shadow", "inset 0 0 0 9999px " + colors[i]
      );
    }
  } else {
    var i0 = stack.indexOf(idx);
    $rows.eq(stack[i0]).find("td").css(
      "box-shadow", ""
    );
    stack.splice(i0, 1);
    for(var i = 0; i < stack.length; i++) {
      $rows.eq(stack[i]).find("td").css(
        "box-shadow", "inset 0 0 0 9999px " + colors[i]
      );
    }
  }
});
'

......

  output[["dtable"]] <- renderDT({
    datatable(
      iris, 
      selection = "multiple", 
      callback = JS(js)
    )
  }, server = TRUE)

While technically this doesn't do what I originally requested (i.e. changing the selection colouring dynamically), the results from this implementation appear visually similar to the end-user.

The idea behind the solution is to keep track of the row selection counter, update the table via a proxy, and apply conditional formatting.

library(shiny)
library(data.table)
library(DT)
data(iris)
iris <- suppressWarnings(cbind(as.data.table(iris),
currently_selected = numeric(),
selected_as_nr     = numeric(),
overwrite          = numeric()))
ui <- fluidPage(
dataTableOutput("table"),
)
server <- function(input, output, session) {
iris[, currently_selected := 0]
iris[, selected_as_nr     := NA]
iris[, overwrite          := 0]
output$table <- DT::renderDataTable({
DT::datatable(iris,
selection = list(mode = "multiple",
selected = 1,
target = "row")) %>%
formatStyle("Sepal.Length",
"selected_as_nr",
backgroundColor = styleEqual(0:4, c("green",
"red",
"black",
"blue",
"yellow")))
})
proxy <- dataTableProxy(outputId = "table")
observeEvent(input$table_rows_selected, {
new_selected_row <- input$table_rows_selected[1]
iris[new_selected_row, currently_selected := (currently_selected + 1) %% 2]
if (iris[new_selected_row, currently_selected] == 1) {
new_selection_nr <- suppressWarnings(iris[, min(setdiff(0:4, unique(selected_as_nr)))])
if (new_selection_nr != "Inf") {
iris[, overwrite := 0]
iris[new_selected_row, selected_as_nr := new_selection_nr] 
} else {
overwrite <- iris[, unique(overwrite)]
iris[selected_as_nr == overwrite, currently_selected := 0]
iris[selected_as_nr == overwrite, selected_as_nr := NA]
iris[new_selected_row, selected_as_nr := overwrite]
iris[, overwrite := (overwrite + 1) %% 5]
}
} else {
iris[new_selected_row, selected_as_nr := NA]
}
DT::replaceData(proxy, iris)
})
}
shinyApp(ui, server)