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。