是否可以将 ggplot 图例和表格结合起来

Question

是否可以将 ggplot 图例和表格结合起来

我想知道是否有人知道如何组合表格和 ggplot 图例，以便图例显示为表格中的一列，如图所示。很抱歉，如果之前有人问过这个问题，但我无法找到一种方法来做到这一点。

编辑：附加的是生成下面输出的代码（减去我正在尝试生成的图例/表格组合，因为我在 Powerpoint 中将其缝合在一起）

library(ggplot2)
library(gridExtra)
library(dplyr)
library(formattable)
library(signal)

#dataset for ggplot
full.data <- structure(list(error = c(0, 1, 2, 3, 4, 5, 6, 0, 1, 2, 3, 4, 
5, 6, 0, 1, 2, 3, 4, 5, 6, 0, 1, 2, 3, 4, 5, 6, 0, 1, 2, 3, 4, 
5, 6, 0, 1, 2, 3, 4, 5, 6), prob.ed.n = c(0, 0, 0.2, 0.5, 0.8, 
1, 1, 0, 0, 0.3, 0.7, 1, 1, 1, 0, 0.1, 0.4, 0.9, 1, 1, 1, 0, 
0.1, 0.5, 0.9, 1, 1, 1, 0, 0.1, 0.6, 1, 1, 1, 1, 0, 0.1, 0.6, 
1, 1, 1, 1), N = c(1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 
3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 
6, 6, 6, 6, 6, 6, 6)), row.names = c(NA, -42L), class = "data.frame")

#summary table 
summary.table <- structure(list(prob.fr = c("1.62%", "1.35%", "1.09%", "0.81%", "0.54%", "0.27%"), prob.ed.n = c("87.4%", "82.2%", "74.8%", "64.4%", "49.8%", "29.2%"), N = c(6, 5, 4, 3, 2, 1)), row.names = c(NA, 
-6L), class = "data.frame")

#table object to beincluded with ggplot
table <- tableGrob(summary.table %>%
            rename(
              `Prb FR` = prob.fr,
              `Prb ED` = prob.ed.n,
            ), 
          rows = NULL)
#plot
plot <- ggplot(full.data, aes(x = error, y = prob.ed.n, group = N, colour = as.factor(N))) +
  geom_vline(xintercept = 2.45, colour = "red", linetype = "dashed") +
  geom_hline(yintercept = 0.9, linetype = "dashed") +
  geom_line(data = full.data %>%
              group_by(N) %>%
              do({
                tibble(error = seq(min(.$error), max(.$error),length.out=100),
                       prob.ed.n = pchip(.$error, .$prob.ed.n, error))
              }),
            size = 1) +
  scale_x_continuous(labels = full.data$error, breaks = full.data$error, expand = c(0, 0.05)) +
  scale_y_continuous(expand = expansion(add = c(0.01, 0.01))) +
  scale_color_brewer(palette = "Dark2") +
  guides(color = guide_legend(reverse=TRUE, nrow = 1)) +
  theme_bw() +
  theme(legend.key = element_rect(fill = "white", colour = "black"),
        legend.direction= "horizontal",
        legend.position=c(0.8,0.05)
)

#arrange plot and grid side-by-side
grid.arrange(plot, table, nrow = 1, widths = c(4,1))

Run Code Online (Sandbox Code Playgroud)

Answer 1

Tje*_*ebo 8

这是一个有趣的问题。简短的回答：是的，这是可能的。但我没有看到对表格和图例的位置进行硬编码的方法，这很丑陋。

下面的建议需要在三个地方进行硬编码。我使用 {ggpubr} 作为表格，使用 {cowplot} 作为拼接。

~~另一个问题源于垂直图例的图例键间距。据我所知，对于除多边形之外的其他键来说，这仍然是一个尚未解决的问题。相关的 GitHub 问题已关闭~~图例间距不再是问题。问问 teunbrand，他就知道答案。

代码中其他一些相关注释。

library(tidyverse)
library(ggpubr)
library(cowplot)
#> 
#> Attaching package: 'cowplot'
#> The following object is masked from 'package:ggpubr':
#> 
#>     get_legend

