条件条作为HTML表的一部分 [英] Conditional bars as part of an HTML table

问题描述

我正在寻找一种创建条件条形图的方法，该条件条形图是 gt 表（表包的奇妙语法）的一部分。似乎在 DT 的数据表中是可能的，如

  library（tidyverse）
库（DT）
 
＃使用CSS渐变来制作条形的自定义函数需要
 color_from_middle<-函数（数据，color1，color2）
 {
 max_val = max（abs（data））
 JS（sprintf（ isNaN（parseFloat（value ））||值<0？'线性梯度（90deg，透明，透明'+（50 + value /％s * 50）+'%%，％s'+（50 + value /％s * 50） +'%%，％s 50 %%，透明50 %%）'：'线性渐变（90度，透明，透明50 %%，％s 50 %%，％s'+（50 + value /％s * 50）+'%%，透明'+（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）％>％回合）％&％;％
 datatable（）％&％;％
 formatStyle（
" mpg" ;, 
 background = color_from_middle（mtcars $ mpg，'red'，'green'）
）
  

解决方案

tab_bar 会将条形添加到指定的列。它将值缩放到 0 和 100 之间。 0 的值映射到 50 。

tab_style 用于在每个值上设置背景渐变。

  library（tidyverse）
库（gt）
 
 tab_bar<-函数（数据，列）{
 vals<-data [['_ data']] [[column]] 
 
 scale_offset<--（max（vals）-min（vals））/ 2 
 scale_multiplier<--1 / max（abs（vals-scale_offset））
 
 for（val （如果值（val＞ 0）{
 color<- lightgreen； 
开始<- 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 
} 
 
数据<-
数据％&％;％
 tab_style（
 style = list（
 css =胶水:: glue （背景：线性渐变（90度，透明，透明{start}％，{color} {start}％，{color} {end}％，透明{end}％）；）
） ，
位置= cells_body（
列=列，
行= vals == val 
）
）
} 
 
数据
} 
  

此处是 mtcars 。

  out<-
 mtcars％>％
 rownames_to_column（）％>％
 select（行名，mpg）％>％
 head（10）％>％
 mutate（mpg =（mpg-20）％>％舍入）％&％;％
 gt（） 
 
 out％>％
 cols_width（vars（mpg）〜120）％&％;％
 tab_bar（column = mpg）
  

I am looking for a way to create a conditional bar plot as part of a gt table (the wonderful grammar of tables package). It seems to be possible in DT's datatable as shown here styleColorBar Center and shift Left/Right dependent on Sign. Here is an image of what I want and below is code to generate this image in DT. I am looking for a gt solution though.

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 will add the bars to the specified column. It scales the values to be between 0 and 100. Values of 0 get mapped to 50.

tab_style is used to on each of the values to set the background gradient.

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
}

Here it is with 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")

这篇关于条件条作为HTML表的一部分的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！