AfarX

A Rookie of R.

R语言绘制复杂人物网络关系图代码

基于NetworkD3包绘制,感谢万能的Stackoverflow的帮助。

代码如下:

预处理

首先将数据处理为networkD3包需要的数据格式。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
# 加载包,都是Hadley大神开发的包,可以使用tidyverse包直接全部加载
#library(tidyverse)
library(stringr)
library(readr)
library(dplyr)
library(tibble)
library(reshape2)

# 载入数据,为防止中文乱码,指定编码为“GB18030"
letters <- read_csv("E://networkViz//GEPHI//edge.csv",locale=locale(encoding = "GB18030"))

################################
## Create node and edge lists ##
################################

### Node list ###
# 从边数据提取节点数据
sources <- letters %>%
distinct(Source) %>%
rename(label = Source)

destinations <- letters %>%
distinct(Target) %>%
rename(label = Target)

nodes <- full_join(sources, destinations, by = "label")

# Create id column and reorder columns
nodes <- nodes %>% rowid_to_column("id")

### Edge list ###
# 将边数据的label转为id
per_route <- letters %>%
select(Source, Target,weight)

# Join with node ids and reorder columns
edges <- per_route %>%
left_join(nodes, by = c("Source" = "label")) %>%
rename(from = id)

edges <- edges %>%
left_join(nodes, by = c("Target" = "label")) %>%
rename(to = id)

edges <- select(edges, from, to, weight)

绘图

载入networkD3包进行网络图绘制。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
########################
## Interactive network##
########################
library(visNetwork)
library(networkD3)
library(igraph)

# 生成节点集中度,根据集中度确定节点大小
routes_igraph <- graph_from_data_frame(d = edges, vertices = nodes, directed = FALSE)
nodes$bte <- betweenness(routes_igraph, directed = F)

quantile(nodes$bte,probs=0.95)
nodes$size <- car::recode(nodes$bte,"0=1;0:100=2;100:200=3;200:1000=4;else=10")

# 节点分类
#extract group by first.name
nodes <- mutate(nodes, group = str_sub(label,0,1))


nodes$group <- car::recode(nodes$group,
"'顾'='顾';else='世家'")

# 边宽度
edges <- mutate(edges, width=weight/5)

# networkD3要求编号从0开始,重新处理数据
nodes_d3 <- mutate(nodes, id = id - 1)
edges_d3 <- mutate(edges, from = from - 1, to = to - 1)

# 节点描述
nodes$description <- paste("This is a description of", nodes$label)

# 鼠标点击事件(弹出节点描述)
clickJS <- "
d3.selectAll('.xtooltip').remove();
d3.select('body').append('div')
.attr('class', 'xtooltip')
.style('position', 'fixed') # 描述出现位置
.style('border-radius', '0px')
.style('padding', '5px')
.style('opacity', '0.85')
.style('background-color', '#161823')
.style('box-shadow', '2px 2px 6px #161823')
# 描述内容
.html('name: ' + d.description + '<br>' + 'group: ' + d.group)
.style('right', '50px')
.style('bottom', '50px')
# 描述颜色
.style('color', d3.select(this).style('fill'))
;
"

# 边颜色
Cols <- car::recode(edges$weight,"1:6='#A78E44'")

# 绘制网络 !重要!
fn <- forceNetwork(Links = edges_d3,
Nodes = nodes_d3, # 节点数据
Source = "from", # 起始点
Target = "to", # 终点
NodeID = "label", # 节点名称
Group = "group", # 节点分组
Value = "width", # 边粗细
fontFamily = "黑体", # 字体
opacity = 1, # 透明度
fontSize = 16, # 字号
zoom = T, # 是否缩放
charge=-50, # 节点斥力大小(负值越大斥力越大)
bounded=T, # 是否有边界
legend=T, # 是否显示图例
arrows = F, # 是否显示箭头
Nodesize = "size", # 节点比例
linkColour = Cols, # 边颜色
opacityNoHover = 1, # 鼠标悬停时透明度
radiusCalculation = JS(" d.nodesize"), # 节点大小
ColourScale <- 'd3.scaleOrdinal() # 节点颜色
.domain(["顾", "世家"])
.range(["#FF6900", "#694489"]);',
width = 1200, # 图宽度
height = 500, # 图高度
clickAction= clickJS # 鼠标点击事件
)

至此网络已绘制完毕,接下来我们用r设置一下html输出格式。

1
2
3
4
5
6
7
8
9
10
11
12
13
library(htmltools)