full.data <- structure(list(error = c(
  0, 1, 2, 3, 4, 5, 6, 0, 1, 2, 3, 4,
  5, 6, 0, 1, 2, 3, 4, 5, 6, 0, 1, 2, 3, 4, 5, 6, 0, 1, 2, 3, 4,
  5, 6, 0, 1, 2, 3, 4, 5, 6
), prob.ed.n = c(
  0, 0, 0.2, 0.5, 0.8,
  1, 1, 0, 0, 0.3, 0.7, 1, 1, 1, 0, 0.1, 0.4, 0.9, 1, 1, 1, 0,
  0.1, 0.5, 0.9, 1, 1, 1, 0, 0.1, 0.6, 1, 1, 1, 1, 0, 0.1, 0.6,
  1, 1, 1, 1
), N = c(
  1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2,
  3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5,
  6, 6, 6, 6, 6, 6, 6
)), row.names = c(NA, -42L), class = "data.frame")

summary.table <-
  structure(list(
    prob.fr = c("1.62%", "1.35%", "1.09%", "0.81%", "0.54%", "0.27%"),
    prob.ed.n = c("87.4%", "82.2%", "74.8%", "64.4%", "49.8%", "29.2%"),
    N = c(6, 5, 4, 3, 2, 1)
  ), row.names = c(NA, -6L), class = "data.frame")

## Hack 1 - create some space for the new legend
spacer <- paste(rep(" ", 6), collapse = "")
my_table <-
  summary.table %>%
  mutate(N = paste(spacer, N))

p1 <-
  ggplot(full.data, aes(x = error, y = prob.ed.n, group = N, colour = as.factor(N))) +
  geom_vline(xintercept = 2.45, colour = "red", linetype = "dashed") +
  geom_hline(yintercept = 0.9, linetype = "dashed") +
  geom_line(
    data = full.data %>%
      group_by(N) %>%
      do({
        tibble(
          error = seq(min(.$error), max(.$error), length.out = 100),
          prob.ed.n = signal::pchip(.$error, .$prob.ed.n, error)
        )
      }),
    size = 1
  ) +
  ## remove the legend labels. You have them in the table already.
  scale_color_brewer(NULL, palette = "Dark2", labels = rep("", length(unique(full.data$N)))) +
  ## remove all the legend specs! I've also removed the not so important reverse scale
  ## I have removed fill and color to make it aesthetically more pleasing
  theme(
    legend.key = element_rect(fill = NA, colour = NA),
    ## hack 2 - hard code legend key spacing
    legend.spacing.y = unit(1.8, "pt"),
    legend.background = element_blank()
  ) +
  ## make y spacing work
  guides(color = guide_legend(byrow = TRUE))

## create the plot elements
p_leg <- cowplot::get_legend(p1)
p2 <- ggtexttable(my_table, rows = NULL)
## we don't want the legend twice
p <- p1 + theme(legend.position = "none")

## hack 3 - hard code the plot element positions
ggdraw(p, xlim = c(0, 1.7)) +
  draw_plot(p2, x = .8) +
  draw_plot(p_leg, x = .97, y = 0.975, vjust = 1)

Run Code Online (Sandbox Code Playgroud)

^{由reprex 包于 2021 年 12 月 31 日创建(v2.0.1)}

Answer 2

dww*_*dww 8

一种简单的方法是使用图例标签本身作为表格。这里我演示如何knitr::kable自动设置表格列宽的格式：

\n

