I inherited some code off a colleague which I am trying to 'improve'.
Essentially it takes a map, and will then zoom in on a location, which then uses gridExtra to bind the map and zoomed map together.
It works, and the function is below:
map_zoom <- function(map, location="London", layout=rbind(c(1, 1, 1),
c(1, 3, 2),
c(1, 1, 1))) {
###
#
# Input: a pre-existing map of the UK,
# and details of where to zoom in
#
# Output: the input map, with the zoomed in map inset
#
###
require(grid)
require(gridExtra)
#A data frame of where to zoom for various locations in the UK
locations <- data.frame(rbind(
c("London", 505000, 555000, 155000, 205000),
c("Liverpool & Manchester", 330000, 400000, 370000, 440000),
c("Leeds & Sheffield", 400000, 470000, 370000, 440000),
c("Coventry & Birmingham", 380000, 450000, 250000, 320000),
c("Edinburgh & Glasgow", 230000, 370000, 630000, 700000),
c("Cambridge", 500000, 570000, 220000, 290000),
c("Oxford", 420000, 490000, 170000, 240000),
c("Bristol", 310000, 380000, 140000, 210000)))
xlim <- as.numeric(locations[locations[,1] == location,2:3])
ylim <- as.numeric(locations[locations[,1] == location,4:5])
zoomed_map <- map +
labs(subtitle = location) +
theme(legend.position = "none",
#plot.margin = unit(c(2,-5,2,2), "cm"),
plot.title = element_blank()) +
coord_fixed(1, xlim = xlim, ylim = ylim)
legend <- extract_legend(map)
map <- map + theme(legend.position="none")
map <- grid.arrange(map, zoomed_map, legend,
layout_matrix = layout)
return(map)
}
However, I want to make the right zoomed in map a circle instead of a square (and then hopefully add zoom lines between the circle and the coordinates that it is taking it from).
I am guessing the square (for London) comes from the vector:
c("London", 505000, 555000, 155000, 205000)
In the map_zoom
function, is there an easy way to change the square into a circle, or would I have to find every long/lat in a certain radius to make a circle?
Thank you.
Edit:
The Extract_Legend function is:
extract_legend <- function(map) {
###
#
# Input: a ggplot object with a legend
#
# Output: a ggplot object of just the legend
#
###
tmp <- ggplot_gtable(ggplot_build(map))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)
}