三种方法在地图上绘制网络图
最近为了绘制几幅简单地图，查阅了一些资料，看到了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
