Two-color color_bar in R formattable

Question

I have a column that is the sum of two other columns. I'm trying to get a color_bar formatter with two colors, each width representing the individual numbers. I tried augmenting the color-bar code by adding another color_bar. The idea was the big bar would be the sum column. Then, I just needed another bar to be one of the individual numbers and I have my bar with two colors.

Couple of problems: Mainly, when I remove the variable before the ~ and place a the column in the width block, R doesn't seem to understand the reference. Two, when I just try to see if it's possible to have two color blocks, by adjusting the height of the second block, only the second block is displayed. I've put the code below.

Let me know if anyone has any tips, ideas, or solutions. I'm open to alternative ideas to display how the two individual columns sum up to the total column. As I'm typing, maybe a pie sparkline?

Here's the code:

#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

I've wanted to do the same thing for a while, so here's at least one solution. Rather than trying to get formattable() to recognize two or more separate columns, the relevant columns are concatenated into a single character variable. The various CSS and formatting functions then parse those strings accordingly.

The maximum width is hard-coded here (= 300px), so you'd probably want to make that reactive.

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

The CSS formatting was inspired by this answer.