R - map 缩放功能，使绘图成为圆形而不是正方形

Question

我从同事那里继承了一些代码，我正在努力“改进”。

本质上它需要一张 map ，然后放大一个位置，然后使用 gridExtra 将 map 和缩放 map 绑定(bind)在一起。

可以运行，功能如下:

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)

}

但是，我想将右侧放大的 map 制作成圆而不是正方形(然后希望在圆和它从中获取的坐标之间添加缩放线)。

我猜正方形(代表伦敦)来自向量:

c("London", 505000, 555000, 155000, 205000)

在 map_zoom 函数中，是否有一种简单的方法可以将正方形变成圆形，或者我是否必须找到特定半径内的每个 long/lat 来制作一个圆？

谢谢。

编辑:

Extract_Legend 函数是:

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)

}

Answer 1

对于圆，我们可以通过围绕其质心的边界框半径来缓冲伦敦的边界框。然后可以使用该缓冲区与我们的初始 map 数据相交。

我不确定您将如何在圆和 map 之间添加“缩放线”，因为它们是两个独立的图。

我使用 sf 读取数据，使用 rmapshaper 简化形状以加快绘图速度。您链接的文件的详细程度可能不需要了解英国概况。

创建用于测试的 map 数据

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"))

我没有更改您的 extract_legend 函数:

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)
}

更新的 map_zoom 函数:

• 在位置 data.frame 中添加了 stringsAsFactors = F，因为这是以前在强制转换为数字时返回因子水平而不是实际值。

• 为我们的位置边界框的质心添加了计算，如以及那个 bbox 的最大半径。这允许我们创建一个带 st_buffer

的缓冲区

• 使用 ggplot_build 从原始 map 中检索数据并与缓冲区相交以创建我们的圆形 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)))