向图例元素组添加注释和线段

因为@erocoar提供了grob挖掘的替代方案,所以我不得不采用创建一个类似传奇的情节的方式。

我在一个比OP更小的数据集和更简单的绘图上制定了我的解决方案,但核心问题是相同的:十个图例元素要分组和注释。我相信这种方法的主要思想可以很容易地适用于其他 geom 和 aes .

library(data.table)
library(ggplot2)
library(cowplot)

# 'original' data    
dt <- data.table(x = sample(1:10), y = sample(1:10), z = sample(factor(1:10)))

# color vector
cols <- c("1" = "olivedrab1", "2" = "olivedrab2",            # min
          "3" = "olivedrab3", "4" = "yellow", "5" = "gold2", # low
          "6" = "orange1", "7" = "orange3",                  # moderate
          "8" = "darkorange3", "9" = "red2", "10" = "red4")  # high 

# original plot, without legend
p1 <- ggplot(data = dt, aes(x = x, y = y, color = z)) +
  geom_point(size = 5) +
  scale_color_manual(values = cols, guide = FALSE)

# create data to plot the legend
# x and y to create a vertical row of points
# all levels of the variable to be represented in the legend (here z)
d <- data.table(x = 1, y = 1:10, z = factor(1:10))

# cut z into groups which should be displayed as text in legend
d[ , grp := cut(as.numeric(z), breaks = c(0, 2, 5, 7, 11),
                labels = c("min", "low", "mod", "high"))]

# calculate the start, end and mid points of each group
# used for vertical segments
d2 <- d[ , .(x = 1, y = min(y), yend = max(y), ymid = mean(y)), by = grp]

# end points of segments in long format, used for horizontal 'ticks' on the segments  
d3 <- data.table(x = 1, y = unlist(d2[ , .(y, yend)]))

# offset (trial and error)
v <- 0.3

# plot the 'legend'
p2 <- ggplot(mapping = aes(x = x, y = y)) +
  geom_point(data = d, aes(color = z), size = 5) +
  geom_segment(data = d2,
               aes(x = x + v, xend = x + v, yend = yend)) +
  geom_segment(data = d3,
               aes(x = x + v, xend = x + (v - 0.1), yend = y)) +
  geom_text(data = d2, aes(x = x + v + 0.4, y = ymid, label = grp)) +
  scale_color_manual(values = cols, guide = FALSE) +
  scale_x_continuous(limits = c(0, 2)) +
  theme_void()

# combine original plot and custom legend
plot_grid(p1,
          plot_grid(NULL, p2, NULL, nrow = 3, rel_heights = c(1, 1.5, 1)),
          rel_widths = c(3, 1))

在里面 ggplot 图例是中映射的直接结果 aes公司 . 一些小的修改可以在中完成 theme 或在中 guide_legend(override.aes . 对于进一步的定制,您必须或多或少地求助于手动“绘图”,或者通过格罗布领域的洞穴探险(例如。 Custom legend with imported images ),或通过创建作为图例添加到原始绘图的绘图(例如。 Create a unique legend based on a contingency (2x2) table in geom_map or ggplot2? ).

另一个定制传奇的例子,同样是grob hacking vs.“plotting”传奇: Overlay base R graphics on top of ggplot2 .

这是一个有趣的问题,像这样的传奇看起来很不错。没有数据,所以我只是在另一个图上进行了尝试-代码可能更通用,但这是第一步:)

首先,情节

library(ggplot2)
library(gtable)
library(grid)

df <- data.frame(
  x = rep(c(2, 5, 7, 9, 12), 2),
  y = rep(c(1, 2), each = 5),
  z = factor(rep(1:5, each = 2)),
  w = rep(diff(c(0, 4, 6, 8, 10, 14)), 2)
)

p <- ggplot(df, aes(x, y)) +
  geom_tile(aes(fill = z, width = w), colour = "grey50") +
  scale_fill_manual(values = c("1" = "red2", "2" = "darkorange3",
                               "3" = "gold2", "4" = "olivedrab3",
                               "5" = "olivedrab2"),
                    labels = c("High", "High", "High", "Low", "Low"))
p

然后使用 gtable 和 grid 图书馆。

grb <- ggplotGrob(p)

# get legend gtable
legend_idx <- grep("guide", grb$layout$name)

leg <- grb$grobs[[legend_idx]]$grobs[[1]]

# separate into labels and rest
leg_labs <- gtable_filter(leg, "label")
leg_rest <- gtable_filter(leg, "background|title|key")

# connectors = 2 horizontal lines + one vertical one
connectors <- gTree(children = gList(linesGrob(x = unit(c(0.1, 0.8), "npc"), y = unit(c(0.1, 0.1), "npc")),
                                    linesGrob(x = unit(c(0.1, 0.8), "npc"), y = unit(c(0.9, 0.9), "npc")),
                                    linesGrob(x = unit(c(0.8, 0.8), "npc"), y = unit(c(0.1, 0.9), "npc"))))

# add both .. if many, could loop this
leg_rest <- gtable_add_grob(leg_rest, connectors, t = 4, b = 6, l = 3, r = 4, name = "high.group.lines")
leg_rest <- gtable_add_grob(leg_rest, connectors, t = 7, b = 8, l = 3, r = 4, name = "low.group.lines")

# get unique labels indeces (note that in the plot labels are High and Low, not High-1 etc.)
lab_idx <- cumsum(summary(factor(sapply(leg_labs$grobs, function(x) x$children[[1]]$label))))

# add cols for extra space, then add the unique labels. 
# theyre centered automatically because i specify top and bottom, and x=0.5npc
leg_rest <- gtable_add_cols(leg_rest, convertWidth(rep(grobWidth(leg_labs$grobs[[lab_idx[1]]]), 2), "cm"))
leg_rest <- gtable_add_grob(leg_rest, leg_labs$grobs[[lab_idx[1]]], t = 4, b = 6, l = 5, r = 7, name = "label-1")
leg_rest <- gtable_add_grob(leg_rest, leg_labs$grobs[[lab_idx[2]]], t = 7, b = 8, l = 5, r = 7, name = "label-2")

# replace original with new legend
grb$grobs[[legend_idx]]$grobs[[1]] <- leg_rest

grid.newpage()
grid.draw(grb)

潜在问题包括

• 组连接器线宽取决于原始标签宽度。。有什么办法吗?
• 此处手动选择t、l、b、r坐标(但这可以使用我创建的lab\u idx进行推广)
• 由于扩展了宽度,图例被推到绘图中(我认为只需在主GTTable中添加col\u空间)