2

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: enter image description here

Could you please help me in solving this matter ?

  • 1
    You can use `kableExtra` package. [Here](https://cran.r-project.org/web/packages/kableExtra/vignettes/awesome_table_in_html.html) is an excellent guide. – symbolrush Apr 08 '19 at 09:47
  • and potentially some more alts [here](https://stackoverflow.com/questions/50058750/r-tablegrob-heatmap-or-conditional-formating-in-column) – user20650 Apr 08 '19 at 09:55

1 Answers1

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)))

enter image description here

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)))

enter image description here

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));

enter image description here

Stéphane Laurent
  • 75,186
  • 15
  • 119
  • 225
  • Thanks for your answer. I tried it with my data frame and it creates a datatable just like yours ... but without any color. Would you have any idea why ? – Valentin Dubois Apr 08 '19 at 11:08
  • @ValentinDubois Are there only numerical values in your dataframe ? And are there some missing values ? – Stéphane Laurent Apr 08 '19 at 11:10
  • Only numerical values and no missing values or so I believe. EDIT: actually it seems the values are not numeric for some reason, going to solve this – Valentin Dubois Apr 08 '19 at 11:17
  • Ok so now I have the colors, but it seems to apply the colors regarding the whole set of values instead of per row only. – Valentin Dubois Apr 08 '19 at 13:29
  • Ok I think it doesn't work due to the non numeric row names. I'm not sure to understand the "js" code but I think it requires a numeric argument for "row" right ? – Valentin Dubois Apr 08 '19 at 14:04
  • @ValentinDubois Aaahh yes, sorry. The `data` argument corresponds to one row. Indeed the row name is the first component and that's the problem. Let me try to fix that. – Stéphane Laurent Apr 08 '19 at 14:11
  • @ValentinDubois I have updated `js`. Could you try please ? Now the code should accept character row names (`data.shift()` removes the first component, that is the row name). – Stéphane Laurent Apr 08 '19 at 14:21
  • Thanks a lot it works perfectly this time ! I'm sorry to abuse of your knowledge, but could you also add black borders for each cell, so that we can differientate them ? (especially the green cells which are difficult to differentiate from each other). Thanks a lot for your help anyway ! – Valentin Dubois Apr 08 '19 at 14:29
  • Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/191463/discussion-between-valentin-dubois-and-stephane-laurent). – Valentin Dubois Apr 08 '19 at 15:07