如何按列分位数设置闪亮的数据表单元格样式？

Question

我正在尝试将闪亮数据表中的单元格样式设置为六个左右的列级分位数（第一列除外，它是字符）。这是我当前代码的 MRE，它使用来自thisanswer的行回调将单元格样式设置为列平均值的上方或下方。我对 javascript 不熟悉。

library(shiny)
library(DT)

set.seed(123)
dataset <- data.frame(
  ID = 1:20,
  Value1 = round(rnorm(10, mean = 15, sd = 5), 1),
  Value2 = round(rnorm(10, mean = 25, sd = 8), 1))

ui <- fluidPage(
  titlePanel("Reprex for cell styling"),
  dataTableOutput("myTable"))

server <- function(input, output, session) {
  output$myTable <- renderDataTable({
    datatable(
      dataset,
      options = list(
        rowCallback = JS(paste0(
          "function(row, data) {\n",
          paste(
            sapply(
              2:ncol(dataset),
              function(i) paste0("var value=data[", i, "]; if (value!==null) $(this.api().cell(row,", i, ").node()).css({'background-color':value <=", mean(dataset[[i]]), " ? '#6EACCA' : '#FFDD91'});\n")
            ),
            collapse = "\n"
          ),
          "}\n"
        ))
      )
    )
  })
}

shinyApp(ui, server)

到目前为止，我的大多数尝试都类似于：

rowCallback = JS(paste0("function(row, data) {\n",
                        "  // Iterate over columns starting from the second column (index 1)\n",
                        sapply(2:ncol(dataset), function(i) {
                          paste0(
                            "  var value = data[", i, "];\n",
                            "  if (value !== null) {\n",
                            "    // Calculate column-level quantiles for the current column\n",
                            "    var columnData = data.map(function(row) { return row[", i, "]; });\n",
                            "    var quantiles = quantile(columnData, [0, 0.2, 0.4, 0.6, 0.8, 1]);\n",
                            "    var color;\n",
                            "    if (value <= quantiles[1]) color = '#BFD3E6';\n",  
                            "    else if (value <= quantiles[2]) color = '#8BACD6';\n",
                            "    else if (value <= quantiles[3]) color = '#6382C1';\n",
                            "    else if (value <= quantiles[4]) color = '#385FAD';\n",
                            "    else if (value <= quantiles[5]) color = '#0D3D99';\n",  
                            "    else color = ''; // Handle edge cases if needed\n",
                            "    $(this.api().cell(row, ", i, ").node()).css({'background-color': color});\n",
                            "  }\n"
                          )
                        }), "}\n"))

我得到的最接近的是六个分位数的样式，但截止值恢复为整个数据表值而不是列级分位数。

Answer 1

您可以使用DT功能

formatStyle

和

styleInterval

:

library(DT)

set.seed(123)
dataset <- data.frame(
  ID = 1:20,
  Value1 = round(rnorm(200, mean = 15, sd = 5), 1),
  Value2 = round(rnorm(200, mean = 25, sd = 8), 1)
)

brks1 <- quantile(dataset$Value1, c(0, 0.2, 0.4, 0.6, 0.8))
brks2 <- quantile(dataset$Value2, c(0, 0.2, 0.4, 0.6, 0.8))
clrs <- c("red", "#BFD3E6", "#8BACD6", "#6382C1", "#385FAD", "#0D3D99")

datatable(dataset) %>% 
  formatStyle("Value1", backgroundColor = styleInterval(brks1, clrs)) %>%
  formatStyle("Value2", backgroundColor = styleInterval(brks2, clrs))