Цвет ячеек в зависимости от их значения для каждой строки кадра данных - PullRequest
2 голосов
/ 08 апреля 2019

У меня есть фрейм данных, который выглядит следующим образом:

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

Я хотел бы сделать градиент цвета в зависимости от значений для каждой строки.Обычно я хотел бы, чтобы максимальное значение каждой строки окрашивалось в зеленый цвет, минимальное значение каждой строки окрашивалось в красный цвет, а остальные ячейки окрашивались постепенно в зависимости от их значения (вторым наихудшим будет оранжевый, вторым лучшим будет желтый и т. Д.)....).

Пример того, что я хотел бы получить: enter image description here

Не могли бы вы помочь мне в решении этого вопроса?

1 Ответ

1 голос
/ 08 апреля 2019

Здесь есть возможность с 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

Чтобы добавить черные границы, выполните

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

enter image description here

I 'мы обнаружили, что цвета стали более четкими, заменив var h = 120*f; на

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

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...