将注释和段添加到图例元素组

Question

我的ggplot有以下传说:

我想将各个图例变量分组,并添加组名称和"括号",如下图所示:

我的数据有2列:
1 - 美国
2州 - 活动水平,范围从10(高) - 1(低)

我也在使用数据 -
us <-map_data("state"),它包含在ggplot/map包中.

我的代码:

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提供了挖掘挖掘的替代方案,所以我不得不追求创造一种情节 - 这看起来像一个传奇的方式.

我在一个较小的数据集和比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领域的洞穴探险(例如,带有导入图像的自定义图例),或者通过创建一个作为图例添加到原始图的绘图(例如根据geom_map或ggplot2中的意外事件(2x2)表创建一个唯一的图例？).

另一个自定义图例的例子,再次grob hacking与' plotting '一个传奇:在ggplot2之上叠加基础R图形.

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)