有条件地设置RowGroup的样式

Question

是否可以设置RowGroup标头的样式？例如，如何在此处更改字体颜色：

library(DT)

mtcars2 = mtcars[1:20, ]
datatable(
  mtcars2[order(mtcars2$cyl), ],
  extensions = 'RowGroup',
  options = list(rowGroup = list(dataSrc = 2)),
  selection = 'none'
)

我找到了this relevant question，但无法将答案应用于我的案子。

对于multi-level grouping，如何仅设置特定组的标题的样式？

Answer 1

mtcars2 = mtcars[1:20, ]
datatable(
  mtcars2[order(mtcars2$cyl), ],
  extensions = 'RowGroup',
  options = list(
    rowGroup = list(
      dataSrc = 2,
      startRender = JS(
        "function(rows, group) {", 
        "  var style = group == 4 ? 'background-color: lime;' : 'background-color: crimson;';",
        "  var td = `<td style='${style}' colspan=12>${group}</td>`;",
        "  return $(`<tr>${td}</tr>`);",
        "}"
      )
    )
  ),
  selection = 'none'
)

---

奖金

这是一种自动设置行组标题的样式。它使用JavaScript库d3-scale-chromatic用于调色板，并使用TinyColor检测颜色是深色还是浅色。

dat <- data.frame(
  Group = gl(10, 2, labels = LETTERS[1:10]),
  x1 = rpois(20, 100),
  x2 = rpois(20, 100),
  x3 = rpois(20, 100)
)

dtable <- datatable(
  dat,
  class = "compact",
  extensions = 'RowGroup',
  options = list(
    pageLength = 20,
    rowGroup = list(
      dataSrc = 1,
      startRender = JS(
        "function(rows, group) {", 
        "  var groups = this.s.dt.table().column(1).data().unique();",
        "  var t = groups.indexOf(group) / groups.length;",
        "  var bgcolor = d3.interpolateWarm(t);",
        "  var color = tinycolor(bgcolor).isDark() ? 'white' : 'black'",
        "  var style = `color: ${color}; background-color: ${bgcolor};`;",
        "  var ncol = this.s.dt.table().columns().count();",
        "  var td = `<td style='${style}' colspan=${ncol}>${group}</td>`;",
        "  return $(`<tr>${td}</tr>`);",
        "}"
      )
    )
  ),
  selection = 'none'
)

dep <- htmltools::htmlDependency(
  "d3-scale-chromatic", "1.5.0",
  c(href =  "https://d3js.org/"), 
  script = c(
    "d3-color.v1.min.js", 
    "d3-interpolate.v1.min.js",
    "d3-scale-chromatic.v1.min.js"
  )
)
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
  "TinyColor", "1.4.1",
  c(href =  "https://cdn.jsdelivr.net/gh/bgrins/TinyColor/"), 
  script = "tinycolor.js"
)
dtable$dependencies <- c(dtable$dependencies, list(dep))

dtable

---

编辑

如果您有嵌套的组，这是将样式仅应用于第二级的方法：

mtcars2 = mtcars[1:20, ]
datatable(
  mtcars2[order(mtcars2$cyl), ],
  extensions = 'RowGroup',
  options = list(
    rowGroup = list(
      dataSrc = c(2,11),
      startRender = JS(
        "function(rows, group, level) {", 
        "  if(level == 1) {",
        "    var style = 'background-color: lime;'",
        "    var td = `<td style='${style}' colspan=12>${group}</td>`;",
        "    return $(`<tr>${td}</tr>`);",
        "  }else{",
        "    return group;",
        "  }",
        "}"
      )
    )
  ),
  selection = 'none'
)