基于R的飞机航线数据可视化

## 加载库
library(ggplot2)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(tidyr)
library(RColorBrewer)
library(maps)
library(geosphere)
library(igraph)

## 
## Attaching package: 'igraph'

## The following object is masked from 'package:tidyr':
## 
##     crossing

## The following objects are masked from 'package:dplyr':
## 
##     as_data_frame, groups, union

## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum

## The following object is masked from 'package:base':
## 
##     union

library(networkD3)
library(stringr)

读取数据

## 读取数据，数据融合
routes <- read.csv("routes.csv",header=TRUE)
airports <- read.csv("airports.csv",header=TRUE)

在地图上可是化机场的位置

map(database = "world",col="skyblue", fill=TRUE, bg="black", lwd=0.1)
# 添加起点的位置
points(x=airports$Longitude, y=airports$Latitude, pch=19, cex=0.2,col="orange")

可视化每个国家有多少机场

### 可视化每个国家有多少机场
plotdata <- airports%>%group_by(Country)%>%
  summarise(number = n(),
            LatitudeMean = mean(Latitude),
            LongitudeMean = mean(Longitude))


## 在地图上可视化每个国家的机场数量
map(database = "world",col="skyblue", fill=TRUE, bg="black", lwd=0.1)
# 添加起点的位置
points(x=plotdata$LongitudeMean, y=plotdata$LatitudeMean,
       pch=19, cex=log10(plotdata$number),col="orange")

可视化机场较多的国家

data.frame(table(airports$Country)) %>% 
  arrange(desc(Freq)) %>% 
  head(20) %>% 
  ggplot(aes(x = reorder(Var1, -Freq), y = Freq, fill = Var1, label = Freq)) + 
  theme_bw(base_family = "STKaiti")+
  geom_bar(stat = "identity", show.legend = FALSE) +
  labs(title = "机场最多的20个国家", x="",y = "机场数量") +
  geom_label(angle = 45, show.legend = FALSE,size=3) +
  theme(axis.text.x = element_text(angle = 40, size = 10),
        plot.title = element_text(hjust = 0.5))

可视化航班之间的联系

##  数据组合
plotdata <- routes[c("source.airport","destination.apirport")]
## 剔除缺失值
plotdata <- plotdata[!is.na(plotdata[,1])&!is.na(plotdata[,2]),]
plotdata2 <- airports[c("IATA","Latitude","Longitude")]
plotdata3 <- merge(plotdata,plotdata2,by.x = "source.airport", by.y = "IATA")
plotdata4 <- merge(plotdata3,plotdata2,by.x = "destination.apirport", by.y = "IATA")

## 可视化航线
map(database = "world",col="skyblue", fill=TRUE, bg="black", lwd=0.1)
# 添加起点的位置
points(x=airports$Longitude, y=airports$Latitude, pch=19, cex=0.2,col="orange red")
col.1 <- adjustcolor("orange", alpha=0.4)

for(i in 1:nrow(plotdata4)) {
  node1 <- plotdata4[i,c("Latitude.x","Longitude.x")]
  node2 <- plotdata4[i,c("Latitude.y","Longitude.y")]
  arc <- gcIntermediate( c(node1$Longitude.x, node1$Latitude.x),
                         c(node2$Longitude.y, node2$Latitude.y),
                         n=100, addStartEnd=TRUE )
  lines(arc, col=col.1, lwd=0.1)
}

可视化美国的机场

##  数据准别
airportusa <- airports[airports$Country == "United States",]
index <- ((plotdata4$source.airport %in% airportusa$IATA)&
            (plotdata4$destination.apirport %in% airportusa$IATA))
plotdata4usa <- plotdata4[index,]

map("state",col="palegreen", fill=TRUE, bg="black", lwd=0.1)
# 添加起点的位置
points(x=airportusa$Longitude, y=airportusa$Latitude, pch=19, cex=0.4,col="orange")

col.1 <- adjustcolor("tomato", alpha=0.4)
## 添加边
for(i in 1:nrow(plotdata4usa)) {
  node1 <- plotdata4usa[i,c("Latitude.x","Longitude.x")]
  node2 <- plotdata4usa[i,c("Latitude.y","Longitude.y")]
  arc <- gcIntermediate( c(node1$Longitude.x, node1$Latitude.x),
                         c(node2$Longitude.y, node2$Latitude.y),
                         n=1000, addStartEnd=TRUE )
  lines(arc, col=col.1, lwd=0.2)
}

可视化国家之间飞机联系的多少

