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

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.

CodePudding user response：

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

CodePudding user response：

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.}