在R中使用库DT渲染DataTable时如何使用行条件为单元格着色?

时间:2018-11-04 17:15:01

标签: r shiny dt

我正在使用DT库在Shiny应用程序中呈现2 x 5数据表(所有数字行)。

我想通过将每个单元格与其对应行的平均值进行比较来为单元格着色。

我无法使用库中提供的当前功能执行此操作。经过一番谷歌搜索,我发现我必须使用JavaScript来实现这一目标。

我没有使用JavaScript进行编码的经验,因此需要一个示例。

要求:将单元格与相应的行平均值进行比较,如果该值小于平均值,则为该单元格着色,否则为绿色。作为可重现的示例,请参考以下代码块:

set.seed(1)
x <- sample(1:10, size = 5, replace = T)

set.seed(1)
y <- sample(100:200, size = 5, replace = T)

## Main data frame, to be used in DT::datatable function
df <- data.frame(rbind(x, y))
df

##    X1  X2  X3  X4  X5
## x   3   4   6  10   3
## y 126 137 157 191 120

x_mean <- mean(x)
y_mean <- mean(y)

## Rendering data table
DT::datatable(
 df,
 options = list(
 searching = F,
 paging = F,
 ordering = F,
 info = F
 )
) %>% 
DT::formatStyle(1:5, backgroundColor = styleInterval(x_mean, c("red", 
 "green")))

运行此代码时,我得到的输出是:Actual Output 这将与“ x_mean”进行按列比较。但是,我只想对第一行执行与'x_mean'的逐行比较。第二行的单元格不应与'x_mean'进行比较。 预期的输出是这样的:Intended Output

可以使用DT库中的任何当前函数来完成此操作,还是必须使用JavaScript来实现这一目标(如果可以,我必须插入什么JavaScript代码?)?

2 个答案:

答案 0 :(得分:1)

library(DT)
set.seed(1)
x <- sample(1:10, size = 5, replace = T)
set.seed(1)
y <- sample(100:200, size = 5, replace = T)
df <- data.frame(rbind(x, y))


rowCallback <- c(
  "function(row, dat, displayNum, index){",
  "  var N = dat.length;",
  "  if(index == 0){ // only first row",
  "    var rowData = dat.slice(); rowData.shift();",
  "    var mean = rowData.reduce(function(a, b){ return a + b }, 0) / (N-1);",
  "    for(var j=1; j<N; j++){",
  "      var color = dat[j] < mean ? 'red' : 'green';",
  "      $('td:eq('+j+')', row).css('background-color', color);",
  "    }",
  "  }",
  "}"
)

datatable(
  df,
  options = list(
    searching = F,
    paging = F,
    ordering = F,
    info = F, 
    rowCallback = JS(rowCallback)
  )
)

答案 1 :(得分:0)

一种解决方案可能是创建一个循环以将每个值与行均值进行比较,然后使用past命令为单元格着色。 您可以在此处找到示例:R to latex - Coloring numbers automatically

在此示例中,单元格使用命令\\cellcolor{red!25}上色(乳胶中)。根据您想要的提取类型进行更改。

在没有任何可复制示例的情况下答复很复杂。我仍然希望能有所帮助。

编辑

一种快速简便的方法是从头开始选择所需的行(df[1,]

datatable(df[1,]) %>% formatStyle(1:5,
                      backgroundColor = styleInterval(x_mean, c("red","green")))

我们可以使其更加“自动”,将1:5替换为1:length(df[1,]),将x_mean替换为mean(as.numeric(df[1,]))

datatable(df[1,]) %>% formatStyle(1:length(df[1,]),
                      backgroundColor = styleInterval(mean(as.numeric(df[1,])), c("red","green")))