##  数据组合
plotdata <- routes[c("source.airport","destination.apirport")]
## 剔除缺失值
plotdata <- plotdata[!is.na(plotdata[,1])&!is.na(plotdata[,2]),]
plotdata2 <- airports[c("IATA","Country","Latitude","Longitude")]
plotdata3 <- merge(plotdata,plotdata2,by.x = "source.airport", by.y = "IATA")
plotdata4 <- merge(plotdata3,plotdata2,by.x = "destination.apirport", by.y = "IATA")

## 计算联系的多少
plotdata5 <- plotdata4%>%group_by(Country.x,Country.y)%>%
  summarise(connectnumber = n())%>%
  arrange(desc(connectnumber))
plotdata5 <- plotdata5[!(plotdata5$Country.x == plotdata5$Country.y),]

### 国家的位置
plotdataCountry <- airports%>%group_by(Country)%>%
  summarise(airportnumber = n(),
            LatitudeMean = mean(Latitude),
            LongitudeMean = mean(Longitude))

## 连接数据
plotdataall <- merge(plotdata5,plotdataCountry,by.x = "Country.x", by.y = "Country")
plotdataall <- merge(plotdataall,plotdataCountry,by.x = "Country.y", by.y = "Country")

## 在地图上可视化每个国家的机场数量
map(database = "world",col="skyblue", fill=TRUE, bg="black", lwd=0.1)
# 添加起点的位置
points(x=plotdataCountry$LongitudeMean, y=plotdataCountry$LatitudeMean,
       pch=19, cex=log10(plotdataCountry$airportnumber),col="orange red")

col.1 <- adjustcolor("orange", alpha=0.4)

for(i in 1:nrow(plotdataall)) {
  node1 <- plotdataall[i,c("LatitudeMean.x","LongitudeMean.x")]
  node2 <- plotdataall[i,c("LatitudeMean.y","LongitudeMean.y")]
  arc <- gcIntermediate( c(node1$LongitudeMean.x, node1$LatitudeMean.x),
                         c(node2$LongitudeMean.y, node2$LatitudeMean.y),
                         n=100, addStartEnd=TRUE )
  lwdi = log2(plotdataall$connectnumber[i])
  lines(arc, col=col.1, lwd=lwdi/2)
}

可视化国家之间的联系

## 国家之间的连接
plotdata <- plotdataall[,c("Country.y","Country.x","connectnumber","airportnumber.x")]
plotdata <- plotdata[plotdata$connectnumber > 50,]
## 机场数量
airportnum <- airports%>%group_by(Country)%>%
  summarise(airportnumber = n())

## 定义连接的数据
d <- plotdata[,c("Country.y","Country.x","connectnumber")]
type <- cut_interval(log(d$connectnumber),3)
levels(type) <- 1:3
d$etype <- as.numeric(type)
## 定义节点的属性
nodes <- unique(c(as.character(plotdata$Country.y),as.character(plotdata$Country.x)))
v <- airportnum[airportnum$Country %in%nodes,]
type <- cut_interval(10*log10(v$airportnumber),3)
levels(type) <- 1:3
v$vtype <- as.numeric(type)
## 定义网络图
g <- graph_from_data_frame(d,vertices = v,directed = TRUE)
E(g)$width <- log10(E(g)$connectnumber)

# Generate colors based on media type:
colrs <- c("gray50", "tomato", "gold")
V(g)$color <- colrs[V(g)$vtype]
E(g)$color <- colrs[E(g)$etype]


par(mfrow=c(2,2), mar=c(0,0,0,0)) # plot four figures - 2 rows, 2 columns
plot(g, layout =  layout_in_circle(g),
     edge.arrow.size=0.4,
     vertex.size = 10*log10(V(g)$airportnumber), 
     vertex.label.cex = 0.5)

plot(g, layout =  layout_with_fr(g),
     edge.arrow.size=0.4,
     vertex.size = 10*log10(V(g)$airportnumber), 
     vertex.label.cex = 0.5)

plot(g, layout =  layout_on_sphere(g),
     edge.arrow.size=0.4,
     vertex.size = 10*log10(V(g)$airportnumber), 
     vertex.label.cex = 0.5)
plot(g, layout =  layout_randomly(g),
     edge.arrow.size=0.4,
     vertex.size = 10*log10(V(g)$airportnumber), 
     vertex.label.cex = 0.5)

## 使用network3d可视化动态图
p <- igraph_to_networkD3(g,group = V(g)$vtype)
forceNetwork(Links = p$links, Nodes = p$nodes, 
             Source = 'source', Target = 'target', 
             NodeID = 'name', Group = 'group')