├── 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 --------------------------------------------------------------------------------