三种方法在地图上绘制网络图

作者简介Introduction

taoyan：R语言中文社区特约作家，伪码农，R语言爱好者，爱开源。

个人博客: https://ytlogos.github.io/

往期回顾

R语言可视化学习笔记之相关矩阵可视化包ggcorrplot

R语言学习笔记之相关性矩阵分析及其可视化

ggplot2学习笔记系列之利用ggplot2绘制误差棒及显著性标记

ggplot2学习笔记系列之主题（theme）设置

用circlize包绘制circos-plot

利用gganimate可视化R-Ladies发展情况

一篇关于国旗与奥运会奖牌的可视化笔记

利用ggseqlogo绘制seqlogo图

R语言data manipulation学习笔记之创建变量、重命名、数据融合

R语言data manipulation学习笔记之subset data

R语言可视化学习笔记之gganimate包

创建属于自己的调色板

Lesson 01 for Plotting in R for Biologists

Lesson 02&03 for Plotting in R for Biologists

Lesson 04 for Plotting in R for Biologists

最近为了绘制几幅简单地图，查阅了一些资料，看到了Markus konrad的帖子，非常赞。其中他的部分思路对于我们学习可视化很有帮助。

准备

我们需要用到以下包

library(pacman)

p_load(assertthat,tidyverse,ggraph,igraph,ggmap)   

加载数据

nodes <- read.table("country_coords.txt", header = FALSE, quote = "'",sep = "",col.names = c("id","lon","lat","name"))   

创建连接关系

set.seed(42)

min <- 1

max <- 4

n_categories <- 4

edges <- map_dfr(nodes$id, function(id){

n <- floor(runif(1,min,max+1))

to <- sample(1:max(nodes$id),n ,replace = FALSE)

to <- to[to!=id]

categories <- sample(1:n_categories,length(to), replace = TRUE)

weight <- runif(length(to))

data_frame(from=id, to=to, weight=weight, category=categories)

})

edges <- edges%>%mutate(category=as.factor(category))

   上面我们已经创建好了节点(node)以及连接(edge)，下面进行可视化

可视化

#生成图形结构

g <- graph_from_data_frame(edges, directed = FALSE, vertices = nodes)   

再额外定义四列用来绘制节点的起始位置

edges_for_plot <- edges%>%

inner_join(nodes%>%select(id, lon, lat),by=c("from"="id"))%>%

rename(x=lon, y=lat)%>%

inner_join(nodes%>%select(id,lon,lat),by=c("to"="id"))%>%

rename(xend=lon,yend=lat)

assert_that(nrow(edges_for_plot)==nrow(edges))

nodes$weight <- degree(g)

下面再定义以下ggplot2主题用来绘制地图

maptheme <- theme(

panel.grid = element_blank(),

axis.text = element_blank(),

axis.ticks = element_blank(),

axis.title = element_blank(),

legend.position = "bottom",

panel.background = element_rect(fill="#596673"),

plot.margin = unit(c(0,0,0.5,0),"cm")

)

country_shape <- geom_polygon(aes(x=long, y=lat, group=group),

data=map_data("world"),

fill="#CECECE", color="#515151",size=0.1)

mapcoords <- coord_fixed(xlim=c(-150,180), ylim=c(-55,80))

方法一：ggplot2

ggplot(nodes)+country_shape+

geom_curve(aes(x=x,y=y,xend=xend,yend=yend,color=category,size=weight),

data=edges_for_plot,curvature = 0.33,alpha=0.5)+

scale_size_continuous(guide = FALSE,range = c(0.25,2))+

geom_point(aes(x=lon,y=lat,size=weight),shape=21,fill="white",color="black",stroke=0.5)+

scale_size_continuous(guide = FALSE, range = c(1,6))+

geom_text(aes(x=lon,y=lat,label=name),hjust=0,nudge_x = 1,nudge_y = 4,size=3,color="black",fontface="bold")+

mapcoords+maptheme

   

方法二：ggplot2+ggraph

nodes_pos <- nodes%>%

select(lon,lat)%>%

rename(x=lon,y=lat)

lay <- create_layout(g,"manual",node.position=nodes_pos)

assert_that(nrow(lay)==nrow(nodes))

lay$weight <- degree(g)

ggraph(lay)+

country_shape+

geom_edge_arc(aes(color=category,edge_width=weight,circular=FALSE),

data = edges_for_plot,curvature = 0.33,alpha=0.5)+

scale_edge_width_continuous(range = c(0.5,2),guide=FALSE)+

geom_node_point(aes(size=weight),shape=21,fill="white",color="black",stroke=0.5)+

scale_size_continuous(range = c(1,6),guide = FALSE)+

geom_node_text(aes(label=name),repel = TRUE, size=3,color="black",fontface="bold")+

mapcoords+maptheme

方法三：图形叠加

图形叠加，所以需要一个透明背景

theme_transp_overlay <- theme(

panel.background = element_rect(fill="transparent",color=NA),

plot.background = element_rect(fill="transparent",color=NA)

)

(p_base <- ggplot()+

country_shape+

mapcoords+

maptheme)

