Feature request: conditional barplot

[novotny1akub]

This is a really good package. Have you considered adding a possibility to have a "conditional barplot"? Something along these lines:

library(tidyverse)
library(gt)

tab_bar <- function(.data, .columns = .data[["_data"]] %>% select_if(is.numeric) %>% names(), .col_neg = "#FFCCCB", .col_pos = "lightgreen"){

  for (column in .columns){
    vals <- .data[['_data']][[column]]

    scale_multiplier <- 50/abs(max(vals) - min(vals))

    for (val in setdiff(unique(vals), 0)) {
      if (val > 0) {
        color <- .col_pos
        start <- "50"
        end <- 50 + val * scale_multiplier + 2
      } else if (val < 0) {
        color <- .col_neg
        start <- 50 + val * scale_multiplier - 2
        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
}

map(
  set_names(letters[1:2]),
  ~runif(10, -1, 1)
) %>%
  as_tibble() %>%
  gt() %>%
  tab_bar(.columns = c("a", "b"))

[jthomasmock]

Howdy!

Thanks for the FR. I'll think about this one.

Just as a note, a similar output is currently possible via the gt_plt_bar() function as seen in the below reprex:

library(tidyverse)
library(gt)
library(gtExtras)

set.seed(37)
input_df <- map(
  set_names(letters[1:2]),
  ~runif(10, -1, 1)
) %>%
  as_tibble() 

input_df %>%
  gt() %>% 
  gt_duplicate_column(a) %>% 
  gt_plt_bar(column = a, color = ifelse(gt_index(., a) >= 0, "blue", "red"), 
             accuracy = 0.1, scale_type = "number") %>% 
  gtsave("ex.png")

^{Created on 2021-10-11 by the reprex package (v2.0.1)}

[novotny1akub]

Wow, this is great. I was not aware.