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

Question

我的 ggplot 有以下图例：

我想对我的个人图例变量进行分组，并添加组名和“括号”，如下图所示：

我的数据有 2 列：
1 - 美国各州
2 - 活动级别，范围为 10（高）- 1（低）

我也在使用数据 -
us
我的代码：

ggplot()+ geom_map(data=us, map=us,aes(x=long, y=lat, map_id=region),
                fill="#ffffff", color="#ffffff", size=0.15) +
geom_map(data=dfm4,map=us,aes(fill=ACTIVITY.LEVEL,map_id=STATENAME)
,color="#ffffff", size=0.15)+  

scale_fill_manual("Activity",
values=c("10"="red4","9"="red2","8"="darkorange3",
"7"="orange3","6"="orange1",                                        
"5"="gold2","4"="yellow","3"="olivedrab3","2"="olivedrab2",
"1"="olivedrab1"),
breaks=c("10","9","8","7","6","5","4","3","2","1"),
labels=c("High - 3","High - 2","High - 1","Moderate - 2","Moderate - 
1","Minimal - 2","Minimal - 1","Low - 3","Low - 2","Low - 1"))+
labs(x="Longitude",y="Latitude")

可重复的数据：

state<-c("alabama", 
"alaska", "arizona", "arkansas", "california", "colorado", "connecticut", 
"delaware", "district of columbia", "florida", "georgia", "hawaii", 
"idaho", "illinois", "indiana", "iowa", "kansas", "kentucky", 
"louisiana", "maine", "maryland", "massachusetts", "michigan", 
"minnesota", "mississippi", "missouri", "montana", "nebraska", 
"nevada", "new hampshire", "new jersey", "new mexico", "new york", 
"new york city", "north carolina", "north dakota", "ohio", "oklahoma", 
"oregon", "pennsylvania", "puerto rico", "rhode island", "south carolina", 
"south dakota", "tennessee", "texas", "utah", "vermont", "virgin islands", 
"virginia", "washington", "west virginia", "wisconsin", "wyoming")

activity<-c("10", "10", "10", "10", 
"8", "8", "6", "10", "10", "1", "10", "6", "4", "10", "10", "7", 
"10", "10", "10", "2", "10", "10", "9", "9", "10", "10", "2", 
"10", "8", "10", "10", "10", "10", "10", "3", "8", "10", "8", 
"10", "10", "10", "10", "10", "10", "7", "10", "10", "1", "10", 
"7", "10", "10", "9", "5")

reproducible_data<-data.frame(state,activity)

Answer 1

因为 @erocoar 提供了 grob 挖掘替代方案，所以我不得不采用 create-a-plot-which-looks-like-a-legend 的方式。

我在比 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 中进行一些小的修改。为了进一步定制，您必须或多或少地求助于手动“绘图”，或者通过在 grobs 领域的洞穴探险（例如Custom legend with imported images），或者通过创建一个作为图例添加到原始情节的情节（例如@987654323 @)。

自定义图例的另一个示例，同样是 grob hacking 与“绘制”图例：Overlay base R graphics on top of ggplot2。

Answer 2

这是一个有趣的问题，这样的传说看起来会很不错。没有数据，所以我只是在不同的情节上尝试了它 - 代码可能会更概括，但这是第一步:)

首先，剧情

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_idx 进行概括）
• 由于宽度扩大，图例被推入情节（我认为只需将 col_space 添加到主 gtable）