Маленькие несколько карт с geom_sf в одном и том же пространственном масштабе

Question

Я хотел бы построить фигуру с несколькими маленькими картами, используя ggplot2::geom_sf. Задача здесь состоит в том, как сделать так, чтобы все карты были в центре изображения и в одном и том же пространственном масштабе. Вот проблема (данные для воспроизводимого примера ниже):

Простая карта, использующая facet_wrap, помещает все полигоны в одном пространственном масштабе, но они не центрированы.

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

Вот решение этого ТА вопроса , в котором используется 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

Я обнаружил ту же проблему, используя 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)

Желаемый вывод

Вывод, который я хотел бы получить, выглядит примерно так:

Данные для воспроизводимого примера

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

Answer 1

Немного хак, но вот возможное решение tmap, основанное на вычислении максимальной ширины различных состояний, а затем создании "фиктивного" слоя точек, разнесенных max_width / 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

, что дает:

Answer 2

Это не идеально, но вы можете программно создать несколько графиков с одинаковым размером блока и , а затем собрать их вместе, используя :: 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

Answer 3

В большинстве случаев я предпочитаю график для sf

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

Однако удаление оси также может быть эффективным

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

Как вы, вероятно, захотите добавить фон, добавьте опцию reset = FALSE, как объяснено здесь , и вы можете добавить несколько другихsf или звезды объектов

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)