R语言 如何通过列分位数设置闪亮的数据表单元格的样式?

4ioopgfo  于 9个月前  发布在  其他
关注(0)|答案(2)|浏览(80)

我试图将一个闪亮的数据表中的单元格样式化为六个左右的列级分位数(除了第一列,这是字符)。这里是我当前代码的MRE,它使用this answer的rowcallback将单元格样式化为列均值的上方或下方。我不熟悉JavaScript。
EDIT:用户可以选择/删除列,所以我需要一个解决方案,适用于当前在dataset中的列。

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


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

ru9i0ody

ru9i0ody1#

您可以使用DT函数formatStylestyleInterval

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

字符串

3b6akqbq

3b6akqbq2#

在@StéphaneLaurent上面的答案和here的帮助下完成了这个工作。使用当前列的分位数列表和样式循环:

quantileList <- lapply(dataset[, -1, drop = FALSE], function(col) {
      quantile(col, c(0, 0.2, 0.4, 0.6, 0.8))
    })
    
    clrs <- c("red", "#BFD3E6", "#8BACD6", "#6382C1", "#385FAD", "#0D3D99")
    
    DT <- datatable(dataset)

    for (i in 2:ncol(dataset)) {
      brks <- quantileList[[i - 1]]
      colname <- colnames(dataset)[i]
      DT <- DT %>% formatStyle(colname, backgroundColor = styleInterval(brks, clrs))
    }
    
    DT

字符串

相关问题