├── Flow Map in R.R
├── README.md
└── output maps
├── Rplot07.jpeg
├── Rplot08.png
├── Rplot09.png
└── Rplot10.png
/Flow Map in R.R:
--------------------------------------------------------------------------------
1 |
2 | ## This script shows how to create Flow Maps in R using ggplot2.
3 | ## source: This script is based on different bits of code from other people with amazing R skills:
4 |
5 | # @ceng_l : http://web.stanford.edu/~cengel/cgi-bin/anthrospace/great-circles-on-a-recentered-worldmap-in-ggplot
6 | # @3wen : http://egallic.fr/maps-with-r/
7 | # @spatialanalysis : http://spatialanalysis.co.uk/2012/06/mapping-worlds-biggest-airlines/
8 | # @freakonometrics : http://freakonometrics.hypotheses.org/48184
9 |
10 |
11 | # Libraries
12 | library(maps)
13 | library(geosphere)
14 | library(dplyr)
15 | library(ggplot2)
16 | library(rworldmap)
17 | library(plyr)
18 | library(data.table)
19 | library(ggthemes)
20 |
21 |
22 | # Get World map
23 | worldMap <- getMap()
24 | mapworld_df <- fortify( worldMap )
25 |
26 |
27 | # Read data on airports and flights
28 | airports <- read.csv("http://www.stanford.edu/~cengel/cgi-bin/anthrospace/wp-content/uploads/2012/03/airports.csv", as.is=TRUE, header=TRUE)
29 | flights <- read.csv("http://www.stanford.edu/~cengel/cgi-bin/anthrospace/wp-content/uploads/2012/03/PEK-openflights-export-2012-03-19.csv", as.is=TRUE, header=TRUE)
30 |
31 | # get airport locations
32 | airport_locations <- airports[, c("IATA","longitude", "latitude")]
33 |
34 | # aggregate number of flights (frequency of flights per pair)
35 | flights.ag <- ddply(flights, c("From","To"), function(x) count(x$To))
36 |
37 |
38 | # Link airport lat long to origin and destination
39 | OD <- left_join(flights.ag, airport_locations, by=c("From"="IATA") )
40 | OD <- left_join(OD, airport_locations, by=c("To"="IATA") )
41 | OD$id <-as.character(c(1:nrow(OD))) #create and id for each pair
42 |
43 |
44 |
45 | ##### Two Simple Maps #####
46 |
47 | # 1. Using straight lines
48 | ggplot() +
49 | geom_polygon(data= mapworld_df, aes(long,lat, group=group), fill="gray30") +
50 | geom_segment(data = OD, aes(x = longitude.x, y = latitude.x, xend = longitude.y, yend = latitude.y, color=freq),
51 | arrow = arrow(length = unit(0.01, "npc"))) +
52 | scale_colour_distiller(palette="Reds", name="Frequency", guide = "colorbar") +
53 | coord_equal()
54 |
55 |
56 | # 2. Using Curved Lines
57 | ggplot() +
58 | geom_polygon(data= mapworld_df, aes(long,lat, group=group), fill="gray30") +
59 | geom_curve(data = OD, aes(x = longitude.x, y = latitude.x, xend = longitude.y, yend = latitude.y, color=freq),
60 | curvature = -0.2, arrow = arrow(length = unit(0.01, "npc"))) +
61 | scale_colour_distiller(palette="Reds", name="Frequency", guide = "colorbar") +
62 | coord_equal()
63 |
64 |
65 |
66 | ##### A more professional map ####
67 | # Using shortest route between airports considering the spherical curvature of the planet
68 |
69 | # get location of Origin and destinations airports
70 | setDT(OD) # set OD as a data.table for faster data manipulation
71 | beijing.loc <- OD[ From== "PEK", .(longitude.x, latitude.x)][1] # Origin
72 | dest.loc <- OD[ , .(longitude.y, latitude.y)] # Destinations
73 |
74 | # calculate routes between Beijing (origin) and other airports (destinations)
75 | routes <- gcIntermediate(beijing.loc, dest.loc, 100, breakAtDateLine=FALSE, addStartEnd=TRUE, sp=TRUE)
76 | class(routes) # SpatialLines object
77 |
78 |
79 | # Convert a SpatialLines object into SpatialLinesDataFrame, so we can fortify and use it in ggplot
80 | # create empty data frate
81 | ids <- data.frame()
82 | # fill data frame with IDs for each line
83 | for (i in (1:length(routes))) {
84 | id <- data.frame(routes@lines[[i]]@ID)
85 | ids <- rbind(ids, id) }
86 |
87 | colnames(ids)[1] <- "ID" # rename ID column
88 |
89 | # convert SpatialLines into SpatialLinesDataFrame using IDs as the data frame
90 | routes <- SpatialLinesDataFrame(routes, data = ids, match.ID = T)
91 |
92 | # Fortify routes (convert to data frame) +++ join attributes
93 | routes_df <- fortify(routes, region= "ID") # convert into something ggplot can plot
94 | gcircles <- left_join(routes_df, OD, by= ("id"))
95 | head(gcircles)
96 |
97 | ### Recenter ####
98 |
99 | center <- 115 # positive values only - US centered view is 260
100 |
101 | # shift coordinates to recenter great circles
102 | gcircles$long.recenter <- ifelse(gcircles$long < center - 180 , gcircles$long + 360, gcircles$long)
103 |
104 | # shift coordinates to recenter worldmap
105 | worldmap <- map_data ("world")
106 | worldmap$long.recenter <- ifelse(worldmap$long < center - 180 , worldmap$long + 360, worldmap$long)
107 |
108 | ### Function to regroup split lines and polygons
109 | # takes dataframe, column with long and unique group variable, returns df with added column named group.regroup
110 | RegroupElements <- function(df, longcol, idcol){
111 | g <- rep(1, length(df[,longcol]))
112 | if (diff(range(df[,longcol])) > 300) { # check if longitude within group differs more than 300 deg, ie if element was split
113 | d <- df[,longcol] > mean(range(df[,longcol])) # we use the mean to help us separate the extreme values
114 | g[!d] <- 1 # some marker for parts that stay in place (we cheat here a little, as we do not take into account concave polygons)
115 | g[d] <- 2 # parts that are moved
116 | }
117 | g <- paste(df[, idcol], g, sep=".") # attach to id to create unique group variable for the dataset
118 | df$group.regroup <- g
119 | df
120 | }
121 |
122 | ### Function to close regrouped polygons
123 | # takes dataframe, checks if 1st and last longitude value are the same, if not, inserts first as last and reassigns order variable
124 | ClosePolygons <- function(df, longcol, ordercol){
125 | if (df[1,longcol] != df[nrow(df),longcol]) {
126 | tmp <- df[1,]
127 | df <- rbind(df,tmp)
128 | }
129 | o <- c(1: nrow(df)) # rassign the order variable
130 | df[,ordercol] <- o
131 | df
132 | }
133 |
134 | # now regroup
135 | gcircles.rg <- ddply(gcircles, .(id), RegroupElements, "long.recenter", "id")
136 | worldmap.rg <- ddply(worldmap, .(group), RegroupElements, "long.recenter", "group")
137 |
138 | # close polys
139 | worldmap.cp <- ddply(worldmap.rg, .(group.regroup), ClosePolygons, "long.recenter", "order") # use the new grouping var
140 |
141 |
142 |
143 | # Flat map
144 | ggplot() +
145 | geom_polygon(data=worldmap.cp, aes(long.recenter,lat,group=group.regroup), size = 0.2, fill="#f9f9f9", color = "grey65") +
146 | geom_line(data= gcircles.rg, aes(long.recenter,lat,group=group.regroup, color=freq), size=0.4, alpha= 0.5) +
147 | scale_colour_distiller(palette="Reds", name="Frequency", guide = "colorbar") +
148 | theme_map()+
149 | ylim(-60, 90) +
150 | coord_equal()
151 |
152 |
153 | # Spherical Map
154 | ggplot() +
155 | geom_polygon(data=worldmap.cp, aes(long.recenter,lat,group=group.regroup), size = 0.2, fill="#f9f9f9", color = "grey65") +
156 | geom_line(data= gcircles.rg, aes(long.recenter,lat,group=group.regroup, color=freq), size=0.4, alpha= 0.5) +
157 | scale_colour_distiller(palette="Reds", name="Frequency", guide = "colorbar") +
158 | # Spherical element
159 | scale_y_continuous(breaks = (-2:2) * 30) +
160 | scale_x_continuous(breaks = (-4:4) * 45) +
161 | coord_map("ortho", orientation=c(61, 90, 0))
162 |
163 |
164 | # Any ideas on how to color the oceans ? :)
165 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # Flow map in R using ggplot2
2 |
3 | ### This script shows how to create Flow Maps in R using `ggplot2`.
4 |
5 |
6 | **Source:** This script is based on different bits of code from other people with amazing R skills: [Claudia Engel](https://twitter.com/ceng_l) - [code](http://web.stanford.edu/~cengel/cgi-bin/anthrospace/great-circles-on-a-recentered-worldmap-in-ggplot) | [Ewen Gallic](https://twitter.com/3wen) - [code](http://egallic.fr/maps-with-r/) |
7 | [James Cheshire](https://twitter.com/spatialanalysis) - [code](http://spatialanalysis.co.uk/2012/06/mapping-worlds-biggest-airlines/) | [Arthur Charpentier](https://twitter.com/freakonometrics) - [code](http://freakonometrics.hypotheses.org/48184).
8 |
9 |
10 | ### Ouput Maps :
11 | Flat or Spherical Map:
12 |
13 |
;
14 |
15 |
16 |
--------------------------------------------------------------------------------
/output maps/Rplot07.jpeg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/rafapereirabr/flow-map-in-r-ggplot/3f733225c36bc639dc55d2756680c4175614562a/output maps/Rplot07.jpeg
--------------------------------------------------------------------------------
/output maps/Rplot08.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/rafapereirabr/flow-map-in-r-ggplot/3f733225c36bc639dc55d2756680c4175614562a/output maps/Rplot08.png
--------------------------------------------------------------------------------
/output maps/Rplot09.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/rafapereirabr/flow-map-in-r-ggplot/3f733225c36bc639dc55d2756680c4175614562a/output maps/Rplot09.png
--------------------------------------------------------------------------------
/output maps/Rplot10.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/rafapereirabr/flow-map-in-r-ggplot/3f733225c36bc639dc55d2756680c4175614562a/output maps/Rplot10.png
--------------------------------------------------------------------------------