如何格式化 DT 背景*每行*?
How to format DT background *per row*?
我想使用 DT 的 formatStyle()
为每行提供颜色渐变。
鉴于此示例数据:
library(DT)
data <- round(data.frame(
x = runif(5, 0, 5),
y = runif(5, 0, 10),
z = runif(5, 0, 20)
), 3)
break_points <- function(x) stats::quantile(x, probs = seq(.05, .95, .05), na.rm = TRUE)
red_shade <- function(x) round(seq(255, 40, length.out = length(x) + 1), 0) %>% {paste0("rgb(255,", ., ",", ., ")")}
我可以使用以下代码根据 整个 table 中的值为单元格背景着色:
brks <- break_points(data)
clrs <- red_shade(brks)
datatable(data) %>% formatStyle(names(data), backgroundColor = styleInterval(brks, clrs))
或者我可以使用以下代码根据每列 的值 为单元格背景着色:
brks <- apply(data, 2, break_points)
clrs <- apply(brks, 2, red_shade)
dt <- datatable(data)
for(i in colnames(data)){
dt <- dt %>% formatStyle(i, backgroundColor = styleInterval(brks[,i], clrs[,i]))
}
dt
但我不确定最简单最干净的解决方案是什么每行,因此在每一行中最高值最暗,较低值最亮。
使用 rowCallback:
library(DT)
data <- round(data.frame(
x = runif(10, 0, 5),
y = runif(10, 0, 10),
z = runif(10, 0, 20)
), 3)
break_points <- function(x) stats::quantile(x, probs = seq(.05, .95, .05), na.rm = TRUE)
red_shade <- function(x) round(seq(255, 40, length.out = length(x) + 1), 0) %>% {paste0("rgb(255,", ., ",", ., ")")}
brks <- apply(data, 1, break_points)
clrs <- apply(brks, 2, red_shade)
rowCallback <- "function(row, data, displayNum, index){"
for(i in 1:ncol(data)){
rowCallback <- c(
rowCallback,
sprintf("var value = data[%d];", i)
)
for(j in 1:nrow(data)){
rowCallback <- c(
rowCallback,
sprintf("if(index === %d){", j-1),
sprintf("$('td:eq(%d)',row).css('background-color', %s);",
i, styleInterval(brks[,j], clrs[,j])),
"}"
)
}
}
rowCallback <- c(rowCallback, "}")
datatable(data, options = list(rowCallback = JS(rowCallback)))
我想使用 DT 的 formatStyle()
为每行提供颜色渐变。
鉴于此示例数据:
library(DT)
data <- round(data.frame(
x = runif(5, 0, 5),
y = runif(5, 0, 10),
z = runif(5, 0, 20)
), 3)
break_points <- function(x) stats::quantile(x, probs = seq(.05, .95, .05), na.rm = TRUE)
red_shade <- function(x) round(seq(255, 40, length.out = length(x) + 1), 0) %>% {paste0("rgb(255,", ., ",", ., ")")}
我可以使用以下代码根据 整个 table 中的值为单元格背景着色:
brks <- break_points(data)
clrs <- red_shade(brks)
datatable(data) %>% formatStyle(names(data), backgroundColor = styleInterval(brks, clrs))
或者我可以使用以下代码根据每列 的值 为单元格背景着色:
brks <- apply(data, 2, break_points)
clrs <- apply(brks, 2, red_shade)
dt <- datatable(data)
for(i in colnames(data)){
dt <- dt %>% formatStyle(i, backgroundColor = styleInterval(brks[,i], clrs[,i]))
}
dt
但我不确定最简单最干净的解决方案是什么每行,因此在每一行中最高值最暗,较低值最亮。
使用 rowCallback:
library(DT)
data <- round(data.frame(
x = runif(10, 0, 5),
y = runif(10, 0, 10),
z = runif(10, 0, 20)
), 3)
break_points <- function(x) stats::quantile(x, probs = seq(.05, .95, .05), na.rm = TRUE)
red_shade <- function(x) round(seq(255, 40, length.out = length(x) + 1), 0) %>% {paste0("rgb(255,", ., ",", ., ")")}
brks <- apply(data, 1, break_points)
clrs <- apply(brks, 2, red_shade)
rowCallback <- "function(row, data, displayNum, index){"
for(i in 1:ncol(data)){
rowCallback <- c(
rowCallback,
sprintf("var value = data[%d];", i)
)
for(j in 1:nrow(data)){
rowCallback <- c(
rowCallback,
sprintf("if(index === %d){", j-1),
sprintf("$('td:eq(%d)',row).css('background-color', %s);",
i, styleInterval(brks[,j], clrs[,j])),
"}"
)
}
}
rowCallback <- c(rowCallback, "}")
datatable(data, options = list(rowCallback = JS(rowCallback)))