条件条作为HTML表的一部分

雅各布·诺沃特尼

我正在寻找一种方法来创建条件条形图作为gt表的一部分(表包的奇妙语法)。这似乎是可能的DTdatatable,如下所示styleColorBar中心和换档左/右依赖于符号这是我想要的图像,下面是在中生成此图像的代码DT我正在寻找gt解决方案。

带栏的html表

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

情节

本文收集自互联网,转载请注明来源。

如有侵权,请联系 [email protected] 删除。

编辑于
0

我来说两句

0 条评论
登录 后参与评论

相关文章