Generate a progressive bar chart within table (like in Excel)?

Question

Supposed I have a table like this:

    df <- structure(list(ticker = c("AAPL", "MSFT", "AMZN", "NVDA"), high = c("182.94", 
"349.67", "3,773.08", "346.47"), current = c(170.7, 308, 2885, 
231.4), Off_by = c(-7, -14, -31, -50)), class = "data.frame", row.names = c(NA, 
-4L))

Is it possible to generate a table like this in R?

Basically, it is a color progressive bar that shows the magnitude with text. I don't need to gradient effect although that would be nice.

Thanks.

Answer 1

You can use gt package developed by RStudio team together with gtExtras (not yet on CRAN). Be careful to replace the commas that act as decimal separators.

library(gt)
# remotes::install_github("jthomasmock/gtExtras")
library(gtExtras)

df <- structure(list(ticker = c("AAPL", "MSFT", "AMZN", "NVDA"), 
                     high = c("182.94", "349.67", "3,773.08", "346.47"), 
                     current = c(170.7, 308, 2885, 231.4)))
df <- as.data.frame(df)
df$high <- gsub(",", "", df$high)
df$high <- as.numeric(df$high)
df$Off_by <- round((df$high - df$current) /df$current, 3) 

gt::gt(df) %>%
  gtExtras::gt_plt_bar(column = Off_by, keep_column = TRUE, color = "red", scale_type = "percent")

Answer 2

You can also use {kableExtra}, which I personally prefer for tables. (Very opinionated). This allows you to add images. It seems a bit verbose, but the advantage is you can basically add what you want - including the desired gradient fill :)

library(kableExtra)
library(tidyverse)

df <- structure(list(ticker = c("AAPL", "MSFT", "AMZN", "NVDA"), high = c("182.94", 
                                                                          "349.67", "3,773.08", "346.47"), current = c(170.7, 308, 2885, 
                                                                                                                       231.4), Off_by = c(-7, -14, -31, -50)), class = "data.frame", row.names = c(NA, 
                                                                                                                                                                                                   -4L))

## Need a hacky factor for making the bars long enough to cover the labels
hack <- 2.5
## that's for the gradient, inspired by Alan https://stackoverflow.com/a/61777415/7941188
grad_df <- data.frame(
  xintercept = seq(-100 * hack, 0, length.out = 2000),
  alpha = seq(0.3, 0, length.out = 2000)
)
inline_bars <-
  df %>%
  ## need to make sure the plots are in the right order
  mutate(ticker = fct_inorder(ticker)) %>%
  group_split(ticker) %>%
  map(~ ggplot(.x, aes(x = Off_by * hack, y = "")) +
    geom_col(fill = "darkred") +
    geom_text(aes(x = 0, label = paste0(Off_by, "%")),
      hjust = 1, color = "white",
      ## the size is chosen because you will have 50points, and this will just nearly
      ## fill an inch (your chosen file size)
      size = 5 * 50 / 14
    ) +
    ## important to have the same limits for every plot
    coord_cartesian(xlim = c(-100, 0), clip = "off") +
    ## for the gradient
    geom_vline(
      data = grad_df, mapping = aes(xintercept = xintercept, alpha = alpha),
      color = "white"
    ) +
    theme_void() +
    theme(legend.position = "none"))

map(1:4, function(i) {
  ggsave(
    filename = paste0(df$ticker[i], ".png"),
    plot = inline_bars[[i]], height = 1, dpi = 300
  )
})

ls_inline_plots <- file.path(getwd(), paste0(df$ticker, ".png"))

df %>%
  ## remove cell content for the plot
  mutate(Off_by = "") %>%
  kbl(booktabs = TRUE) %>%
  kable_paper(full_width = FALSE) %>%
  column_spec(4, image = spec_image(ls_inline_plots, width = 200, height = 50)) %>%
  ## RStudio preview does not always show the images, but the final html file shows them
  cat(., file = "tbl.html")

This results in a html that looks like:

_{My apologies, I'd rather post this with the reprex package, but I don't know how to use it with kableExtra in this case. It should hopefully still be reproducible.}