可以将文章内容翻译成中文,广告屏蔽插件可能会导致该功能失效(如失效,请关闭广告屏蔽插件后再试):
问题:
Imagine I plot this toy data:
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()
I get this plot, as expected.
I would like to add another legend (below the nodes) relating the width of the segments and N2/N1.
PD:
Following some of your suggestions...
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()
I got the legend but it overlaps with the other one.
I can try using colors instead of widths:
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()
Or varying alpha
Though I prefer the original approach with widths because in my real plot I'll have many lines crossing.
PD: Any solution with lattice or any alternative able to be exported as svg or vectorial pdf?
PD2: I've found another problem, thin points aren't scaled properly and sometimes is impossible to force ggplot to show a proper legend:
How can I force ggplot to show more levels on the legend?
回答1:
Using a highly experimental package I put together:
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()
Created on 2018-05-16 by the reprex package (v0.2.0).
回答2:
Sometimes ggplot may not be the best tool for the job. it pays to be familiar with some other plotting options for these instances, with R's base graphics system being reasonably versatile.
Here's how you might do it in base graphics:
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()