Question

我的ggplot有以下传说：

我想对各个图例变量进行分组，并添加组名和＆＃34;括号＆＃34;如下图所示：

我的数据有两列：
1 - 美国的国家
2 - 活动水平，范围从10（高） - 1（低）

我也在使用数据 - 我们＆lt; -map_data（＆＃34;州＆＃34;），它包含在ggplot / map包中。

我的代码：

<random>

可重复数据：

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

Answer 1

因为@erocoar提供了挖掘挖掘的替代方案，所以我不得不追求创造一种情节 - 这看起来像一个传奇的方式。

我在一个较小的数据集和比OP更简单的图上制定了我的解决方案，但核心问题是相同的：要分组和注释的十个图例元素。我相信这种方法的主要思想可以很容易地适应其他public class Application extends android.app.Application { @Override public void onCreate() { super.onCreate(); PESDK.init(this); } }和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中进行一些小修改。为了进一步定制，您必须采用或多或少的手绘“绘图”，或者通过grobs领域的洞穴探险（例如Custom legend with imported images），或者创建一个作为图例添加的图表。原始情节（例如Create a unique legend based on a contingency (2x2) table in geom_map or ggplot2?）。

自定义传奇的另一个例子，再次grob hacking vs.＆＃39; plotting＆＃39;传奇：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中）

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

2 个答案: