颜色单元格取决于它们在数据帧每一行的值

Question

我有一个看起来像这样的数据框：

          header1  header2  header3  header4  ...
rowname1     1        2        3        4
rowname2     4        3        2        1
rowname3     2        4        1        3
rowname4     1        4        3        2
...

我想根据每行的值进行颜色渐变。通常，我希望将每行的最大值涂成绿色，将每行的最小值涂成红色，并将其他单元格根据其值逐渐涂上颜色（第二坏的是橙色，第二好的是黄色，依此类推） ...）。

我想要获得的示例：

您能帮我解决这个问题吗？

Answer 1

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

要添加黑色边框，请

datatable(dat, options = list(rowCallback = JS(js))) %>% 
  formatStyle(1:(ncol(dat)-1), `border-right` = "solid 1px")

---

以上解决方案假定您在表中显示行名。如果您不想显示行名，请执行以下操作：

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

---

编辑

根据聊天室中OP的要求，这是一个变体。它不会生成与单元格值成比例的颜色，而是生成与单元格值的等级成比例的颜色。

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

我发现将var h = 120*f;替换为

可以使颜色更加鲜明

var h = 60*(1 + Math.tan(2*f-1)/Math.tan(1));