browsable(
tagList(
tags$head(
tags$style('
body{background-color: #161823 !important} # 背景颜色
.legend text{fill: #FFFFFF} # 图例颜色
')
),
fn
)
)

r毕竟是个搞统计的软件,html输出没那么好调试(主要是我弱智调试不好……),所以我们直接建一个html网页,把上述网络嵌入到网页中去。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
<!DOCTYPE HTML>

<html>
<head>
<meta charset="utf-8">
<title></title>
<style>
*{
margin:100;
padding:200;
}
.div1{
padding-left: 100px; <!--左边距-->
padding-top: 100px; <!--右边距-->
width:800px; <!--宽度-->
}
</style>

<style type="text/css">
body {
margin: 0;
background-image: url('file:///C|/Users/afarx/Desktop/yw.png'); <!--背景图片-->
background-repeat:no-repeat;
background-position:100% 0%; <!--背景图片位置-->
}
</style>


</head>

<body bgcolor="#161823"> <!--背景色-->

<div class="div1">
<h1 style="font-family:arial;color:#EEDEB0;font-size:30px;">棠棣之华</h1>
<p style="font-family:arial;color:#F2ECDE;font-size:13px;">这张人物关系网络图将带你探索枉却东风作品<a href="http://www.66rpg.com/game/13639">《棠棣之华》</a>中复杂的人际关系网络。本图仅包括主线剧情出现人物及关系,连线越粗代表关系越亲近。人物节点可拖动,单击人物节点右下角将出现人物小传。<br>本图由AfarX整理,使用R包networkD3绘制,不断更新完善中。由于能力有限,难免错漏,请大家多多指正!</p>

<!--嵌入做好的网络图-->
<IFRAME name="tdzh" width=1200px height=600px frameborder=0 src="http://afarx.com/b.html" scrolling=no>
</IFRAME >
</div>
</body>
</html>

大功告成!现在就是不断完善了!

效果图见:http://afarx.com/tdzh.html


参考文献:

  1. Package ‘networkD3’
    https://cran.r-project.org/web/packages/networkD3/networkD3.pdf
  2. CUSTOM NETWORK CHART | NETWORKD3
    https://www.r-graph-gallery.com/253-custom-network-chart-networkd3/
  3. R语言利用igraph和networkD3包快速入门做出炫酷的社交网络图等几类图。
    http://blog.csdn.net/abc200941410128/article/details/72825628
  4. 如何做出漂亮的复杂网络关系图
    https://www.zhihu.com/question/27813239
  5. linking clickAction on a node in networkD3 to content preview in tab
    https://stackoverflow.com/questions/44970707/linking-clickaction-on-a-node-in-networkd3-to-content-preview-in-tab
  6. 用R构建Shiny应用程序
    http://yanping.me/shiny-tutorial/
  7. Shiny app的网页分享
    https://liubj2016.github.io/Akuan/group/python&R/note3.html
  8. 英文版shiny教程
    http://zevross.com/blog/2016/04/19/r-powered-web-applications-with-shiny-a-tutorial-and-cheat-sheet-with-40-example-apps/
  9. 改变NetworkD3节点颜色
    https://stackoverflow.com/questions/35280218/r-networkd3-package-node-coloring-in-simplenetwork
  10. Network visualization – part 6: D3 and R (networkD3)
    https://www.r-bloggers.com/network-visualization-part-6-d3-and-r-networkd3/
    http://www.vesnam.com/Rblog/viznets6/
  11. 将节点替换成图片
    https://stackoverflow.com/questions/39315593/r-networkd3-change-node-img
  12. 给NetworkD3添加标题
    https://stackoverflow.com/questions/46899144/r-add-title-to-networkd3-plot-and-save
  13. 利用嵌套CSS修改networkD3的背景、节点、图例颜色
    https://stackoverflow.com/questions/36879535/networkd3-forcenetwork-how-to-change-legend-text-colour-text-label-colour-and
  14. 加入搜索框
    https://stackoverflow.com/questions/39486906/search-box-in-network-plot
  15. 节点配色
    http://bl.ocks.org/aaizemberg/78bd3dade9593896a59d
  16. d3中文手册
    https://github.com/d3/d3/wiki/API--%E4%B8%AD%E6%96%87%E6%89%8B%E5%86%8C
  17. htmlwidgets for R
    http://www.htmlwidgets.org/
  18. 给图片添加tooltips
    https://stackoverflow.com/questions/44110370/implementing-tooltip-for-networkd3-app
  19. 添加注释
    https://stackoverflow.com/questions/44970707/linking-clickaction-on-a-node-in-networkd3-to-content-preview-in-tab/46096709#46096709
  20. 注释颜色替换
    https://stackoverflow.com/questions/16304818/d3js-use-elements-current-color-in-tooltip
  21. 修改背景图片及位置
    https://stackoverflow.com/questions/45473185/changing-background-image-within-forcenetwork/45495431#45495431
  22. 中国传统配色
    http://ylbook.com/cms/web/chuantongsecai/chuantongsecai.htm
  23. 网页嵌入特殊字体
    http://www.51xuediannao.com/html+css/htmlcssjq/CSS_TTF.html
  24. htmltools水平排列
    https://stackoverflow.com/questions/42475365/how-to-arrange-rgl-3d-plot-in-grid-using-taglist-from-htmltools
    https://stackoverflow.com/questions/45175040/multiple-leaflets-in-a-grid/45177697#45177697