geom_sf 具有相同空间比例的小型多张地图
Small multiple maps with geom_sf at the same spatial scale
我想用 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))
这并不理想,但您可以使用相同的框大小以编程方式绘制多个图,然后然后使用::gridExtra 将它们放在一起。要获得每个框的中心,请使用每个几何体的质心。
library(sf)
library(geobr)
library(mapview)
library(ggplot2)
library(gridExtra)
阅读巴西所有州:
states <- geobr::read_state(code_state = 'all', year=2015)
Select六个州:
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
有点 hack,但这里有一个可能的 tmap
解决方案,它基于计算不同状态的最大宽度,然后创建一个 "dummy" 点间隔层 max_width/2从每个状态的质心到 "force" 一个恒定的刻面宽度,因此是一个恒定的比例:
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
,给出:
大多数时候我更喜欢 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 here,然后您可以添加其他几个 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)
我想用 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))
这并不理想,但您可以使用相同的框大小以编程方式绘制多个图,然后然后使用::gridExtra 将它们放在一起。要获得每个框的中心,请使用每个几何体的质心。
library(sf)
library(geobr)
library(mapview)
library(ggplot2)
library(gridExtra)
阅读巴西所有州:
states <- geobr::read_state(code_state = 'all', year=2015)
Select六个州:
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
有点 hack,但这里有一个可能的 tmap
解决方案,它基于计算不同状态的最大宽度,然后创建一个 "dummy" 点间隔层 max_width/2从每个状态的质心到 "force" 一个恒定的刻面宽度,因此是一个恒定的比例:
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
,给出:
大多数时候我更喜欢 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 here,然后您可以添加其他几个 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)