条件条作为HTML表的一部分

问题描述

我正在寻找一种方法来创建条件条形图作为gt表的一部分（表包的奇妙语法）。如styleColorBar Center and shift Left/Right dependent on Sign所示，在DT的{​​{1}}中似乎是有可能的。这是我想要的图像，下面是在datatable中生成该图像的代码。我正在寻找DT解决方案。

gt

解决方法

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