library(knitr)\ntable = summary.table %>%\n  rename(`Prb FR` = prob.fr, `Prb ED` = prob.ed.n) %>%\n  kable %>%\n  gsub(\'|\', \' \', ., fixed = T) %>%\n  strsplit(\'\\n\') %>%\n  trimws\nheader = table[[1]]\nheader = paste0(header, \'\\n\', paste0(rep(\'\xe2\x94\x80\', nchar(header)), collapse =\'\'))\ntable = table[-(1:2)]\ntable = do.call(rbind, table)[,1]\ntable = data.frame(N=summary.table$N, lab = table)\n  \nplot_data = full.data %>%\n  group_by(N) %>%\n  do({\n    tibble(error = seq(min(.$error), max(.$error),length.out=100),\n           prob.ed.n = pchip(.$error, .$prob.ed.n, error))\n  }) %>%\n  left_join(table)\n\nggplot(plot_data, aes(x = error, y = prob.ed.n, group = N, colour = lab)) +\n  geom_line() +\n  guides(color = guide_legend(header, reverse=TRUE, \n                              label.position = "left", \n                              title.theme = element_text(size=8, family=\'mono\'),\n                              label.theme = element_text(size=8, family=\'mono\'))) +\n  theme(\n    legend.key = element_rect(fill = NA, colour = NA),\n    legend.spacing.y = unit(0, "pt"),\n    legend.key.height = unit(10, "pt"),\n    legend.background = element_blank())\n

Run Code Online (Sandbox Code Playgroud)\n

\n

Answer 3

teu*_*and 5

假设我们有以下绘图，为了简洁起见，该图从示例代码中进行了简化，并具有垂直图例。

library(ggplot2)
library(gridExtra)
library(dplyr)
library(formattable)
library(signal)


# Omitted full code, same as in question
# full.data <- structure(...)
# summary.table <- structure(...)
# table <- tableGrob(...)

# Simplified plot
plot <- ggplot(full.data, aes(x = error, y = prob.ed.n, group = N, colour = as.factor(N))) +
  geom_line(data = full.data %>%
              group_by(N) %>%
              do({
                tibble(error = seq(min(.$error), max(.$error),length.out=100),
                       prob.ed.n = pchip(.$error, .$prob.ed.n, error))
              }),
            size = 1) +
  guides(color = guide_legend(reverse=TRUE)) +
  theme(legend.key = element_rect(fill = "white", colour = "black"))

plot

Run Code Online (Sandbox Code Playgroud)

我们可以编写以下函数将图例键放入表中。它有点笨拙，因为 gtable 和网格代码通常不是很优雅，但它应该可以完成工作。tableGrob默认情况下，它用第一个图例的键替换输出中的最后一列。

请注意，这仅处理垂直图例，而不处理水平图例。此外，假设表格和图例按其自然顺序组合在一起有点天真：它不进行任何花哨的标签匹配，并假设表格和图例中的顺序相同。

library(grid)
library(gtable)

#' @param tableGrob The output of the `gridExtra::tableGrob()` function.
#' @param plot A ggplot2 object with a single, vertical legend
#' @param replace_col An `integer(1)` with the column number in the 
#'   table to replace with keys. Defaults to the last one.
#' @param key_padding The amount of extra space to surround keys with,
#'   as a `grid::unit()` object.
#'
#' @return A modified version of the `tableGrob` argument
add_legend_column <- function(
  tableGrob, 
  plot,
  replace_col = ncol(tableGrob),
  key_padding = unit(5.5, "pt")
) {
  
  # Getting legend keys
  keys <- cowplot::get_legend(plot)
  keys <- keys$grobs[[which(keys$layout$name == "guides")[1]]]
  keys <- gtable_filter(keys, 'label|key')
  idx  <- unique(keys$layout$t)
  keys <- lapply(idx, function(i) {
    x <- keys[i, ]
    # Set justification of keys
    x$vp$x <- unit(0.5, "npc")
    x$vp$justification <- x$vp$valid.just <- c(0.5, 1)
    # Set key padding
    x <- gtable_add_padding(x, key_padding)
    x
  }) 
  if (nrow(table) != length(keys) + 1) {
    stop("Keys don't fit in the table")
  }
  
  # Measure keys
  width  <- max(do.call(unit.c, lapply(keys, grobWidth)))
  width  <- max(width, table$widths[replace_col])
  height <- do.call(unit.c, lapply(keys, grobHeight))
  
  # Delete foreground content of the column to replace
  drop <- table$layout$l == replace_col & table$layout$t != 1
  drop <- drop & endsWith(table$layout$name, "-fg")
  table$grobs  <- table$grobs[!drop]
  table$layout <- table$layout[!drop, ]
  
  # Add keys to table
  table <- gtable_add_grob(
    table, keys, name = "key",
    t = seq_along(keys) + 1, 
    l = replace_col
  )
  
  # Set dimensions
  table$widths[replace_col] <- width
  table$heights[-1] <- unit.pmax(table$heights[-1], height)
  
  return(table)
}

Run Code Online (Sandbox Code Playgroud)

最后，我们可以将表格添加到我们最喜欢的绘图组合包中，如下所示。请注意，图例和表格的文本大小不匹配，因此我将图例文本大小设置为与表格的文本大小相匹配。当然，删除我们在表中捕获的图例后，绘图看起来会更好。

library(patchwork)
#> 
#> Attaching package: 'patchwork'
#> The following object is masked from 'package:formattable':
#> 
#>     area

(plot + theme(legend.position = "none")) + 
  add_legend_column(table, plot + theme(legend.text = element_text(size = 12)))

Run Code Online (Sandbox Code Playgroud)

我不知道当绘图有 > 1 个图例或tableGrob()打开或关闭其他选项时，这概括得有多好，这是我第一次使用此功能。

归档时间：	4 年，4 月前
查看次数：	1849 次
最近记录：	4 年，4 月前