能否将ggplot的图例和表格合并呢？

Question

能否将ggplot的图例和表格合并呢？

9

我想知道是否有一种方法可以将表格和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))

- reidj

2

(1) 我还没有找到在图例中实现这一点的方法，我经常想要同样的功能。我的（不太好的）解决方法是将列制作成每行一个字符串，并显示“简单”的图例，但是没有对齐（也不好看）。但是，您可以使用GGally :: ggtable创建表格并使用patchwork轻松拼合它们。 (2) 如果缺少这个，您的问题将受益于可重现性。祝你好运！ - r2evans

1

如何在具有不同线条的图表中添加图例、包含数据值的表格？ - tjebo

1

@tjebo，那是来自“signal”库的内容。我已更新代码以包括它。 - reidj

5个回答

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)

^{使用reprex包（v2.0.1）于2021年12月31日创建}

- tjebo

1

感谢你的反馈。我已经添加了必要的代码，用于生成可重现的示例。我对此还有些陌生，没有意识到使用dput()可以将数据框输出为代码。这使得生成示例比我预期的要简单得多。我喜欢你的方法，最终我使用了类似的方法，尽管它也存在着你提到的相同限制。完成后我会发布它。 - reidj

1

这正是我想要实现的。很遗憾没有更简单/自动化的方法来完成这个任务，但通过一些试错，这对我的目的来说已经足够了。谢谢。 - reidj

这是我迄今为止一直在使用的方法，但@dww提供了一个解决方案，可以避免必须单独定位图例键和表格的问题。目前我已将其标记为接受的答案。 - reidj

1

@reidj 不用担心！我对自己的解决方案并不是很满意（尽管结果看起来不错）- 所以才设置了悬赏。我觉得我们现在有一些很好的选择可以挑选 :) - tjebo

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

我们可以编写以下函数将图例键放入表格中。由于gtable和grid代码通常不太优雅，因此它有点笨重，但应该能够完成工作。默认情况下，它将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)
}

最后，我们可以按照以下方式将表格添加到我们喜欢的绘图组合软件中。请注意，图例和表格的文本大小不匹配，因此我已将图例文本大小设置为与表格相匹配的大小。自然地，在我们捕获的表格中删除图例后，图表看起来更好。

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

我不知道当图例大于1个时，或者tableGrob()有其他选项打开或关闭时，这种方法是否仍然适用，因为这是我第一次使用该函数。

- teunbrand

1

没问题，我不贪心积分 :) - teunbrand

4

我的解决方案可能不完全符合您的要求，但它传达了信息，并且在处理不同数量的线条图形时会更容易。我用线条的颜色为框框着色，而不是添加彩色线条。

注：图例保留以显示线条颜色和填充框之间的对应关系。

完整代码：

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)

# Change cells to match the line colours
  # Id the colour codes
    color_range <- RColorBrewer::brewer.pal(8, "Dark2") # Find the colours being used in the graph 
  
  # Function to find the cell in a tableGrob
    find_cell <- function(table, row, col, name="core-fg"){
      l <- table$layout
      which(l$t==row & l$l==col & l$name==name)
    }
  
  # Fill the cells with the appropriate colour
    for(i in 1:nrow(summary.table)) {
      cell_ref <- find_cell(table, i+1, 3, "core-bg")
      table$grobs[cell_ref][[1]][["gp"]] <- grid::gpar(fill=color_range[nrow(summary.table)+1-i], col = color_range[nrow(summary.table)+1-i], lwd=5)
    }


#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_minimal() +
  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))

- Tech Commodities

这是另一个不错的选择 - 你为什么选择 brewer.pal(8,...)？我认为 "6" 更合适，不是吗？选择编程方法是否更安全，例如 length(unique(full.data$N))？ - tjebo

这是为了从调色板中提取所有颜色，尽管6或变量方法同样有效。 - Tech Commodities

1

另一个想法，对于那些熟悉 grid 的人来说，应该可以将彩色线条添加到表格 grob 中。帮助页面 https://cran.r-project.org/web/packages/gridExtra/vignettes/tableGrob.html 中有一个示例。 - Tech Commodities

