在R中使用庫DT渲染DataTable時，如何使用行條件為單元格着色？

Question

我正在使用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")))

當我運行此代碼時，得到的輸出是： 實際輸出這是對'x_mean'進行按列比較。 但是，我只想對第一行執行與'x_mean'的逐行比較。 第二行的單元格不應與'x_mean'進行比較。 預期的輸出是這樣的： 預期的輸出

可以使用DT庫中的任何當前函數來完成此操作，還是必須使用JavaScript來實現此目的（如果可以，那么我將要插入的JavaScript代碼是什么？）？

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

Answer 2

一種解決方案是創建一個循環，將每個值與行平均值進行比較，然后使用past命令為單元格着色。 您可以在此處找到示例： R到乳膠-自動為數字着色

在此示例中，單元格使用以下命令為乳膠上色： \\\\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")))