重画《癌生物学》插图||原发癌和它们的转移倾向

在读《癌生物学》第十四章：<迁出：侵袭和转移>的时候看到一张插图（图14.43）：

P732

看到箭头就想到网络图的我，不免想起用igraph来画一下这个插图。

于是，我开始量化这几个箭头的方向和粗细得到一张这样的表：

library(igraph)
library(tidyverse)
df<- read.table(file = "clipboard", sep = "\t", header=TRUE)
df
    from   to weighting
1  前列腺   脑         5
2  前列腺   肺         5
3  前列腺   肝         7
4  前列腺 骨髓        10
5    胰腺   脑         0
6    胰腺   肺         5
7    胰腺   肝        10
8    胰腺 骨髓         0
9    乳腺   脑         1
10   乳腺   肺        10
11   乳腺   肝         5
12   乳腺 骨髓        10
13   结肠   脑         0
14   结肠   肺         1
15   结肠   肝        10
16   结肠 骨髓         1

然后就是对它画图了：

df %>% filter(weighting>0) -> df 
net<- graph_from_data_frame(df)
#plot(net)
allcolour=c("#0000FF","#20B2AA","#FFA500","#9370DB",
            "#98FB98","#F08080","#1E90FF","#7CFC00","#FFFF00",
            "#808000","#FF00FF","#FA8072","#7B68EE","#9400D3",
            "#800080","#A0522D","#D2B48C","#D2691E","#87CEEB",
            "#40E0D0","#5F9EA0","#FF1493",
            "#FFE4B5","#8A2BE2","#228B22","#E9967A","#4682B4",
            "#32CD32","#F0E68C","#FFFFE0","#EE82EE","#FF6347",
            "#6A5ACD","#9932CC","#8B008B","#8B4513","#DEB887")


karate_groups <- cluster_optimal(net)
coords <- layout_in_circle(net, order =
                               order(membership(karate_groups)))  # 设置网络布局

E(net)$width  <- E(net)$weighting  # 边点权重（粗细）

net2 <- net  # 复制一份备用

for (i in 1: length(unique(df$from)) ){
    E(net)[map(unique(df$to),function(x) {
        get.edge.ids(net,vp = c(unique(df$from)[i],x))
    })%>% unlist()]$color <- allcolour[i]
}  # 这波操作谁有更好的解决方案？ 
E(net)$color
plot(net, edge.arrow.size=.8, 
     edge.curved=0,
     vertex.color=allcolour,
     vertex.frame.color="#555555",
     vertex.label.color="black",
     layout = coords,
     vertex.label.cex=1.2)

很简单的一张原发癌和它们的转移倾向图奉献给大家。

如果你想尝试不同的布局：

layouts <- grep("^layout_", ls("package:igraph"), value=TRUE)[-1] 
# Remove layouts that do not apply to our graph.
layouts <- layouts[!grepl("bipartite|merge|norm|sugiyama|tree", layouts)]

par(mfrow=c(3,5), mar=c(1,1,1,1))

for (layout in layouts) {
    print(layout)
    l <- do.call(layout, list(net)) 
    plot(net,  edge.arrow.size=.2, layout=l, main=layout,vertex.label.cex=1.9,vertex.color=allcolour) }