Color cells depending of their value for each row of a data frame - r

Question

I have a data frame which looks like this:
header1 header2 header3 header4 ...
rowname1 1 2 3 4
rowname2 4 3 2 1
rowname3 2 4 1 3
rowname4 1 4 3 2
...
I would like to make a color gradient depending of the values for each row. Typically I would like the maximum value of each row to be colored green, the minimum value of each row colored red, and the other cells to be colored gradually depending of their value (second worst would be orange, second best would be yellow, etc ...).
An example of what I would like to obtain:
Could you please help me in solving this matter ?

Answer 1

Here is a possibility with DT.
dat <- data.frame(
V1 = rpois(6,5),
V2 = rpois(6,5),
V3 = rpois(6,5),
V4 = rpois(6,5),
V5 = rpois(6,5),
V6 = rpois(6,5)
)
library(DT)
js <- c(
"function(row, data, num, index){",
" data.shift();", # remove row name
" var min = Math.min.apply(null, data);",
" var max = Math.max.apply(null, data);",
" for(var i=0; i<data.length; i++){",
" var f = (data[i] - min)/(max-min);",
" var h = 120*f;",
" var color = 'hsl(' + h + ', 100%, 50%)';",
" $('td:eq('+(i+1)+')', row).css('background-color', color);",
" }",
"}"
)
datatable(dat, options = list(rowCallback = JS(js)))
To add black borders, do
datatable(dat, options = list(rowCallback = JS(js))) %>%
formatStyle(1:(ncol(dat)-1), `border-right` = "solid 1px")
The above solution assumes that you display the row names in the table. If you don't want to display the row names, do:
js <- c(
"function(row, data, num, index){",
" var min = Math.min.apply(null, data);",
" var max = Math.max.apply(null, data);",
" for(var i=0; i<data.length; i++){",
" var f = (data[i] - min)/(max-min);",
" var h = 120*f;",
" var color = 'hsl(' + h + ', 100%, 50%)';",
" $('td:eq('+i+')', row).css('background-color', color);",
" }",
"}"
)
datatable(dat, rownames = FALSE, options = list(rowCallback = JS(js)))
Edit
As requested by the OP in the chat, here is a variant. Instead of generating a color proportional to the cell value, it generates a color proportional to the rank of the cell value.
js <- c(
"function(row, data, num, index){",
" data.shift();", # remove row name
" var data_uniq = data.filter(function(item, index) {",
" if(data.indexOf(item) == index){",
" return item;",
" }}).sort(function(a,b){return a-b});",
" var n = data_uniq.length;",
" var ranks = data.slice().map(function(v){ return data_uniq.indexOf(v) });",
" for(var i=0; i<data.length; i++){",
" var f = ranks[i]/(n-1);",
" var h = 120*f;",
" var color = 'hsl(' + h + ', 100%, 50%)';",
" $('td:eq('+(i+1)+')', row).css('background-color', color);",
" }",
"}"
)
dat <- as.data.frame(matrix(round(rnorm(24),2), ncol=8))
datatable(dat, options = list(rowCallback = JS(js)))
I've found that the colors are more distinct by replacing var h = 120*f; with
var h = 60*(1 + Math.tan(2*f-1)/Math.tan(1));