Двухцветная color_bar в R formattable

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.