在表格中生成渐进条形图（就像在 Excel 中一样）？

Question

假设我有一个这样的表：

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

R 中可以生成这样的表吗？

基本上，它是一个颜色渐进条，用文本显示幅度。我不需要渐变效果，尽管那会很好。

谢谢。

Answer 1

您还可以使用 {kableExtra}，我个人更喜欢将其用于表格。（非常固执己见）。这允许您添加图像。这看起来有点冗长，但优点是你基本上可以添加你想要的东西 - 包括所需的渐变填充:)

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 /sf/answers/4324419081/
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")

这会生成一个如下所示的 html：

_{抱歉，我宁愿将其与 reprex 包一起发布，但在这种情况下我不知道如何将它与 kableExtra 一起使用。希望它仍然可以重现。}

Answer 2

您可以使用gtRStudio 团队开发的包gtExtras（尚未在 CRAN 上）。请小心替换充当小数分隔符的逗号。

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