如何在一个 ggplot 中有两个不同大小的图例？
How to have two different size legends in one ggplot?
假设我绘制了这个玩具数据：
lev <- c("A", "B", "C", "D")
nodes <- data.frame(ord=c(1,1,1,2,2,3,3,4), brand=
factor(c("A", "B", "C","B", "C","D", "B","D"), levels=lev),
thick=c(16,9,9,16,4,1,4,1))
edge <- data.frame(ord1=c(1,1,2,3), brand1=factor(c("C","A","B","B"),
levels=lev),ord2=c(2,2,3,4), brand2=c("C","B","B","D"),
N1=c(2,1,2,1), N2=c(5,5,2,1))
ggplot() +
geom_point(data = nodes,
aes(x = ord, y = brand, size = sqrt(thick)),
color = "black", shape = 16, show.legend = T) +
scale_x_continuous(limits=c(1, 4), breaks=seq(0,4,1),
minor_breaks = NULL) +
geom_segment(data = edge,
aes(x = ord1, y = brand1, xend = ord2, yend = brand2),
color = "blue", size = edge$N2/edge$N1) +
ylim(lev) +
theme_bw()
如预期的那样，我得到了这个情节。
我想添加另一个与线段宽度相关的图例（在节点下方）N2/N1。
PD：
按照您的一些建议...
ggplot() +
geom_segment(data = edge,
aes(x = ord1, y = brand1, xend = ord2, yend = brand2, size = N2/N1),
color = "blue", show.legend = T) +
geom_point(data = nodes,
aes(x = ord, y = brand, size = thick),
color = "black", shape = 16, show.legend = T) +
scale_x_continuous(limits = c(1, 4), breaks = 0:4,
minor_breaks = NULL) +
scale_size_continuous(trans = "sqrt", breaks = c(1,4,9,16)) +
ylim(lev) + theme_bw()
我得到了图例，但它与另一个重叠。
我可以尝试使用颜色而不是宽度：
ggplot()+ geom_segment(data=edge, aes(x=ord1, y=brand1, xend=ord2, yend=brand2, alpha=N2/N1) , size=1 ,show.legend = T) +
geom_point(data=nodes,aes(x=ord, y=brand, size=thick), color="black", shape=16,show.legend = T) +
scale_x_continuous(limits=c(1, 4), breaks=seq(0,4,1), minor_breaks = NULL) + scale_size_continuous(trans = "sqrt", breaks=c(1,4,9,16)) +
ylim(lev) + theme_bw()
或改变 alpha
虽然我更喜欢原来的宽度方法，因为在我的真实情节中我会有很多线交叉。
PD：任何带有格子的解决方案或任何能够导出为 svg 或矢量 pdf 的替代方案？
PD2：我发现了另一个问题，细点未正确缩放，有时无法强制 ggplot 显示正确的图例：
有时 ggplot 可能不是完成这项工作的最佳工具。熟悉这些实例的其他一些绘图选项是值得的，R 的基本图形系统相当通用。
以下是您在基本图形中的操作方法：
lev <- c("A", "B", "C", "D")
nodes <- data.frame(ord=c(1,1,1,2,2,3,3,4), brand=
factor(c("A", "B", "C","B", "C","D", "B","D"), levels=lev),
thick=c(16,9,9,16,4,1,4,1))
edge <- data.frame(ord1=c(1,1,2,3),
brand1=factor(c("C","A","B","B"), levels=lev),
ord2=c(2,2,3,4),
brand2=factor(c("C","B","B","D"), levels=lev),
N1=c(2,1,2,1), N2=c(5,5,2,1))
png(width = 6, height = 4, units = 'in',res=300)
par(xpd=FALSE, mar = c(5, 4, 4, 15) + 0.1)
plot(NULL, NULL, xaxt = "n", yaxt = "n",
xlim = c(1,4), ylim = c(1,4),
xlab = 'ord', ylab = 'brand')
axis(side = 1, at = 1:4)
axis(side = 2, at = 1:4, labels = LETTERS[1:4])
grid()
par(xpd=TRUE)
segments(edge$ord1, as.integer(edge$brand1),
edge$ord2, as.integer(edge$brand2),
lwd = 4*edge$N2/edge$N1,
col='blue')
points(nodes$ord, nodes$brand, cex=sqrt(nodes$thick), pch=16)
legend(4.5,4,
legend = as.character(c(1,2,4,8,16)),
pch = 16,
cex = 1.5,
pt.cex = sqrt(c(1,2,4,8,16)))
legend(6,4,
legend = as.character(1:5),
lwd = 4*(1:5),
col = 'blue',
cex = 1.5)
dev.off()
使用我整理的highly实验包：
library(ggplot2) # >= 2.3.0
library(dplyr)
library(relayer) # install.github("clauswilke/relayer")
# make aesthetics aware size scale, also use better scaling
scale_size_c <- function(name = waiver(), breaks = waiver(), labels = waiver(),
limits = NULL, range = c(1, 6), trans = "identity", guide = "legend", aesthetics = "size")
{
continuous_scale(aesthetics, "area", scales::rescale_pal(range), name = name,
breaks = breaks, labels = labels, limits = limits, trans = trans,
guide = guide)
}
lev <- c("A", "B", "C", "D")
nodes <- data.frame(
ord = c(1,1,1,2,2,3,3,4),
brand = factor(c("A", "B", "C", "B", "C", "D", "B", "D"), levels=lev),
thick = c(16, 9, 9, 16, 4, 1, 4, 1)
)
edge <- data.frame(
ord1 = c(1, 1, 2, 3),
brand1 = factor(c("C", "A", "B", "B"), levels = lev),
ord2 = c(2, 2, 3, 4),
brand2 = c("C", "B", "B", "D"),
N1 = c(2, 1, 2, 1),
N2 = c(5, 5, 2, 1)
)
ggplot() +
(geom_segment(
data = edge,
aes(x = ord1, y = brand1, xend = ord2, yend = brand2, edge_size = N2/N1),
color = "blue"
) %>% rename_geom_aes(new_aes = c("size" = "edge_size"))) +
(geom_point(
data = nodes,
aes(x = ord, y = brand, node_size = thick),
color = "black", shape = 16
) %>% rename_geom_aes(new_aes = c("size" = "node_size"))) +
scale_x_continuous(
limits = c(1, 4),
breaks = 0:4,
minor_breaks = NULL
) +
scale_size_c(
aesthetics = "edge_size",
breaks = 1:5,
name = "edge size",
guide = guide_legend(keywidth = grid::unit(1.2, "cm"))
) +
scale_size_c(
aesthetics = "node_size",
trans = "sqrt",
breaks = c(1, 4, 9, 16),
name = "node size"
) +
ylim(lev) + theme_bw()
由 reprex package (v0.2.0) 创建于 2018-05-16。
假设我绘制了这个玩具数据：
lev <- c("A", "B", "C", "D")
nodes <- data.frame(ord=c(1,1,1,2,2,3,3,4), brand=
factor(c("A", "B", "C","B", "C","D", "B","D"), levels=lev),
thick=c(16,9,9,16,4,1,4,1))
edge <- data.frame(ord1=c(1,1,2,3), brand1=factor(c("C","A","B","B"),
levels=lev),ord2=c(2,2,3,4), brand2=c("C","B","B","D"),
N1=c(2,1,2,1), N2=c(5,5,2,1))
ggplot() +
geom_point(data = nodes,
aes(x = ord, y = brand, size = sqrt(thick)),
color = "black", shape = 16, show.legend = T) +
scale_x_continuous(limits=c(1, 4), breaks=seq(0,4,1),
minor_breaks = NULL) +
geom_segment(data = edge,
aes(x = ord1, y = brand1, xend = ord2, yend = brand2),
color = "blue", size = edge$N2/edge$N1) +
ylim(lev) +
theme_bw()
如预期的那样，我得到了这个情节。
我想添加另一个与线段宽度相关的图例（在节点下方）N2/N1。
PD： 按照您的一些建议...
ggplot() +
geom_segment(data = edge,
aes(x = ord1, y = brand1, xend = ord2, yend = brand2, size = N2/N1),
color = "blue", show.legend = T) +
geom_point(data = nodes,
aes(x = ord, y = brand, size = thick),
color = "black", shape = 16, show.legend = T) +
scale_x_continuous(limits = c(1, 4), breaks = 0:4,
minor_breaks = NULL) +
scale_size_continuous(trans = "sqrt", breaks = c(1,4,9,16)) +
ylim(lev) + theme_bw()
我得到了图例，但它与另一个重叠。
我可以尝试使用颜色而不是宽度：
ggplot()+ geom_segment(data=edge, aes(x=ord1, y=brand1, xend=ord2, yend=brand2, alpha=N2/N1) , size=1 ,show.legend = T) +
geom_point(data=nodes,aes(x=ord, y=brand, size=thick), color="black", shape=16,show.legend = T) +
scale_x_continuous(limits=c(1, 4), breaks=seq(0,4,1), minor_breaks = NULL) + scale_size_continuous(trans = "sqrt", breaks=c(1,4,9,16)) +
ylim(lev) + theme_bw()
或改变 alpha
虽然我更喜欢原来的宽度方法，因为在我的真实情节中我会有很多线交叉。
PD：任何带有格子的解决方案或任何能够导出为 svg 或矢量 pdf 的替代方案？
PD2：我发现了另一个问题，细点未正确缩放，有时无法强制 ggplot 显示正确的图例：
有时 ggplot 可能不是完成这项工作的最佳工具。熟悉这些实例的其他一些绘图选项是值得的，R 的基本图形系统相当通用。
以下是您在基本图形中的操作方法：
lev <- c("A", "B", "C", "D")
nodes <- data.frame(ord=c(1,1,1,2,2,3,3,4), brand=
factor(c("A", "B", "C","B", "C","D", "B","D"), levels=lev),
thick=c(16,9,9,16,4,1,4,1))
edge <- data.frame(ord1=c(1,1,2,3),
brand1=factor(c("C","A","B","B"), levels=lev),
ord2=c(2,2,3,4),
brand2=factor(c("C","B","B","D"), levels=lev),
N1=c(2,1,2,1), N2=c(5,5,2,1))
png(width = 6, height = 4, units = 'in',res=300)
par(xpd=FALSE, mar = c(5, 4, 4, 15) + 0.1)
plot(NULL, NULL, xaxt = "n", yaxt = "n",
xlim = c(1,4), ylim = c(1,4),
xlab = 'ord', ylab = 'brand')
axis(side = 1, at = 1:4)
axis(side = 2, at = 1:4, labels = LETTERS[1:4])
grid()
par(xpd=TRUE)
segments(edge$ord1, as.integer(edge$brand1),
edge$ord2, as.integer(edge$brand2),
lwd = 4*edge$N2/edge$N1,
col='blue')
points(nodes$ord, nodes$brand, cex=sqrt(nodes$thick), pch=16)
legend(4.5,4,
legend = as.character(c(1,2,4,8,16)),
pch = 16,
cex = 1.5,
pt.cex = sqrt(c(1,2,4,8,16)))
legend(6,4,
legend = as.character(1:5),
lwd = 4*(1:5),
col = 'blue',
cex = 1.5)
dev.off()
使用我整理的highly实验包：
library(ggplot2) # >= 2.3.0
library(dplyr)
library(relayer) # install.github("clauswilke/relayer")
# make aesthetics aware size scale, also use better scaling
scale_size_c <- function(name = waiver(), breaks = waiver(), labels = waiver(),
limits = NULL, range = c(1, 6), trans = "identity", guide = "legend", aesthetics = "size")
{
continuous_scale(aesthetics, "area", scales::rescale_pal(range), name = name,
breaks = breaks, labels = labels, limits = limits, trans = trans,
guide = guide)
}
lev <- c("A", "B", "C", "D")
nodes <- data.frame(
ord = c(1,1,1,2,2,3,3,4),
brand = factor(c("A", "B", "C", "B", "C", "D", "B", "D"), levels=lev),
thick = c(16, 9, 9, 16, 4, 1, 4, 1)
)
edge <- data.frame(
ord1 = c(1, 1, 2, 3),
brand1 = factor(c("C", "A", "B", "B"), levels = lev),
ord2 = c(2, 2, 3, 4),
brand2 = c("C", "B", "B", "D"),
N1 = c(2, 1, 2, 1),
N2 = c(5, 5, 2, 1)
)
ggplot() +
(geom_segment(
data = edge,
aes(x = ord1, y = brand1, xend = ord2, yend = brand2, edge_size = N2/N1),
color = "blue"
) %>% rename_geom_aes(new_aes = c("size" = "edge_size"))) +
(geom_point(
data = nodes,
aes(x = ord, y = brand, node_size = thick),
color = "black", shape = 16
) %>% rename_geom_aes(new_aes = c("size" = "node_size"))) +
scale_x_continuous(
limits = c(1, 4),
breaks = 0:4,
minor_breaks = NULL
) +
scale_size_c(
aesthetics = "edge_size",
breaks = 1:5,
name = "edge size",
guide = guide_legend(keywidth = grid::unit(1.2, "cm"))
) +
scale_size_c(
aesthetics = "node_size",
trans = "sqrt",
breaks = c(1, 4, 9, 16),
name = "node size"
) +
ylim(lev) + theme_bw()
由 reprex package (v0.2.0) 创建于 2018-05-16。