R格式中的双色color_bar

Question

我有一列是另外两列的总和。我试图用两种颜色获得color_bar格式化程序，每种宽度代表单个数字。我试图通过增加另一个color_bar来增加色彩条码。这个想法是大栏是总结栏。然后，我只需要另一个酒吧作为个人号码之一，我有我的酒吧有两种颜色。

几个问题：主要是，当我在~之前删除变量并将该列放在宽度块中时，R似乎并不理解该引用。二，当我试图看看是否可以有两个色块时，通过调整第二个块的高度，只显示第二个块。我已经把代码放在下面。

让我知道是否有人有任何提示，想法或解决方案。我愿意提供其他想法来展示两个单独列与总列的对比情况。在我打字的时候，也许是一个派对迷你？

下面的代码：

#Make a formattable with a dual color bar 

#Packages 
library(dplyr) 
library(formattable) 

#Function 
#Ideally, I'd like it to be a function, but can't visualize how to do it. 
dualbar <- function(bar1 = "lightgray", bar2 = "lightblue", 
        fun = "comma", digits = 0) { 

    fun <- match.fun(fun) 
    formatter("span", x ~ fun(x, digits = digits), 
      style = y ~ style(
       display = "inline-block", 
       direction = "rtl", 
       "border-radius" = "4px", 
       "padding-right" = "2px", 
       "background-color" = csscolor(bar1), 
       width = percent(proportion(as.numeric(y), na.rm = TRUE))), 
      style = z ~ style(
       display = "inline-block", 
       direction = "rtl", 
       "border-radius" = "4px", 
       "padding-right" = "2px", 
       "background-color" = csscolor(bar2), 
       width = percent(proportion(as.numeric(z), na.rm = TRUE)), 
       height = "10px") 
      ) 
} 

#Generate Data 
set.seed(1234) 
df <- data.frame(month = month.name[1:12], 
       valx = runif(12, 0, 5), 
       valy = runif(12, 2, 7)) 
df$total <- df$valx + df$valy 

tab <- df %>% 
    formattable(list(area(row = 1:12, col = 2) ~ 
        formatter("span", x ~ comma(x, digits = 0), 
           style = y ~ style(
           display = "inline-block", 
           direction = "rtl", 
           "border-radius" = "4px", 
           "padding-right" = "2px", 
           "background-color" = csscolor("lightgray"), 
           width = percent(proportion(as.numeric(y), na.rm = TRUE))), 
           z ~ style(
           display = "inline-block", 
           direction = "rtl", 
           "border-radius" = "4px", 
           "padding-right" = "2px", 
           "background-color" = csscolor("lightblue"), 
           width = percent(proportion(as.numeric(z), na.rm = TRUE))) 
       ))) %>% 
    select(-valx, -valy) %>% 
    formattable::as.htmlwidget() 

tab 

Answer 1

我想做同样的事情了一会儿，所以这里的至少一个解决方案。与其试图让formattable（）识别两个或多个单独的列，相关的列连接成单个字符变量。各种CSS和格式化函数然后相应地解析这些字符串。

最大宽度在这里被硬编码（= 300px），所以你可能想要做出反应。

library(dplyr) # (>= 0.7.0) 
library(formattable) 
library(glue) 
library(stringr) 
library(tidyr) 
library(scales) 

set.seed(1234) 
df <- data.frame(month = month.name[1:12], 
      valx = runif(12, 0, 5), 
      valy = runif(12, 2, 7)) 
df$total <- df$valx + df$valy 


extr <- function(v, n, size = 6){ 
    str_split_fixed(v, "_", size)[,n] %>% as.double 
} 

lblue <- csscolor(col2rgb("lightblue")) 
lgray <- csscolor(col2rgb("lightgray")) 

df %>% mutate(orders = row_number()) %>% 
    mutate_if(is.double, funs(lbl = round(., 0))) %>% 
    gather(key = item, value = score, valx:total) %>% 
    mutate(score = rescale(score, to = c(0,300)), 
     score = round(score, 0), 
     item = factor(item, levels = c("valx", "valy", "total"))) %>% 
    spread(key = item, value = score) %>% 
    arrange(orders) %>% 
    mutate(vals = str_c(valx, "_", valy, "_", total, "_", valx_lbl, "_",  
     valy_lbl, "_", total_lbl)) %>% 
    select(month, vals) %>% 
    formattable(align = "l", list(
    vals = formatter("span", 
       style = x ~ style(
        display = "inline-block", 
        direction = "ltr", 
        "border-radius" = "4px", 
        "padding-right" = "2px", 
        "text-indent" = str_c(extr(x,1)-10, "px"), 
        "background-image" = glue("linear-gradient(to right, 
        {lgray}, {lgray}), linear-gradient(to right, {lblue}, {lblue})"), 
        "background-repeat" = "no-repeat", 
        "background-position" = str_c("0 0, ", extr(x,1), "px 0"), 
        "background-size" = str_c(extr(x,1), "px 100%, ", extr(x,2), "px 100%"), 
        "width" = str_c(extr(x,3), "px"), 
        "text-align" = "left", 
        "position" = "relative" 
       ), x ~ str_c(extr(x,4), "  ", str_c(extr(x,5)))) 
)) 

CSS格式的灵感来自this answer。