Skip to content

Instantly share code, notes, and snippets.

@pmur002
Created October 29, 2018 21:29
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save pmur002/c250e177c0da896f10970f6c66763e4a to your computer and use it in GitHub Desktop.
Save pmur002/c250e177c0da896f10970f6c66763e4a to your computer and use it in GitHub Desktop.
Lines between maps on multiple-map layout
## Main code based on https://www.r-spatial.org//r/2018/10/25/ggplot2-sf-3.html
library("ggplot2")
theme_set(theme_bw())
## Requires up to date gdal
## (e.g., from https://launchpad.net/~ubuntugis/+archive/ubuntu/ppa)
library("sf")
library("rworldmap")
library("rworldxtra")
world <- getMap(resolution = "high")
## Requires libgeos++dev (not [just] libgeos-dev)
library("rgeos")
world <- st_as_sf(world)
sites <- st_as_sf(data.frame(longitude = c(-80.15, -80.1), latitude = c(26.5,
26.8)), coords = c("longitude", "latitude"), crs = 4326,
agr = "constant")
(florida <- ggplot(data = world) +
geom_sf(fill = "antiquewhite1") +
geom_sf(data = sites, size = 4, shape = 23, fill = "darkred") +
annotate(geom = "text", x = -85.5, y = 27.5, label = "Gulf of Mexico",
color = "grey22", size = 4.5) +
coord_sf(xlim = c(-87.35, -79.5), ylim = c(24.1, 30.8)) +
xlab("Longitude")+ ylab("Latitude")+
theme(panel.grid.major = element_line(colour = gray(0.5), linetype = "dashed",
size = 0.5), panel.background = element_rect(fill = "aliceblue"),
panel.border = element_rect(fill = NA)))
(siteA <- ggplot(data = world) +
geom_sf(fill = "antiquewhite1") +
geom_sf(data = sites, size = 4, shape = 23, fill = "darkred") +
coord_sf(xlim = c(-80.25, -79.95), ylim = c(26.65, 26.95), expand = FALSE) +
annotate("text", x = -80.18, y = 26.92, label= "Site A", size = 6) +
theme_void() +
theme(panel.grid.major = element_line(colour = gray(0.5), linetype = "dashed",
size = 0.5), panel.background = element_rect(fill = "aliceblue"),
panel.border = element_rect(fill = NA)))
(siteB <- ggplot(data = world) +
geom_sf(fill = "antiquewhite1") +
geom_sf(data = sites, size = 4, shape = 23, fill = "darkred") +
coord_sf(xlim = c(-80.3, -80), ylim = c(26.35, 26.65), expand = FALSE) +
annotate("text", x = -80.23, y = 26.62, label= "Site B", size = 6) +
theme_void() +
theme(panel.grid.major = element_line(colour = gray(0.5), linetype = "dashed",
size = 0.5), panel.background = element_rect(fill = "aliceblue"),
panel.border = element_rect(fill = NA)))
arrowA <- data.frame(x1 = 18.5, x2 = 23, y1 = 9.5, y2 = 14.5)
arrowB <- data.frame(x1 = 18.5, x2 = 23, y1 = 8.5, y2 = 6.5)
ggplot() +
coord_equal(xlim = c(0, 28), ylim = c(0, 20), expand = FALSE) +
annotation_custom(ggplotGrob(florida), xmin = 0, xmax = 20, ymin = 0,
ymax = 20) +
annotation_custom(ggplotGrob(siteA), xmin = 20, xmax = 28, ymin = 11.25,
ymax = 19) +
annotation_custom(ggplotGrob(siteB), xmin = 20, xmax = 28, ymin = 2.5,
ymax = 10.25) +
## I'll draw the segments myself below
## geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), data = arrowA,
## arrow = arrow(), lineend = "round") +
## geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), data = arrowB,
## arrow = arrow(), lineend = "round") +
theme_void()
## Custom line segment stuff starts here
library(grid)
## grid.ls()
grid.force(redraw=FALSE)
## grid.ls()
points <- grid.grep("points", grep=TRUE, global=TRUE, viewports=TRUE)
# Site A
depth <- downViewport(attr(points[[2]], "vpPath"))
p2 <- grid.get(points[[2]])
grid.move.to(grobX(p2, 0) + unit(2, "mm"), grobY(p2, 0) + unit(2, "mm"))
upViewport(depth)
depth <- downViewport(attr(points[[4]], "vpPath"))
p4 <- grid.get(points[[4]])
cvp <- current.viewport()
pushViewport(viewport(xscale=cvp$xscale, yscale=cvp$yscale, clip="off"))
grid.line.to(grobX(p4, 180) - unit(2, "mm"), grobY(p4, 180) - unit(2, "mm"),
arrow=arrow())
upViewport(depth + 1)
## Site B
depth <- downViewport(attr(points[[1]], "vpPath"))
p1 <- grid.get(points[[1]])
grid.move.to(grobX(p1, 0) + unit(2, "mm"), grobY(p1, 0) - unit(1, "mm"))
upViewport(depth)
depth <- downViewport(attr(points[[5]], "vpPath"))
p5 <- grid.get(points[[5]])
cvp <- current.viewport()
pushViewport(viewport(xscale=cvp$xscale, yscale=cvp$yscale, clip="off"))
grid.line.to(grobX(p5, 180) - unit(2, "mm"), grobY(p5, 180) + unit(1, "mm"),
arrow=arrow())
upViewport(depth + 1)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment