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

Question

我从一位同事那里继承了一些我正在尝试“改进”的代码。

基本上它需要一张地图，然后放大一个位置，然后使用 gridExtra 将地图和缩放后的地图绑定在一起。

有效，功能如下：

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)

}

但是，我想让右侧放大的地图变成圆形而不是正方形（然后希望在圆形和它所取的坐标之间添加缩放线）。

我猜这个正方形（伦敦）来自向量：

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

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

谢谢。

编辑：

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

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

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

我使用sf 读取数据并使用rmapshaper 简化形状以加快绘图速度。您链接的文件的详细程度可能不是英国概览所必需的。

为测试创建地图数据

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

更新地图缩放功能：

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

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

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