在R中使用库DT渲染DataTable时，如何使用行条件为单元格着色？

Question

I am rendering a 2 x 5 data table (all numeric rows) in a Shiny app using DT library.

I want to color cells by comparing each cell to the mean of its corresponding row.

I am unable to perform this using the current functions provided in the library. After some googling, I figured out that I would have to use JavaScript to achieve this.

I have no experience of coding in JavaScript and require an example for doing this.

Requirement: Compare cell to the corresponding row mean, and color the cell if the value is less than the mean and green otherwise. As a reproducible example, please refer to the following code chunk:

set.seed(1)
x <- sample(1:10, size = 5, replace = T)

set.seed(1)
y <- sample(100:200, size = 5, replace = T)

## Main data frame, to be used in DT::datatable function
df <- data.frame(rbind(x, y))
df

##    X1  X2  X3  X4  X5
## x   3   4   6  10   3
## y 126 137 157 191 120

x_mean <- mean(x)
y_mean <- mean(y)

## Rendering data table
DT::datatable(
 df,
 options = list(
 searching = F,
 paging = F,
 ordering = F,
 info = F
 )
) %>% 
DT::formatStyle(1:5, backgroundColor = styleInterval(x_mean, c("red", 
 "green")))

When I run this code, the output I get is this: Actual Output This is performing column-wise comparisons to 'x_mean'. However, I want to perform row-wise comparisons to 'x_mean', only for the first row. Cells of the second row should not be colored basis comparison to 'x_mean'. Intended output is this: Intended Output

Can this be done using any current function in DT library, or do I have to use JavaScript to achieve this (if so, what would be the JavaScript codes that I would have to insert?) ?

Answer 1

library(DT)
set.seed(1)
x <- sample(1:10, size = 5, replace = T)
set.seed(1)
y <- sample(100:200, size = 5, replace = T)
df <- data.frame(rbind(x, y))


rowCallback <- c(
  "function(row, dat, displayNum, index){",
  "  var N = dat.length;",
  "  if(index == 0){ // only first row",
  "    var rowData = dat.slice(); rowData.shift();",
  "    var mean = rowData.reduce(function(a, b){ return a + b }, 0) / (N-1);",
  "    for(var j=1; j<N; j++){",
  "      var color = dat[j] < mean ? 'red' : 'green';",
  "      $('td:eq('+j+')', row).css('background-color', color);",
  "    }",
  "  }",
  "}"
)

datatable(
  df,
  options = list(
    searching = F,
    paging = F,
    ordering = F,
    info = F, 
    rowCallback = JS(rowCallback)
  )
)

Answer 2

A solution could be to create a loop to compare each value to your row mean, and then to colour your cell with the past command. You can find an example here : R to latex - Coloring numbers automatically

In this example the cell is coloured (in latex) with the command: \\\\cellcolor{red!25} . Change it according to the kind of extraction you want.

It is complicated to reply without any reproducible example. I still hope it helps.

EDIT

A quick and easy way is to select the row you want from the beginning ( df[1,] ):

datatable(df[1,]) %>% formatStyle(1:5,
                      backgroundColor = styleInterval(x_mean, c("red","green")))

We can make it a little more "automatic", replacing 1:5 by 1:length(df[1,]) and x_mean by mean(as.numeric(df[1,])) :

datatable(df[1,]) %>% formatStyle(1:length(df[1,]),
                      backgroundColor = styleInterval(mean(as.numeric(df[1,])), c("red","green")))