网络图layout如何自定义

写在前面

在构造更加合适我们解决问题的网络图layout过程中，我学习到了一些有意思的数据排布。这里展示给大家。

多边形–五边形

library(tidyverse)

pentagon <- tibble(
x = accumulate(1:4, ~.x+cos(.y*2*pi/5), .init = 0),
y = accumulate(1:4, ~.x+sin(.y*2*pi/5), .init = 0),
xend = accumulate(2:5, ~.x+cos(.y*2*pi/5), .init = cos(2*pi/5)),
yend = accumulate(2:5, ~.x+sin(.y*2*pi/5), .init = sin(2*pi/5)))

ggplot(pentagon)+
geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+
coord_equal()+
theme_void()

定义随意多边形

polygon <- function(n) {
tibble(
x = accumulate(1:(n-1), ~.x+cos(.y*2*pi/n), .init = 0),
y = accumulate(1:(n-1), ~.x+sin(.y*2*pi/n), .init = 0),
xend = accumulate(2:n, ~.x+cos(.y*2*pi/n), .init = cos(2*pi/n)),
yend = accumulate(2:n, ~.x+sin(.y*2*pi/n), .init = sin(2*pi/n)))
}

ggplot(polygon(6))+
geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+
coord_equal()+
theme_void()

ggplot(polygon(7))+
geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+
coord_equal()+
theme_void()

ggplot(polygon(8))+
geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+
coord_equal()+
theme_void()

ggplot(polygon(9))+
geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+
coord_equal()+
theme_void()

复杂多边形，用于网络嵌套结构

polygon(5) -> df1
df1 %>% mutate(angle = atan2(yend-y, xend-x)+pi/2,
x = 0.5*x+0.5*xend,
y = 0.5*y+0.5*yend,
xend = x+0.2*cos(angle),
yend = y+0.2*sin(angle)) %>%
select(x, y, xend, yend) -> df2
df1 %>% bind_rows(df2) -> df
ggplot(df)+
geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+
coord_equal()+
theme_void()

polygon(5) -> df1
df1 %>% mutate(angle = atan2(yend-y, xend-x)+pi/2,
x = 0.5*x+0.5*xend,
y = 0.5*y+0.5*yend,
xend = x+0.2*cos(angle),
yend = y+0.2*sin(angle)) %>%
select(x, y, xend, yend) -> df2
df2 %>% mutate(
x=xend,
y=yend,
xend=lead(x, default=first(x)),
yend=lead(y, default=first(y))) %>%
select(x, y, xend, yend) -> df3
df1 %>% bind_rows(df2) %>% bind_rows(df3) -> df
ggplot(df)+
geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+
coord_equal()+
theme_void()

我觉得三级嵌套已经足够了

mid_points <- function(d) {
d %>% mutate(
angle=atan2(yend-y, xend-x) + pi/2,
x=0.5*x+0.5*xend,
y=0.5*y+0.5*yend,
xend=x+0.2*cos(angle),
yend=y+0.2*sin(angle)) %>%
select(x, y, xend, yend)
}
con_points <- function(d) {
d %>% mutate(
x=xend,
y=yend,
xend=lead(x, default=first(x)),
yend=lead(y, default=first(y))) %>%
select(x, y, xend, yend)
}
polygon(5) -> df1
df2 <- mid_points(df1)
df3 <- con_points(df2)
df4 <- mid_points(df3)
df5 <- con_points(df4)
df1 %>%
bind_rows(df2) %>%
bind_rows(df3) %>%
bind_rows(df4) %>%
bind_rows(df5) -> df
ggplot(df)+
geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+
coord_equal()+
theme_void()

mid_points <- function(d, p) {
d %>% mutate(
angle=atan2(yend-y, xend-x) + pi/2,
x=p*x+(1-p)*xend,
y=p*y+(1-p)*yend,
xend=x+0.2*cos(angle),
yend=y+0.2*sin(angle)) %>%
select(x, y, xend, yend)
}
edges <- 7
niter <- 6
polygon(edges) -> df1
accumulate(.f = function(old, y) {
if (y%%2==0) mid_points(old, 0.3) else con_points(old)
},
1:niter,
.init=df1) %>%
bind_rows() -> df
ggplot(df)+
geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+
coord_equal()+
theme_void()

当然我不需要将其化画成花的话

