Reputation: 3737
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)
}
Upvotes: 3
Views: 2466
Reputation: 3986
For the circle we can buffer the bounding box for, say, London by the radius of that bounding box about its centroid. That buffer can then be used to intersect our initial map data.
I'm not sure how you would go about adding 'zoom lines' between the circle and map because they are two separate plots.
I've used sf
to do the reading in of the data and rmapshaper
to simplify the shape for faster plotting. The file you linked has a level of detail that is probably not required for an overview of the UK.
Create map data for testing
library(sf)
library(tidyverse)
library(rmapshaper)
nuts1 <- read_sf('http://geoportal1-ons.opendata.arcgis.com/datasets/01fd6b2d7600446d8af768005992f76a_0.geojson')
# simplify geometries
nuts1_simp <- ms_simplify(nuts1, keep=0.02)
# add some random data to make chloropleth
set.seed(100)
nuts1_simp <- nuts1_simp %>% mutate(value = sample(1:20,12)) %>%
st_transform(27700)
# create initial map
my_map <- ggplot() +
geom_sf(data = nuts1_simp, aes(fill = value), col = 'black', size = 0.2) +
theme_minimal() +
theme(panel.grid.major = element_line(colour = "transparent"))
I left your extract_legend function unchanged:
extract_legend <- function(map) {
tmp <- ggplot_gtable(ggplot_build(map))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)
}
Updated map_zoom function:
stringsAsFactors = F
in locations data.frame as this was
previously returning the factor levels when coercing to numeric
rather than actual values.added calculations for the centroid of our location bounding box, as
well as for the max radius of that bbox
. This allows us to create a
buffer with st_buffer
retreived the data from the original map with ggplot_build
and intersected with the buffer to create our circular shaped zoomed_map
.
map_zoom <- function(map, location="London", layout=rbind(c(1, 1, 1),
c(1, 3, 2),
c(1, 1, 1))) {
require(grid)
require(gridExtra)
require(sf)
#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)),
stringsAsFactors = F)
xlim <- as.numeric(locations[locations[,1] == location,2:3])
ylim <- as.numeric(locations[locations[,1] == location,4:5])
location_bbox <- as.numeric(locations[locations[,1] == location,2:5])
bbox_radius <- max((location_bbox[2] - location_bbox[1])/2, (location_bbox[4] - location_bbox[3])/2)
bbox_centroid<- data.frame(x = (location_bbox[1]+location_bbox[2])/2, y = (location_bbox[3]+location_bbox[4])/2) %>%
st_as_sf(coords = c('x','y'), crs = 27700)
buffer <- st_buffer(bbox_centroid, bbox_radius)
# get data from input map
map_data <- ggplot_build(map)$data[[1]]%>% st_sf
zoom_dat <- map_data %>% mutate(colid = factor(row_number())) %>% st_intersection(buffer)
zoomed_map <- ggplot() +
geom_sf(data = zoom_dat, aes(fill=colid), size = 0.2, col='black')+
scale_fill_manual(values=zoom_dat$fill)+
labs(subtitle = location) +
scale_x_continuous(expand = c(0,0))+
scale_y_continuous(expand = c(0,0))+
coord_sf(xlim = xlim, ylim = ylim) +
theme_minimal()+
theme(legend.position = "none",
plot.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid.major = element_line(colour = "transparent"))
legend <- extract_legend(map)
map <- map + theme(legend.position="none")
map <- grid.arrange(map, zoomed_map, legend,
layout_matrix = layout)
return(map)
}
map_zoom(my_map, layout=rbind(c(1, 1, 1),
c(3, 1, 2),
c(1, 1, 1)))
Upvotes: 4