利用R语言绘制世界航班路线图
2018-03-06 00:00
435 查看
作者简介Introductiontaoyan:伪码农,R语言爱好者,爱开源。个人博客: https://ytlogos.github.io/公众号:生信大讲堂
往期回顾R语言可视化学习笔记之相关矩阵可视化包ggcorrplot
R语言学习笔记之相关性矩阵分析及其可视化
ggplot2学习笔记系列之利用ggplot2绘制误差棒及显著性标记
ggplot2学习笔记系列之主题(theme)设置
用circlize包绘制circos-plot
一、 简介
本文基于NASA的夜间地图(https://www.nasa.gov/specials/blackmarble/2016/globalmaps/BlackMarble_2016_01deg.jpg)的基础上进行世界航班路线可视化,参考多篇博客以及可视化案例。1. 包加载本博客使用的包较多,利用pacman包里的p_load()函数进行加载
library(pacman)p_load(tidyverse, data.table, geosphere, grid, jpeg, plyr) 2. 数据准备使用的数据来自于OpenFlights.org(https://openflights.org/data.html)。3.数据下载download.file("https://raw.githubusercontent.com/jpatokal/openflights/master/data/airlines.dat",destfile = "airlines.dat", mode = "wb")download.file("https://raw.githubusercontent.com/jpatokal/openflights/master/data/airports.dat",destfile = "airports.dat", mode = "wb")download.file("https://raw.githubusercontent.com/jpatokal/openflights/master/data/routes.dat",destfile = "routes.dat", mode = "wb")4.数据导入
airlines <- fread("airlines.dat", sep = ",", skip = 1)airports <- fread("airports.dat", sep = ",")routes <- fread("routes.dat", sep = ",")5. 数据整理#添加列名colnames(airlines) <- c("airline_id", "name", "alias", "iata", "icao", "callisign", "country", "active")colnames(airports) <- c("airport_id", "name", "city", "country","iata", "icao", "latitude", "longitude","altitude", "timezone","dst","tz_database_time_zone","type", "source")colnames(routes) <- c("airline", "airline_id", "source_airport", "source_airport_id","destination_airport","destination_airport_id","codeshare", "stops","equipment")#类型转换routes$airline_id <- as.numeric(routes$airline_id)# airlines与routes数据融合flights <- left_join(routes, airlines, by="airline_id")# flights与airports数据融合airports_orig <- airports[,c(5,7,8)]colnames(airports_orig) <- c("source_airport","source_airport_lat", "source_airport_long")airports_dest <- airports[, c(5, 7, 8)]colnames(airports_dest) <- c("destination_airport", "destination_airport_lat", "destination_airport_long")flights <- left_join(flights, airports_orig, by = "source_airport")flights <- left_join(flights, airports_dest, by = "destination_airport")#剔除缺失值flights <- na.omit(flights, cols = c("source_airport_long", "source_airport_lat", "destination_airport_long", "destination_airport_lat"))#最后数据如下head(flights[,c(1:5)]) 6. 下面就是准备地理信息数据本文主要是可视化地理信息上的点与点之间的连接,这可以通过geosphere包里的函数gcIntermediate()很轻松实现。具体使用方法可以参考这里(http://flowingdata.com/2011/05/11/how-to-map-connections-with-great-circles/)。
# 按航空公司拆分数据集flights_split <- split(flights, flights$name)# Calculate intermediate points between each two locationsflights_all <- lapply(flights_split, function(x) gcIntermediate(x[, c("source_airport_long", "source_airport_lat")], x[, c("destination_airport_long", "destination_airport_lat")], n=100, breakAtDateLine = FALSE, addStartEnd = TRUE, sp = TRUE))
# 转换为数据框flights_fortified <- lapply(flights_all, function(x) ldply(x@lines, fortify))
# Unsplit listsflights_fortified <- do.call("rbind", flights_fortified)
# Add and clean column with airline namesflights_fortified$name <- rownames(flights_fortified)flights_fortified$name <- gsub("\\..*", "", flights_fortified$name)
# Extract first and last observations for plotting source and destination points (i.e., airports)flights_points <- flights_fortified %>% group_by(group) %>% filter(row_number() == 1 | row_number() == n()) 二、 可视化接下来就是进行可视化了,前面讲了我们只是在NASA提供的夜间地球图上面进行数据映射,所以第一我们需要获取该背景地图。1. 图片获取并渲染#下载图片
download.file("https://www.nasa.gov/specials/blackmarble/2016/globalmaps/BlackMarble_2016_01deg.jpg",destfile = "BlackMarble_2016_01deg.jpg", mode = "wb")
#加载并渲染图片
earth <- readJPEG("BlackMarble_2016_01deg.jpg", native = TRUE)earth <- rasterGrob(earth, interpolate = TRUE)
2. 数据映射由于航空公司十分多,就挑选几个有名的航空公司进行可视化。(1) Lufthansa(德国汉莎航空公司)ggplot() +annotation_custom(earth, xmin = -180, xmax = 180, ymin = -90, ymax = 90) +geom_path(aes(long, lat, group = id, color = name), alpha = 0.0, size = 0.0, data = flights_fortified) +geom_path(aes(long, lat, group = id, color = name), alpha = 0.2, size = 0.3, color = "#f9ba00", data = flights_fortified[flights_fortified$name == "Lufthansa", ]) +geom_point(data = flights_points[flights_points$name == "Lufthansa", ], aes(long, lat), alpha = 0.8, size = 0.1, colour = "white") +theme(panel.background = element_rect(fill = "#05050f", colour = "#05050f"),panel.grid.major = element_blank(),panel.grid.minor = element_blank(),axis.title = element_blank(),axis.text = element_blank(),axis.ticks.length = unit(0, "cm"),legend.position = "none") +annotate("text", x = -150, y = -18, hjust = 0, size = 14,label = paste("Lufthansa"), color = "#f9ba00", family = "Helvetica Black") +annotate("text", x = -150, y = -26, hjust = 0, size = 8,label = paste("Flight routes"), color = "white") +annotate("text", x = -150, y = -30, hjust = 0, size = 7,label = paste("ytlogos.github.io || NASA.gov || OpenFlights.org"), color = "white", alpha = 0.5) +coord_equal()
(2) Emirates(阿联酋航空公司)
ggplot() +annotation_custom(earth, xmin = -180, xmax = 180, ymin = -90, ymax = 90) +geom_path(aes(long, lat, group = id, color = name), alpha = 0.0, size = 0.0, data = flights_fortified) +geom_path(aes(long, lat, group = id, color = name), alpha = 0.2, size = 0.3, color = "#ff0000", data = flights_fortified[flights_fortified$name == "Emirates", ]) +geom_point(data = flights_points[flights_points$name == "Emirates", ], aes(long, lat), alpha = 0.8, size = 0.1, colour = "white") +theme(panel.background = element_rect(fill = "#05050f", colour = "#05050f"),panel.grid.major = element_blank(),panel.grid.minor = element_blank(),axis.title = element_blank(),axis.text = element_blank(),axis.ticks.length = unit(0, "cm"),legend.position = "none") +annotate("text", x = -150, y = -18, hjust = 0, size = 14,label = paste("Emirates"), color = "#ff0000", family = "Fontin") +annotate("text", x = -150, y = -26, hjust = 0, size = 8,label = paste("Flight routes"), color = "white") +annotate("text", x = -150, y = -30, hjust = 0, size = 7,label = paste("ytlogos.github.io || NASA.gov || OpenFlights.org"), color = "white", alpha = 0.5) +coord_equal()
(3) British Airways(英国航空公司)
ggplot() +annotation_custom(earth, xmin = -180, xmax = 180, ymin = -90, ymax = 90) +geom_path(aes(long, lat, group = id, color = name), alpha = 0.0, size = 0.0, data = flights_fortified) +geom_path(aes(long, lat, group = id, color = name), alpha = 0.2, size = 0.3, color = "#075aaa", data = flights_fortified[flights_fortified$name == "British Airways", ]) +geom_point(data = flights_points[flights_points$name == "British Airways", ], aes(long, lat), alpha = 0.8, size = 0.1, colour = "white") +theme(panel.background = element_rect(fill = "#05050f", colour = "#05050f"),panel.grid.major = element_blank(),panel.grid.minor = element_blank(),axis.title = element_blank(),axis.text = element_blank(),axis.ticks.length = unit(0, "cm"),legend.position = "none") +annotate("text", x = -150, y = -18, hjust = 0, size = 14,label = paste("BRITISH AIRWAYS"), color = "#075aaa", family = "Baker Signet Std") +annotate("text", x = -150, y = -26, hjust = 0, size = 8,label = paste("Flight routes"), color = "white") +annotate("text", x = -150, y = -30, hjust = 0, size = 7,label = paste("ytlogos.github.io || NASA.gov || OpenFlights.org"), color = "white", alpha = 0.5) +coord_equal()
(4) Air China(中国国航)
ggplot() +annotation_custom(earth, xmin = -180, xmax = 180, ymin = -90, ymax = 90) +geom_path(aes(long, lat, group = id, color = name), alpha = 0.0, size = 0.0, data = flights_fortified) +geom_path(aes(long, lat, group = id, color = name), alpha = 0.2, size = 0.3, color = "#F70C15", data = flights_fortified[flights_fortified$name == "Air China"
eb76
, ]) +geom_point(data = flights_points[flights_points$name == "Air China", ], aes(long, lat), alpha = 0.8, size = 0.1, colour = "white") +theme(panel.background = element_rect(fill = "#05050f", colour = "#05050f"),panel.grid.major = element_blank(),panel.grid.minor = element_blank(),axis.title = element_blank(),axis.text = element_blank(),axis.ticks.length = unit(0, "cm"),legend.position = "none") +annotate("text", x = -150, y = -18, hjust = 0, size = 14,label = paste("Air China"), color = "#F70C15", family = "Times New Roman") +annotate("text", x = -150, y = -26, hjust = 0, size = 8,label = paste("Flight routes"), color = "white") +annotate("text", x = -150, y = -30, hjust = 0, size = 7,label = paste("ytlogos.github.io || NASA.gov || OpenFlights.org"), color = "white", alpha = 0.5) +coord_equal()
(5) China Southern Airlines(中国南航)ggplot() +annotation_custom(earth, xmin = -180, xmax = 180, ymin = -90, ymax = 90) +geom_path(aes(long, lat, group = id, color = name), alpha = 0.0, size = 0.0, data = flights_fortified) +geom_path(aes(long, lat, group = id, color = name), alpha = 0.2, size = 0.3, color = "#004D9D", data = flights_fortified[flights_fortified$name == "China Southern Airlines", ]) +geom_point(data = flights_points[flights_points$name == "China Southern Airlines", ], aes(long, lat), alpha = 0.8, size = 0.1, colour = "white") +theme(panel.background = element_rect(fill = "#05050f", colour = "#05050f"),panel.grid.major = element_blank(),panel.grid.minor = element_blank(),axis.title = element_blank(),axis.text = element_blank(),axis.ticks.length = unit(0, "cm"),legend.position = "none") +annotate("text", x = -150, y = -18, hjust = 0, size = 14,label = paste("China Southern Airlines"), color = "#004D9D", family = "Times New Roman") +annotate("text", x = -150, y = -26, hjust = 0, size = 8,label = paste("Flight routes"), color = "white") +annotate("text", x = -150, y = -30, hjust = 0, size = 7,label = paste("ytlogos.github.io || NASA.gov || OpenFlights.org"), color = "white", alpha = 0.5) +coord_equal()
(6) 一次性映射多家航空公司航行路线
#抽取数据集flights_subset <- c("Lufthansa", "Emirates", "British Airways")flights_subset <- flights_fortified[flights_fortified$name %in% flights_subset, ]flights_subset_points <- flights_subset%>%group_by(group)%>%filter(row_number()==1|row_number()==n())#可视化ggplot() +annotation_custom(earth, xmin = -180, xmax = 180, ymin = -90, ymax = 90) +geom_path(aes(long, lat, group = id, color = name), alpha = 0.2, size = 0.3, data = flights_subset) +geom_point(data = flights_subset_points, aes(long, lat), alpha = 0.8, size = 0.1, colour = "white") +scale_color_manual(values = c("#f9ba00", "#ff0000", "#075aaa")) +theme(panel.background = element_rect(fill = "#05050f", colour = "#05050f"),panel.grid.major = element_blank(),panel.grid.minor = element_blank(),axis.title = element_blank(),axis.text = element_blank(),axis.ticks.length = unit(0, "cm"),legend.position = "none") +annotate("text", x = -150, y = -4, hjust = 0, size = 14,label = paste("Lufthansa"), color = "#f9ba00", family = "Helvetica Black") +annotate("text", x = -150, y = -11, hjust = 0, size = 14,label = paste("Emirates"), color = "#ff0000", family = "Fontin") +annotate("text", x = -150, y = -18, hjust = 0, size = 14,label = paste("BRITISH AIRWAYS"), color = "#075aaa", family = "Baker Signet Std") +annotate("text", x = -150, y = -30, hjust = 0, size = 8,label = paste("Flight routes"), color = "white") +annotate("text", x = -150, y = -34, hjust = 0, size = 7,label = paste("ytlogos.github.io || NASA.gov || OpenFlights.org"), color = "white", alpha = 0.5) +coord_equal()
三、 SessionInfo
sessionInfo()R version 3.4.3 (2017-11-30)Platform: x86_64-w64-mingw32/x64 (64-bit)Running under: Windows >= 8 x64 (build 9200)Matrix products: default
locale:[1] LC_COLLATE=Chinese (Simplified)_China.936 LC_CTYPE=Chinese (Simplified)_China.936[3] LC_MONETARY=Chinese (Simplified)_China.936 LC_NUMERIC=C[5] LC_TIME=Chinese (Simplified)_China.936
attached base packages:[1] grid stats graphics grDevices utils datasets methods base
other attached packages:[1] plyr_1.8.4 jpeg_0.1-8 geosphere_1.5-7 data.table_1.10.4-3[5] forcats_0.2.0 stringr_1.2.0 dplyr_0.7.4 purrr_0.2.4[9] readr_1.1.1 tidyr_0.8.0 tibble_1.4.2 ggplot2_2.2.1.9000[13] tidyverse_1.2.1 pacman_0.4.6
loaded via a namespace (and not attached): [1] Rcpp_0.12.15 cellranger_1.1.0 pillar_1.1.0 compiler_3.4.3 bindr_0.1 [6] tools_3.4.3 lubridate_1.7.1 jsonlite_1.5 nlme_3.1-131 gtable_0.2.0[11] lattice_0.20-35 pkgconfig_2.0.1 rlang_0.1.6 psych_1.7.8 cli_1.0.0[16] rstudioapi_0.7 yaml_2.1.16 parallel_3.4.3 haven_1.1.1 bindrcpp_0.2[21] xml2_1.2.0 httr_1.3.1 knitr_1.19 hms_0.4.1 glue_1.2.0[26] R6_2.2.2 readxl_1.0.0 foreign_0.8-69 sp_1.2-7 modelr_0.1.1[31] reshape2_1.4.3 magrittr_1.5 scales_0.5.0.9000 rvest_0.3.2 assertthat_0.2.0[36] mnormt_1.5-5 colorspace_1.3-2 stringi_1.1.6 lazyeval_0.2.1 munsell_0.4.3[41] broom_0.4.3 crayon_1.3.4
往期精彩内容整理合集 2017年R语言发展报告(国内)R语言中文社区历史文章整理(作者篇)
R语言中文社区历史文章整理(类型篇)
公众号后台回复关键字即可学习回复 R R语言快速入门及数据挖掘
回复 Kaggle案例 Kaggle十大案例精讲(连载中)
回复 文本挖掘 手把手教你做文本挖掘
回复 可视化 R语言可视化在商务场景中的应用
回复 大数据 大数据系列免费视频教程
回复 量化投资 张丹教你如何用R语言量化投资
回复 用户画像 京东大数据,揭秘用户画像
回复 数据挖掘 常用数据挖掘算法原理解释与应用
回复 机器学习 人工智能系列之机器学习与实践
回复 爬虫 R语言爬虫实战案例分享
相关文章推荐
- R语言利用wordcloud2绘制词云
- python之利用Pygal+2010年世界人口=绘制世界地图
- caffe利用draw_net.py绘制net结构
- C#中利用LightningChart绘制曲线(及LightningChart介绍)
- 利用R语言的DMwR包处理样本不平衡
- Python 利用matplotlib绘制热力图 correlation heatmap X,Y 坐标轴字体重叠显示问题,将字体进行旋转
- 利用meshgrid函数绘制二维高斯函数曲面
- R语言绘制空间热力图
- ASP.NET利用VML绘制统计图
- iOS中利用CAGradientLayer绘制渐变色的方法实例
- R语言书籍的学习路线图
- Unity LineRenderer绘制物体行走路线
- 利用C语言的Cairo图形库绘制太极图实例教程
- 利用R语言对RNA-Seq进行探索分析与差异表达分析
- Android入门——利用Canvas完成绘制点、圆、直线、路径、椭圆、多边形等2D图形
- 现实世界的Windows Azure 视频:新南威尔士州教育部(DET)利用Windows Azure实现在线科学测验
- 利用TChart绘制直方图
- MKDirections绘制导航路线
- 利用Arcgis for javascript API绘制GeoJSON并同时弹出多个Popup
- 利用C#实现分形树的绘制