3

我建议将图和表分别定义，然后将它们拼合起来。为了获取表格颜色，您可以从ggplot对象中提取scale_color_brewer值，并动态定义您的表格主题。使用您喜欢的多图形工具（例如gridExtra::grid.arrange()）进行拼合。

这个答案和上面的答案(https://dev59.com/JsPra4cB1Zd3GeqPaS67#70581378)的区别是我直接从ggplot对象中提取比例颜色来定义相应表格的颜色。这确保了颜色匹配，理论上您可以在多个比例尺/图例中使用此方法。

你需要典型的ggplot图例吗？或者仅着色单元格背景就足够了？编辑：我更新了我的答案，展示了如何使用unicode符号来近似ggplot图例。

library(ggplot2)
library(gridExtra)
library(signal)

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

#plot
p <- 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 = ldata, 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") +
  theme_bw() +
  theme(legend.position = "none")

# Get scale data from ggplot object
pb <- ggplot_build(p)
scale_cols <- unique(pb$data[[3]][,c("colour", "group")])
table2 <- merge(table, scale_cols, by.x = "N", by.y = "group", sort = FALSE)
table2$N2 <- "\u2015"
table2 <- table2[,c("N", "N2", "Prb FR", "Prb ED", "colour")]

# Define vectors of fills and colors for table
fills <- c(table2$colour, rep("grey90", nrow(table2)*4))
cols <- c(rep("black", nrow(table2)*1), table2$colour, rep("black", nrow(table2)*3))
bgcols <- c(rep("white", nrow(table2)*5))
tt <- ttheme_default(core=list(bg_params = list(fill=fills, col=bgcols), fg_params = list(col=cols)))
t <- tableGrob(table2, theme = tt, rows = NULL)

# Combine plot and table
grid.arrange(p, t[,c(1:4)], nrow = 1, ncol = 2, widths=c(2,0.5))

- Skaqqs

1

只是简单地浏览了一下代码并点赞；但是能否提供一些指针，说明这与此答案 https://dev59.com/JsPra4cB1Zd3GeqPaS67#70581378 有何不同，那就更好了。 - tjebo

感谢您的评论，我很感激您的反馈。我添加了一句话来指出差异。据您看，您认为我的回答的某个版本最好作为该回答的评论吗？我仍在学习如何最好地为该网站做出贡献。 - Skaqqs

我认为只要你能清楚地指出差异，那么每个投票者就可以决定是否值得为他们投上一票。 - tjebo

有些人在评论中写出了惊人的答案，这也是令人难过的，因为评论很容易被删除而不留痕迹，而且它也不够显眼，不能被“接受”。 - tjebo

1

即使在这里待了几年，决定做什么最好并不总是容易的 :) - tjebo

1

明白了 - 谢谢你分享你的想法！祝你好运 - Skaqqs

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- dww · Accepted Answer

一个简单的方法是使用图例标签本身作为表格。在这里，我演示了使用knitr::kable自动格式化表格列宽的方法：

library(knitr)
table = summary.table %>%
  rename(`Prb FR` = prob.fr, `Prb ED` = prob.ed.n) %>%
  kable %>%
  gsub('|', ' ', ., fixed = T) %>%
  strsplit('\n') %>%
  trimws
header = table[[1]]
header = paste0(header, '\n', paste0(rep('─', nchar(header)), collapse =''))
table = table[-(1:2)]
table = do.call(rbind, table)[,1]
table = data.frame(N=summary.table$N, lab = table)
  
plot_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))
  }) %>%
  left_join(table)

ggplot(plot_data, aes(x = error, y = prob.ed.n, group = N, colour = lab)) +
  geom_line() +
  guides(color = guide_legend(header, reverse=TRUE, 
                              label.position = "left", 
                              title.theme = element_text(size=8, family='mono'),
                              label.theme = element_text(size=8, family='mono'))) +
  theme(
    legend.key = element_rect(fill = NA, colour = NA),
    legend.spacing.y = unit(0, "pt"),
    legend.key.height = unit(10, "pt"),
    legend.background = element_blank())