Skip to content

Instantly share code, notes, and snippets.

# internaut/networkmap.R Created May 30, 2018

Three ways of plotting a network graph of nodes with geographic coordinates on a map
 # Plot a network graph of nodes with geographic coordinates on a map. # # Author: Markus Konrad # May 2018 # # This script shows three ways of plotting a network graph on a map. # The following information should be visualized (with the respective # aestethics added): # # * graph nodes with: # * position on map -> x,y position of the node # * node weight (degree of the node) -> node size # * node label -> also x,y position of the node # * edges between nodes with: # * edge weight -> edge width # * edge category -> edge color library(assertthat) library(dplyr) library(purrr) library(igraph) library(ggplot2) library(ggraph) library(ggmap) # -------------------------------------- # # Preparation: generate some random data # # -------------------------------------- # set.seed(123) N_EDGES_PER_NODE_MIN <- 1 N_EDGES_PER_NODE_MAX <- 4 N_CATEGORIES <- 4 country_coords_txt <- " 1 3.00000 28.00000 Algeria 2 54.00000 24.00000 UAE 3 139.75309 35.68536 Japan 4 45.00000 25.00000 'Saudi Arabia' 5 9.00000 34.00000 Tunisia 6 5.75000 52.50000 Netherlands 7 103.80000 1.36667 Singapore 8 124.10000 -8.36667 Korea 9 -2.69531 54.75844 UK 10 34.91155 39.05901 Turkey 11 -113.64258 60.10867 Canada 12 77.00000 20.00000 India 13 25.00000 46.00000 Romania 14 135.00000 -25.00000 Australia 15 10.00000 62.00000 Norway" # nodes come from the above table and contain geo-coordinates for some # randomly picked countries nodes <- read.delim(text = country_coords_txt, header = FALSE, quote = "'", sep = "", col.names = c('id', 'lon', 'lat', 'name')) # edges: create random connections between countries (nodes) edges <- map_dfr(nodes\$id, function(id) { n <- floor(runif(1, N_EDGES_PER_NODE_MIN, N_EDGES_PER_NODE_MAX+1)) to <- sample(1:max(nodes\$id), n, replace = FALSE) to <- to[to != id] categories <- sample(1:N_CATEGORIES, length(to), replace = TRUE) weights <- runif(length(to)) data_frame(from = id, to = to, weight = weights, category = categories) }) edges <- edges %>% mutate(category = as.factor(category)) # create the igraph graph object g <- graph_from_data_frame(edges, directed = F, vertices = nodes) # --------------------------------------------------------------------- # # Common data structures and ggplot objects for all the following plots # # --------------------------------------------------------------------- # # create a data frame for plotting the edges # join with nodes to get start and end positions for each # edge (x, y and xend, yend) 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)) # use the node degree for scaling the node sizes nodes\$weight = degree(g) # common plot theme maptheme <- theme(panel.grid = element_blank()) + theme(axis.text = element_blank()) + theme(axis.ticks = element_blank()) + theme(axis.title = element_blank()) + theme(legend.position = "bottom") + theme(panel.grid = element_blank()) + theme(panel.background = element_rect(fill = "#596673")) + theme(plot.margin = unit(c(0, 0, 0.5, 0), 'cm')) # common polygon geom for plotting the country shapes country_shapes <- geom_polygon(data = map_data('world'), aes(x = long, y = lat, group = group), fill = "#CECECE", color = "#515151", size = 0.15) # common coordinate system for all the following plots mapcoords <- coord_fixed(xlim = c(-150, 180), ylim = c(-55, 80)) # ------------------------------- # # Solution 1: ggplot + ggmap only # # ------------------------------- # # try to plot with scaled edge widths and node sizes # this will fail because we can only use the "size" aesthetic twice ggplot(nodes) + country_shapes + geom_curve(aes(x = x, y = y, xend = xend, yend = yend, # draw edges as arcs color = category, size = weight), data = edges_for_plot, curvature = 0.33, alpha = 0.5) + scale_size_continuous(guide = FALSE, range = c(0.25, 2)) + # scale for edge widths geom_point(aes(x = lon, y = lat, size = weight), # draw nodes shape = 21, fill = 'white', color = 'black', stroke = 0.5) + scale_size_continuous(guide = FALSE, range = c(1, 6)) + # scale for node size geom_text(aes(x = lon, y = lat, label = name), # draw text labels hjust = 0, nudge_x = 1, nudge_y = 4, size = 3, color = "white", fontface = "bold") + mapcoords + maptheme # Results in warning: "Scale for 'size' is already present. Adding another scale for # 'size', which will replace the existing scale." # now a plot with static node size: ggplot(nodes) + country_shapes + geom_curve(aes(x = x, y = y, xend = xend, yend = yend, # draw edges as arcs color = category, size = weight), data = edges_for_plot, curvature = 0.33, alpha = 0.5) + scale_size_continuous(guide = FALSE, range = c(0.25, 2)) + # scale for edge widths geom_point(aes(x = lon, y = lat), # draw nodes shape = 21, size = 3, fill = 'white', color = 'black', stroke = 0.5) + geom_text(aes(x = lon, y = lat, label = name), # draw text labels hjust = 0, nudge_x = 1, nudge_y = 4, size = 3, color = "white", fontface = "bold") + mapcoords + maptheme # ------------------------------------ # # Solution 2: ggplot2 + ggmap + ggraph # # ------------------------------------ # # prepare layout: use "manual" layout with geo-coordinates node_pos <- nodes %>% select(lon, lat) %>% rename(x = lon, y = lat) lay <- create_layout(g, 'manual', node.positions = node_pos) assert_that(nrow(lay) == nrow(nodes)) # use the node degree for scaling the node sizes lay\$weight <- degree(g) ggraph(lay) + country_shapes + geom_edge_arc(aes(color = category, edge_width = weight, # draw edges as arcs circular = FALSE), data = edges_for_plot, curvature = 0.33, alpha = 0.5) + scale_edge_width_continuous(range = c(0.5, 2), # scale for edge widths guide = FALSE) + geom_node_point(aes(size = weight), shape = 21, # draw nodes fill = "white", color = "black", stroke = 0.5) + scale_size_continuous(range = c(1, 6), guide = FALSE) + # scale for node widths geom_node_text(aes(label = name), repel = TRUE, size = 3, color = "white", fontface = "bold") + mapcoords + maptheme # --------------------------------------------------------------- # # Solution 3: the hacky way (overlay several ggplot "plot grobs") # --------------------------------------------------------------- # theme_transp_overlay <- theme( panel.background = element_rect(fill = "transparent", color = NA), plot.background = element_rect(fill = "transparent", color = NA) ) # the base plot showing only the world map p_base <- ggplot() + country_shapes + mapcoords + maptheme # first overlay: edges as arcs p_edges <- ggplot(edges_for_plot) + geom_curve(aes(x = x, y = y, xend = xend, yend = yend, # draw edges as arcs color = category, size = weight), curvature = 0.33, alpha = 0.5) + scale_size_continuous(guide = FALSE, range = c(0.5, 2)) + # scale for edge widths mapcoords + maptheme + theme_transp_overlay + theme(legend.position = c(0.5, -0.1), legend.direction = "horizontal") # second overlay: nodes as points p_nodes <- ggplot(nodes) + geom_point(aes(x = lon, y = lat, size = weight), shape = 21, fill = "white", color = "black", # draw nodes stroke = 0.5) + scale_size_continuous(guide = FALSE, range = c(1, 6)) + # scale for node size geom_text(aes(x = lon, y = lat, label = name), # draw text labels hjust = 0, nudge_x = 1, nudge_y = 4, size = 3, color = "white", fontface = "bold") + mapcoords + maptheme + theme_transp_overlay # combine the overlays to a full plot # proper positioning of the grobs can be tedious... I found that # using `ymin` works quite well but manual tweeking of the # parameter seems necessary p <- p_base + annotation_custom(ggplotGrob(p_edges), ymin = -74) + annotation_custom(ggplotGrob(p_nodes), ymin = -74) print(p)

### stewartli commented Jun 1, 2018

 very helpful. like it. thank you very much.
to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.