代码之家  ›  专栏  ›  技术社区  ›  rafa.pereira

具有相同空间尺度geom_-sf的小型多重地图

  •  0
  • rafa.pereira  · 技术社区  · 5 年前

    我想用多个小地图绘制一个图形 ggplot2::geom_sf . 这里的挑战是如何做到这一点,使所有的地图在图像中居中,在相同的空间尺度。下面是问题(可重复示例的数据):

    使用 facet_wrap 将所有多边形放在同一空间比例上,但它们不居中。

    ggplot(states6) +
      geom_sf() +
      facet_wrap(~name_state)
    

    enter image description here

    这里有一个解决方案 SO question 使用 cowplot . 在这种情况下,多边形是居中的,但它们具有不同的空间尺度

    g <- purrr::map(unique(states6$name_state),
                    function(x) {
    
                      # subset data
                      temp_sf <- subset(states6, name_state == x)
    
                      ggplot() +
                        geom_sf(data = temp_sf, fill='black') +
                        guides(fill = FALSE) +
                        ggtitle(x) +
                        ggsn::scalebar(temp_sf, dist = 100, st.size=2, 
                                       height=0.01, model = 'WGS84', 
                                       transform = T, dist_unit='km') 
                        })
    
    g2 <- cowplot::plot_grid(plotlist = g)
    g2
    

    enter image description here

    我发现使用 tmap 图书馆。

     tm_shape(states6) +
       tm_borders(col='black') +
       tm_fill(col='black') +
       tm_facets(by = "name_state ", ncol=3) +
       tm_scale_bar(breaks = c(0, 50, 100), text.size = 3)
    

    期望输出

    我想要得到的输出类似于:

    enter image description here

    可复制示例的数据

    library(sf)
    library(geobr)
    library(mapview)
    library(ggplot2)
    library(ggsn)
    library(cowplot)
    library(purrr)
    library(tmap)
    
    # Read all Brazilian states
    states <- geobr::read_state(code_state = 'all', year=2015)
    
    # Select six states
    states6 <- subset(states, code_state %in% c(35,33,53,29,31,23))
    
    0 回复  |  直到 5 年前
        1
  •  2
  •   rafa.pereira    5 年前

    这并不理想,但您可以用相同的框大小和 然后 使用::gridExtra将它们组合在一起。要获得每个长方体的中心,请使用每个几何体的质心。

    library(sf)
    library(geobr)
    library(mapview)
    library(ggplot2)
    library(gridExtra)
    

    阅读所有巴西州:

    states <- geobr::read_state(code_state = 'all', year=2015)
    

    选择六个州:

    states6 <- subset(states, code_state %in% c(35,33,53,29,31,23))
    

    质心,在下面的ggplot中参考(我必须设置投影,如果需要,在这里进行更改):

    states6$centroid <- 
         sf::st_transform(states6, 29101) %>% 
         sf::st_centroid() %>% 
         sf::st_transform(., '+proj=longlat +ellps=GRS80 +no_defs')  %>% 
         sf::st_geometry()
    

    设置填充:

    padding <-7 
    

    绘图功能:

    graph <- function(x){
      ggplot2::ggplot(states6[x,]) +
               geom_sf() +
               coord_sf(xlim = c(states6$centroid[[x]][1]-padding , 
                                 states6$centroid[[x]][1]+padding), 
                        ylim = c(states6$centroid[[x]][2]-padding , 
                                 states6$centroid[[x]][2]+padding), 
                        expand = FALSE)
    }
    

    创建一组绘图:

    plot_list <- lapply(X = 1:nrow(states6), FUN = graph)
    

    将它们排列在一起:

    g <- cowplot::plot_grid(plotlist = plot_list, ncol = 3)
    g
    

    results

        2
  •  2
  •   lbusett Guest    5 年前

    有点麻烦,但有可能 tmap 解决方案基于计算不同状态的最大宽度,然后创建一个“虚拟”层,该层的点间距为每个状态的质心的最大宽度/2,以“强制”面的恒定宽度,从而实现恒定比例:

    library(sf)
    library(geobr)
    library(tmap)
    library(dplyr)
    
    # Read all Brazilian states
    states <- geobr::read_state(code_state = 'all', year=2015)
    
    # Select six states
    states6 <- subset(states, code_state %in% c(35,33,53,29,31,23)) %>% 
        sf::st_set_crs(4326)
    
    # compute bboxes and find width of the widest one
    bboxes <- lapply(sf::st_geometry(states6), 
                     FUN = function(x) as.numeric(st_bbox((x))))
    which_max_wid <- which.max(lapply(bbs, FUN = function(x) abs(x[1] - x[3])))              
    max_wid <- bbs[[which_max_wid]][1] - bbs[[which_max_wid]][3]
    
    # create some fake points, at a distance of max_wid/2 from 
    # centroids of each state, then a multipoint by state_name
    
    fake_points_min <- st_sf(name_state = states6$name_state, 
                             geometry = st_geometry(sf::st_centroid(states6)) - c(max_wid/2, 0))
    fake_points_max <- st_sf(name_state = states6$name_state, 
                             geometry = st_geometry(sf::st_centroid(states6)) + c(max_wid/2, 0))
    
    fake_points <- rbind(fake_points_min,fake_points_max) %>% 
        dplyr::group_by(name_state) %>% 
        dplyr::summarize() %>% 
        dplyr::ungroup() %>% 
        sf::st_set_crs(4326)
    
    # plot
    plot <- tm_shape(states6) +
        tm_graticules() +
        tm_borders(col='black') +
        tm_fill(col='black') +
        tm_facets(by = "name_state", ncol=3) +
        tm_scale_bar(breaks = c(0, 150, 300), text.size = 3) + 
        tm_shape(fake_points)  +  #here we add the point layer to force constant width!
        tm_dots(alpha = 0)+ 
        tm_facets(by = "name_state", ncol=3)
    plot
    

    ,给予:

    enter image description here

        3
  •  0
  •   Sergio    5 年前

    大多数时候我更喜欢科幻小说的情节

    library(sf)
    library(geobr)
    
    # Read all Brazilian states
    states <- geobr::read_state(code_state = 'all', year=2015)
    
    # Select six states
    states6 <- subset(states, code_state %in% c(35,33,53,29,31,23))
    
    par(mfrow = c(2, 3))
    for(i in 1:nrow(states6)){
      plot(states6$geometry[i], axes = T, main = states6$name_state[i])  
    }
    par(mfrow = c(1,1))
    

    enter image description here

    然而,去除轴也可以有效。

    par(mfrow = c(2, 3))
    for(i in 1:nrow(states6)){
      plot(states6$geometry[i], axes = F, main = states6$name_state[i])  
      axis(1)
      axis(2)
    }
    par(mfrow = c(1,1))
    

    enter image description here

    可能您想添加一个背景,如前所述添加reset=FALSE选项 here 你还可以添加一些其他的sf或stars对象

    EDIT1:你也可以试试imagemagick

    library(ggplot2)
    imas <- paste0(letters[1:6], ".png")
    for(i in 1:nrow(states6)) {
    png( imas[i])
      print(
        ggplot(states6[i,]) +
          geom_sf()  +
          ggtitle(states6$name_state[i])
    )  
      dev.off()
    }
    
    library(magick)
    a <- image_append(image = c(image_read(imas[1]), 
                           image_read(imas[2]),
                           image_read(imas[3])))
    
    
    b <- image_append(image = c(image_read(imas[4]), 
                                image_read(imas[5]),
                                image_read(imas[6])))
    
    image_append(c(a,b), stack = T)
    

    enter image description here