(p_edges <- ggplot(edges_for_plot)+

geom_curve(aes(x=x,y=y,xend=xend,yend=yend,color=category,size=weight),

curvature = 0.33,alpha=0.33)+

scale_size_continuous(guide = FALSE, range = c(0.5, 2)) +

mapcoords + maptheme + theme_transp_overlay +

theme(legend.position = c(0.5, -0.1),

legend.direction = "horizontal"))

   

(p_nodes <- ggplot(nodes) +

geom_point(aes(x = lon, y = lat, size = weight),

shape = 21, fill = "white", color = "black",

stroke = 0.5) +

scale_size_continuous(guide = FALSE, range = c(1, 6)) +

geom_text(aes(x = lon, y = lat, label = name),

hjust = 0, nudge_x = 1, nudge_y = 4,

size = 3, color = "white", fontface = "bold") +

mapcoords + maptheme + theme_transp_overlay)

   最后就是三图形叠加了（需要多次调整）

p <- p_base+

annotation_custom(ggplotGrob(p_edges),ymin = -74)+

annotation_custom(ggplotGrob(p_nodes),ymin = -74)

print(p)

   

Info

sessionInfo()

## R version 3.5.0 (2018-04-23)

## Platform: x86_64-w64-mingw32/x64 (64-bit)

## Running under: Windows 10 x64 (build 16299)

##

## Matrix products: default

##

## locale:

## [1] LC_COLLATE=Chinese (Simplified)_China.936

## [2] LC_CTYPE=Chinese (Simplified)_China.936  

## [3] LC_MONETARY=Chinese (Simplified)_China.936

## [4] LC_NUMERIC=C

## [5] LC_TIME=Chinese (Simplified)_China.936    

##

## attached base packages:

## [1] stats     graphics  grDevices utils     datasets  methods   base

##

## other attached packages:

##  [1] maps_3.3.0         bindrcpp_0.2.2     ggmap_2.6.1      

##  [4] igraph_1.2.1       ggraph_1.0.1       forcats_0.3.0    

##  [7] stringr_1.3.1      dplyr_0.7.5        purrr_0.2.5      

## [10] readr_1.1.1        tidyr_0.8.1        tibble_1.4.2      

## [13] ggplot2_2.2.1.9000 tidyverse_1.2.1    assertthat_0.2.0  

## [16] pacman_0.4.6      

##

## loaded via a namespace (and not attached):

##  [1] ggrepel_0.8.0     Rcpp_0.12.17      lubridate_1.7.4  

##  [4] lattice_0.20-35   png_0.1-7         rprojroot_1.3-2  

##  [7] digest_0.6.15     psych_1.8.4       ggforce_0.1.2    

## [10] R6_2.2.2          cellranger_1.1.0  plyr_1.8.4      

## [13] backports_1.1.2   evaluate_0.10.1   httr_1.3.1      

## [16] pillar_1.2.3      RgoogleMaps_1.4.1 rlang_0.2.1      

## [19] lazyeval_0.2.1    readxl_1.1.0      geosphere_1.5-7  

## [22] rstudioapi_0.7    rmarkdown_1.9     labeling_0.3    

## [25] proto_1.0.0       udunits2_0.13     foreign_0.8-70  

## [28] munsell_0.4.3     broom_0.4.4       compiler_3.5.0  

## [31] modelr_0.1.2      pkgconfig_2.0.1   mnormt_1.5-5    

## [34] htmltools_0.3.6   tidyselect_0.2.4  gridExtra_2.3    

## [37] viridisLite_0.3.0 crayon_1.3.4      withr_2.1.2      

## [40] MASS_7.3-49       grid_3.5.0        nlme_3.1-137    

## [43] jsonlite_1.5      gtable_0.2.0      magrittr_1.5    

## [46] units_0.5-1       scales_0.5.0      cli_1.0.0        

## [49] stringi_1.1.7     mapproj_1.2.6     reshape2_1.4.3  

## [52] viridis_0.5.1     sp_1.2-7          xml2_1.2.0      

## [55] rjson_0.2.19      tools_3.5.0       glue_1.2.0      

## [58] tweenr_0.1.5      jpeg_0.1-8        hms_0.4.2        

## [61] parallel_3.5.0    yaml_2.1.19       colorspace_1.3-2

## [64] rvest_0.3.2       knitr_1.20        bindr_0.1.1      

## [67] haven_1.1.1

   

　往期精彩内容整理合集　

2017年R语言发展报告（国内）

R语言中文社区历史文章整理（作者篇）

R语言中文社区历史文章整理（类型篇）

公众号后台回复关键字即可学习

回复 R                  R语言快速入门及数据挖掘 
回复 Kaggle案例  Kaggle十大案例精讲（连载中）
回复 文本挖掘      手把手教你做文本挖掘
回复 可视化          R语言可视化在商务场景中的应用 
回复 大数据         大数据系列免费视频教程 
回复 量化投资      张丹教你如何用R语言量化投资 
回复 用户画像      京东大数据，揭秘用户画像
回复 数据挖掘     常用数据挖掘算法原理解释与应用
回复 机器学习     人工智能系列之机器学习与实践
回复 爬虫            R语言爬虫实战案例分享