Question

在R中使用 DT 包，我想突出显示每行的最大/最小数字数据框。

假设我们使用6个集群构建分段，然后我们想用描述性变量描述这些集群：

library(DT)
library(tidyverse)
df <- iris[1:6, 1:4] %>% t()
(df)

#                1   2   3   4   5   6
# Sepal.Length 5.1 4.9 4.7 4.6 5.0 5.4
# Sepal.Width  3.5 3.0 3.2 3.1 3.6 3.9
# Petal.Length 1.4 1.4 1.3 1.5 1.4 1.7
# Petal.Width  0.2 0.2 0.2 0.2 0.2 0.4

我们希望可视化哪些集群具有最高的Sepal.Length，哪一个具有最高的Sepal.Width等。解决方案将是每行的彩色最大值。

如果我使用 DT 包的 formatStyle（）函数，我可以按列进行（按照特定间隔突出显示最大值，颜色值，......），但我不能每排都这样做。即使我使用参数 target ='row'，整个行也会被着色，而不仅仅是我想要的最大值或单元格。

df %>% datatable() %>% 
   formatStyle('1', background = styleEqual(max(df[,1]), 'green'))

另一种方法是翻译我的数据帧的行和列，但我更喜欢有一个包含50行和5列的数据帧，而不是一个包含5行和50列且名称很长的数据帧。

提前感谢您的帮助和建议。

Answer 1

您需要自定义rowCallback功能。这是一个例子：

iris[1:6, 1:4] %>% datatable(options=list(rowCallback = JS(
  'function(row, data) {
    var num_data = data.slice(1,data.length)
    var row_max = Math.max.apply(Math,num_data);
    var row_min = Math.min.apply(Math,num_data);
    for(i=1;i < data.length; i++) {
      if(data[i]==row_max) {
        $("td:eq("+i+")", row).css("background-color", "green")
      } else if(data[i]==row_min) {
        $("td:eq("+i+")", row).css("background-color", "yellow")
      }
    }
  }')))

请注意，您需要过滤num_data中的任何文本列，包括第一个具有rownames的列。

如果要突出显示第二个最高值，可以对num_data进行排序并调整JS代码中的if / else，以便为您想要的颜色着色。排序num_data后，num_data[num_data.length-1]是最大值，num_data[0]是最小值，num_data [num_data.length-2]`是第二个最大值等。

iris[1:6, 1:4] %>% datatable(options=list(rowCallback = JS(
  'function(row, data) {
    var num_data = data.slice(1,data.length)
    num_data.sort(function (a, b) {  return a - b;  });
    for(i=1;i < data.length; i++) {
    if(data[i]==num_data[num_data.length-1]) {
      $("td:eq("+i+")", row).css("background-color", "green")
    } else if(data[i]==num_data[0]) {
      $("td:eq("+i+")", row).css("background-color", "yellow")
    } else if(data[i]==num_data[num_data.length-2]) {
      $("td:eq("+i+")", row).css("background-color", "orange")
    }
    }
  }')))

Answer 2

@NicE的回答是正确而正确的。他提到有必要从数据中过滤出任何文本列，在我的用例中，我确实将文本和数字混合在一起，因此我想提供一个基于他的解决方案，但也要增加额外的步骤，以防有人将来需要它：

library(shiny)

ui <- fluidPage(
  actionButton("reset", "New data"),
  DT::DTOutput("table")
)

server <- function(input, output, session) {
  output$table <- DT::renderDT({
    input$reset

    df <- data.frame(
      a = sample(letters, 5),
      b = runif(5),
      c = runif(5),
      d = sample(letters, 5),
      e = runif(5),
      f = runif(5)
    )

    DT::datatable(df, options = list(rowCallback = DT::JS(
      'function(row, data) {
        function filterNumbersFromArray(arr) {
          arr = arr.filter((item) => {
            return (typeof item == "number")
          })
          return arr;
        }
        var num_data = filterNumbersFromArray(data);
        var row_max = Math.max.apply(Math, num_data);
        var row_min = Math.min.apply(Math, num_data);
        for(i = 1; i < data.length; i++) {
          if(data[i] == row_max) {
            $("td:eq(" + i + ")", row).css("background-color", "lightgreen");
          } else if(data[i] == row_min) {
            $("td:eq(" + i + ")", row).css("background-color", "lightblue");
          }
        }
      }')))
  })
}

shinyApp(ui, server)

R包DT - 如何突出每行的最大值

2 个答案: