Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to format DT background *per row*?

Tags:

r

dt

I want to use DT's formatStyle() to give a colour gradient per row.

Given this sample data:

library(DT)

data <- round(data.frame(
  x = runif(5, 0, 5),
  y = runif(5, 0, 10), 
  z = runif(5, 0, 20)
), 3)

break_points <- function(x) stats::quantile(x, probs = seq(.05, .95, .05), na.rm = TRUE)
red_shade <- function(x) round(seq(255, 40, length.out = length(x) + 1), 0) %>% {paste0("rgb(255,", ., ",", ., ")")}

I can colour the cell backgrounds based on values in the entire table using this code:

brks <- break_points(data)
clrs <- red_shade(brks)
datatable(data) %>% formatStyle(names(data), backgroundColor = styleInterval(brks, clrs))

Or I can colour the cell background based on values per column with this code:

brks <- apply(data, 2, break_points)
clrs <- apply(brks, 2, red_shade)
dt <- datatable(data)
for(i in colnames(data)){
  dt <- dt %>% formatStyle(i, backgroundColor = styleInterval(brks[,i], clrs[,i]))
}
dt

But I'm not sure what's the simplest cleanest solution to do so per row, so that in each row the highest value is darkest and the lower value is lightest.

like image 901
DeanAttali Avatar asked Nov 30 '25 01:11

DeanAttali


1 Answers

With a rowCallback:

library(DT)

data <- round(data.frame(
  x = runif(10, 0, 5),
  y = runif(10, 0, 10), 
  z = runif(10, 0, 20)
), 3)

break_points <- function(x) stats::quantile(x, probs = seq(.05, .95, .05), na.rm = TRUE)
red_shade <- function(x) round(seq(255, 40, length.out = length(x) + 1), 0) %>% {paste0("rgb(255,", ., ",", ., ")")}

brks <- apply(data, 1, break_points)
clrs <- apply(brks, 2, red_shade)

rowCallback <- "function(row, data, displayNum, index){"

for(i in 1:ncol(data)){
  rowCallback <- c(
    rowCallback,
    sprintf("var value = data[%d];", i)
  )
  for(j in 1:nrow(data)){
    rowCallback <- c(
      rowCallback, 
      sprintf("if(index === %d){", j-1),
      sprintf("$('td:eq(%d)',row).css('background-color', %s);", 
              i, styleInterval(brks[,j], clrs[,j])),
      "}"
    )
  }
}
rowCallback <- c(rowCallback, "}")

datatable(data, options = list(rowCallback = JS(rowCallback)))

enter image description here

like image 119
Stéphane Laurent Avatar answered Dec 01 '25 20:12

Stéphane Laurent