mid_points <- function(d, p, a) {
d %>% mutate(
angle=atan2(yend-y, xend-x) + a,
x=p*x+(1-p)*xend,
y=p*y+(1-p)*yend,
xend=x+0.2*cos(angle),
yend=y+0.2*sin(angle)) %>%
select(x, y, xend, yend)
}
edges <- 7
niter <- 18
polygon(edges) -> df1
accumulate(.f = function(old, y) {
if (y%%2!=0) mid_points(old, 0.3, pi/5) else con_points(old)
},
1:niter,
.init=df1) %>%
bind_rows() -> df
ggplot(df)+
geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+
coord_equal()+
theme_void()

mid_points <- function(d, p, a, i, FUN = function(x) x) {
d %>% mutate(
angle=atan2(yend-y, xend-x) + a,
radius=FUN(i),
x=p*x+(1-p)*xend,
y=p*y+(1-p)*yend,
xend=x+radius*cos(angle),
yend=y+radius*sin(angle)) %>%
select(x, y, xend, yend)
}

edges <- 7
niter <- 18
polygon(edges) -> df1
accumulate(.f = function(old, y) {
if (y%%2!=0) mid_points(old, 0.3, pi/5, y) else con_points(old)
},
1:niter,
.init=df1) %>%
bind_rows() -> df
ggplot(df)+
geom_segment(aes(x=x, y=y, xend=xend, yend=yend))+
coord_equal()+
theme_void()

edges <- 7
niter <- 250
step <- 2
polygon(edges) -> df1
accumulate(.f = function(old, y) {
if (y%%step!=0) mid_points(old, 0.3, pi/5, y) else con_points(old)
},
1:niter,
.init=df1) %>%
bind_rows() -> df
ggplot(df)+
geom_curve(aes(x=x, y=y, xend=xend, yend=yend),
curvature = 0,
color="black",
alpha=0.1)+
coord_equal()+
theme(legend.position = "none",
panel.background = element_rect(fill="white"),
plot.background = element_rect(fill="white"),
axis.ticks = element_blank(),
panel.grid = element_blank(),
axis.title = element_blank(),
axis.text = element_blank())

library(tidyverse)

# This function creates the segments of the original polygon
polygon <- function(n) {
tibble(
x = accumulate(1:(n-1), ~.x+cos(.y*2*pi/n), .init = 0),
y = accumulate(1:(n-1), ~.x+sin(.y*2*pi/n), .init = 0),
xend = accumulate(2:n, ~.x+cos(.y*2*pi/n), .init = cos(2*pi/n)),
yend = accumulate(2:n, ~.x+sin(.y*2*pi/n), .init = sin(2*pi/n)))
}

# This function creates segments from some mid-point of the edges
mid_points <- function(d, p, a, i, FUN = ratio_f) {
d %>% mutate(
angle=atan2(yend-y, xend-x) + a,
radius=FUN(i),
x=p*x+(1-p)*xend,
y=p*y+(1-p)*yend,
xend=x+radius*cos(angle),
yend=y+radius*sin(angle)) %>%
select(x, y, xend, yend)
}

# This function connect the ending points of mid-segments
con_points <- function(d) {
d %>% mutate(
x=xend,
y=yend,
xend=lead(x, default=first(x)),
yend=lead(y, default=first(y))) %>%
select(x, y, xend, yend)
}

edges <- 3 # Number of edges of the original polygon
niter <- 250 # Number of iterations
pond <- 0.24 # Weight to calculate the point on the middle of each edge
step <- 13 # No of times to draw mid-segments before connect ending points
alph <- 0.25 # transparency of curves in geom_curve
angle <- 0.6 # angle of mid-segment with the edge
curv <- 0.1 # Curvature of curves
line_color <- "black" # Color of curves in geom_curve
back_color <- "white" # Background of the ggplot
ratio_f <- function(x) {sin(x)} # To calculate the longitude of mid-segments

# Generation on the fly of the dataset
accumulate(.f = function(old, y) {
if (y%%step!=0) mid_points(old, pond, angle, y) else con_points(old)
}, 1:niter,
.init=polygon(edges)) %>% bind_rows() -> df

# Plot
ggplot(df)+
geom_curve(aes(x=x, y=y, xend=xend, yend=yend),
curvature = curv,
color=line_color,
alpha=alph)+
coord_equal()+
theme(legend.position = "none",
panel.background = element_rect(fill=back_color),
plot.background = element_rect(fill=back_color),
axis.ticks = element_blank(),
panel.grid = element_blank(),
axis.title = element_blank(),
axis.text = element_blank())

reference

如果大家兴趣，可以到此处查看更多用法，但是到现在为为止，我们已经足够用了。

https://fronkonstin.com/tag/ggplot2/