Nicholas
Nicholas

Reputation: 3737

R - Map Zoom Function, making the plot a circle rather than a square

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)

}

enter image description here

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

Answers (1)

Chris
Chris

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:

  • added 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)))

enter image description here

Upvotes: 4

Related Questions