作为 HTML table 的一部分的条件栏
Conditional bars as part of an HTML table
我正在寻找一种方法来创建条件条形图作为 gt
table(tables 包的精彩语法)的一部分。在 DT
的 datatable
中似乎是可能的,如此处 所示。这是我想要的图像,下面是在 DT
中生成此图像的代码。不过,我正在寻找 gt
解决方案。
library(tidyverse)
library(DT)
# custom function that uses CSS gradients to make the kind of bars I need
color_from_middle <- function (data, color1,color2)
{
max_val=max(abs(data))
JS(sprintf("isNaN(parseFloat(value)) || value < 0 ? 'linear-gradient(90deg, transparent, transparent ' + (50 + value/%s * 50) + '%%, %s ' + (50 + value/%s * 50) + '%%,%s 50%%,transparent 50%%)': 'linear-gradient(90deg, transparent, transparent 50%%, %s 50%%, %s ' + (50 + value/%s * 50) + '%%, transparent ' + (50 + value/%s * 50) + '%%)'",
max_val,color1,max_val,color1,color2,color2,max_val,max_val))
}
mtcars %>%
rownames_to_column() %>%
select(rowname, mpg) %>%
head(10) %>%
mutate(mpg = (mpg - 20) %>% round) %>%
datatable() %>%
formatStyle(
"mpg",
background = color_from_middle(mtcars$mpg,'red','green')
)
tab_bar
会将条形添加到指定的列。它将值缩放到 0
和 100
之间。 0
的值映射到 50
。
tab_style
用于在每个值上设置背景渐变。
library(tidyverse)
library(gt)
tab_bar <- function(data, column) {
vals <- data[['_data']][[column]]
scale_offset <- (max(vals) - min(vals)) / 2
scale_multiplier <- 1 / max(abs(vals - scale_offset))
for (val in unique(vals)) {
if (val > 0) {
color <- "lightgreen"
start <- "50"
end <- ((val - scale_offset) * scale_multiplier / 2 + 1) * 100
} else {
color <- "#FFCCCB"
start <- ((val - scale_offset) * scale_multiplier / 2 + 0.5) * 100
end <- "50"
}
data <-
data %>%
tab_style(
style = list(
css = glue::glue("background: linear-gradient(90deg, transparent, transparent {start}%, {color} {start}%, {color} {end}%, transparent {end}%);")
),
locations = cells_body(
columns = column,
rows = vals == val
)
)
}
data
}
这是 mtcars
。
out <-
mtcars %>%
rownames_to_column() %>%
select(rowname, mpg) %>%
head(10) %>%
mutate(mpg = (mpg - 20) %>% round) %>%
gt()
out %>%
cols_width(vars(mpg) ~ 120) %>%
tab_bar(column = "mpg")
也允许多列。
library(tidyverse)
library(gt)
tab_bar <- function(.data, .columns = .data[["_data"]] %>% select_if(is.numeric) %>% names(), .col_neg = "#FFCCCB", .col_pos = "lightgreen"){
for (column in .columns){
vals <- .data[['_data']][[column]]
scale_multiplier <- 50/abs(max(vals) - min(vals))
for (val in setdiff(unique(vals), 0)) {
if (val > 0) {
color <- .col_pos
start <- "50"
end <- 50 + val * scale_multiplier + 2
} else if (val < 0) {
color <- .col_neg
start <- 50 + val * scale_multiplier - 2
end <- "50"
}
.data <-
.data %>%
tab_style(
style = list(
css = glue::glue("background: linear-gradient(90deg, transparent, transparent {start}%, {color} {start}%, {color} {end}%, transparent {end}%);")
),
locations = cells_body(
columns = column,
rows = vals == val
)
)
}
}
.data
}
map(
set_names(letters[1:5]),
~runif(10, -1, 1)
) %>%
as_tibble() %>%
gt() %>%
tab_bar()
我正在寻找一种方法来创建条件条形图作为 gt
table(tables 包的精彩语法)的一部分。在 DT
的 datatable
中似乎是可能的,如此处 DT
中生成此图像的代码。不过,我正在寻找 gt
解决方案。
library(tidyverse)
library(DT)
# custom function that uses CSS gradients to make the kind of bars I need
color_from_middle <- function (data, color1,color2)
{
max_val=max(abs(data))
JS(sprintf("isNaN(parseFloat(value)) || value < 0 ? 'linear-gradient(90deg, transparent, transparent ' + (50 + value/%s * 50) + '%%, %s ' + (50 + value/%s * 50) + '%%,%s 50%%,transparent 50%%)': 'linear-gradient(90deg, transparent, transparent 50%%, %s 50%%, %s ' + (50 + value/%s * 50) + '%%, transparent ' + (50 + value/%s * 50) + '%%)'",
max_val,color1,max_val,color1,color2,color2,max_val,max_val))
}
mtcars %>%
rownames_to_column() %>%
select(rowname, mpg) %>%
head(10) %>%
mutate(mpg = (mpg - 20) %>% round) %>%
datatable() %>%
formatStyle(
"mpg",
background = color_from_middle(mtcars$mpg,'red','green')
)
tab_bar
会将条形添加到指定的列。它将值缩放到 0
和 100
之间。 0
的值映射到 50
。
tab_style
用于在每个值上设置背景渐变。
library(tidyverse)
library(gt)
tab_bar <- function(data, column) {
vals <- data[['_data']][[column]]
scale_offset <- (max(vals) - min(vals)) / 2
scale_multiplier <- 1 / max(abs(vals - scale_offset))
for (val in unique(vals)) {
if (val > 0) {
color <- "lightgreen"
start <- "50"
end <- ((val - scale_offset) * scale_multiplier / 2 + 1) * 100
} else {
color <- "#FFCCCB"
start <- ((val - scale_offset) * scale_multiplier / 2 + 0.5) * 100
end <- "50"
}
data <-
data %>%
tab_style(
style = list(
css = glue::glue("background: linear-gradient(90deg, transparent, transparent {start}%, {color} {start}%, {color} {end}%, transparent {end}%);")
),
locations = cells_body(
columns = column,
rows = vals == val
)
)
}
data
}
这是 mtcars
。
out <-
mtcars %>%
rownames_to_column() %>%
select(rowname, mpg) %>%
head(10) %>%
mutate(mpg = (mpg - 20) %>% round) %>%
gt()
out %>%
cols_width(vars(mpg) ~ 120) %>%
tab_bar(column = "mpg")
也允许多列。
library(tidyverse)
library(gt)
tab_bar <- function(.data, .columns = .data[["_data"]] %>% select_if(is.numeric) %>% names(), .col_neg = "#FFCCCB", .col_pos = "lightgreen"){
for (column in .columns){
vals <- .data[['_data']][[column]]
scale_multiplier <- 50/abs(max(vals) - min(vals))
for (val in setdiff(unique(vals), 0)) {
if (val > 0) {
color <- .col_pos
start <- "50"
end <- 50 + val * scale_multiplier + 2
} else if (val < 0) {
color <- .col_neg
start <- 50 + val * scale_multiplier - 2
end <- "50"
}
.data <-
.data %>%
tab_style(
style = list(
css = glue::glue("background: linear-gradient(90deg, transparent, transparent {start}%, {color} {start}%, {color} {end}%, transparent {end}%);")
),
locations = cells_body(
columns = column,
rows = vals == val
)
)
}
}
.data
}
map(
set_names(letters[1:5]),
~runif(10, -1, 1)
) %>%
as_tibble() %>%
gt() %>%
tab_bar()