ggplot2(和 sf)中世界地图的整个地球多边形
whole earth polygon for world map in ggplot2 (and sf)
绘制世界地图时 ggplot2
存在一个问题:它用相同的颜色为整个背景着色,包括实际上不属于地球的地块的角,请参见下面的快照由以下代码生成(它使用前沿 sf
abd ggplot2
版本,但问题是通用的,请参阅下面提到的博客 post):
#install.packages("devtools")
#devtools::install_github("tidyverse/ggplot2")
#devtools::install_github("edzer/sfr")
library(ggplot2)
library(sf)
library(rnaturalearth)
library(dplyr)
theme_map <- function(...) {
theme_minimal() +
theme(
text = element_text(family = "Ubuntu Regular", color = "#22211d"),
axis.line = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.minor = element_line(color = "#ebebe5", size = 0.2),
panel.grid.major = element_line(color = "#ebebe5", size = 0.2),
plot.background = element_rect(fill = "#f5f5f2", color = NA),
panel.background = element_rect(fill = "#f5f5f2", color = NA),
legend.background = element_rect(fill = "#f5f5f2", color = NA),
panel.border = element_blank(),
...
)
}
crs <- "+proj=laea +lat_0=52 +lon_0=10 +x_0=4321000 +y_0=3210000 +datum=WGS84 +units=m +no_defs"
ctrys50m <- ne_countries(scale = 50, type = "countries", returnclass = "sf") %>%
select(iso_a3, iso_n3, admin)
ggplot() +
geom_sf(data = ctrys50m, alpha = 0.15, fill="grey") +
coord_map() +
coord_sf(crs = crs) +
theme_map()
为了能够很好地绘制地球轮廓,在D3.js
中添加了一个特殊的GeoJSONtype
,{type: "Sphere"}
,参见this thread which can be seen in action here:它是以下快照中整个地球的外部黑色边框:
我在 R
/ggplot2
中找到的唯一 技巧 是 Matt Strimas-Mackey 在他的博客条目 Mapping the Longest Commericial Flights in R, see the Bounding box and graticules 部分以及 make_bbox
和 project_recenter
函数。
这些代码很多,我想知道是否有一些
sf
或 geom_sf
代码会生成 cleaner/simpler 代码,所以我尝试了:
# whole world WSG84 bounding box
sphere <- ne_download(category = "physical", type = "wgs84_bounding_box", returnclass = "sf")
sphere_laea <- st_transform(sphere, crs)
ggplot() +
geom_sf(data = sphere, fill = "#D8F4FF") +
coord_sf(crs = crs) +
geom_sf(data = ctrys50m, alpha = 0.15, fill="grey") +
coord_map() +
coord_sf(crs = crs) +
theme_map()
我得到的只是一个额外的 "anti-meridian"(注意来自北极的线...)并且没有充满 #D8F4FF
的 海洋 。 .
底部的多边形非常不规则(D3.js 大师做了一些聪明的 adaptive resampling 来提高投影线的准确性...)
关于我为 ggplot2 世界地图获取整个世界多边形的尝试有什么问题吗?
(感谢您阅读到这里!)
我还在探索 sf
的魔力的过程中,因此可能有更直接的解决方案来解决您的问题。不过,您可能会发现这种方法很有用:
为了提取地球球体的多边形,只需使用所需投影的经纬网,创建一个凸包并合并生成的多边形。
library(ggplot2)
library(sf)
library(rnaturalearth)
library(dplyr)
crs <- "+proj=laea +lat_0=52 +lon_0=10 +x_0=4321000 +y_0=3210000
+datum=WGS84 +units=m +no_defs"
ctrys50m <- ne_countries(scale = 50, type = "countries", returnclass = "sf") %>%
select(iso_a3, iso_n3, admin)
sphere <- st_graticule(st_transform(ctrys50m, crs = crs)) %>%
st_convex_hull() %>%
summarise(geometry = st_union(geometry))
ggplot() +
geom_sf(data = sphere, fill = "#D8F4FF", alpha = 0.7) +
geom_sf(data = ctrys50m, fill="grey") +
#coord_sf(crs = crs) + # not necessary because the crs from the first layer is being used.
theme_bw()
这为您提供了以下图,它仍然有一些可见的角,但根据您的目的可能已经足够了。
按照 Dave 的建议,我创建了一个足够小的新经纬网,以便凸包操作能够很好地逼近地球的边界。
下面的代码给出了很好的结果(见后图):
library(ggplot2)
library(sf)
library(rnaturalearth)
library(dplyr)
crs <- "+proj=laea +lat_0=52 +lon_0=10 +x_0=4321000 +y_0=3210000 +datum=WGS84 +units=m +no_defs"
ctrys50m <- ne_countries(scale = 50, type = "countries", returnclass = "sf") %>%
select(iso_a3, iso_n3, admin)
sphere <- st_graticule(ndiscr = 10000, margin = 10e-6) %>%
st_transform(crs = crs) %>%
st_convex_hull() %>%
summarise(geometry = st_union(geometry))
ggplot() +
geom_sf(data = sphere, fill = "#D8F4FF", alpha = 0.7) +
geom_sf(data = ctrys50m, fill="grey") +
theme_bw()
绘制世界地图时 ggplot2
存在一个问题:它用相同的颜色为整个背景着色,包括实际上不属于地球的地块的角,请参见下面的快照由以下代码生成(它使用前沿 sf
abd ggplot2
版本,但问题是通用的,请参阅下面提到的博客 post):
#install.packages("devtools")
#devtools::install_github("tidyverse/ggplot2")
#devtools::install_github("edzer/sfr")
library(ggplot2)
library(sf)
library(rnaturalearth)
library(dplyr)
theme_map <- function(...) {
theme_minimal() +
theme(
text = element_text(family = "Ubuntu Regular", color = "#22211d"),
axis.line = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.minor = element_line(color = "#ebebe5", size = 0.2),
panel.grid.major = element_line(color = "#ebebe5", size = 0.2),
plot.background = element_rect(fill = "#f5f5f2", color = NA),
panel.background = element_rect(fill = "#f5f5f2", color = NA),
legend.background = element_rect(fill = "#f5f5f2", color = NA),
panel.border = element_blank(),
...
)
}
crs <- "+proj=laea +lat_0=52 +lon_0=10 +x_0=4321000 +y_0=3210000 +datum=WGS84 +units=m +no_defs"
ctrys50m <- ne_countries(scale = 50, type = "countries", returnclass = "sf") %>%
select(iso_a3, iso_n3, admin)
ggplot() +
geom_sf(data = ctrys50m, alpha = 0.15, fill="grey") +
coord_map() +
coord_sf(crs = crs) +
theme_map()
为了能够很好地绘制地球轮廓,在D3.js
中添加了一个特殊的GeoJSONtype
,{type: "Sphere"}
,参见this thread which can be seen in action here:它是以下快照中整个地球的外部黑色边框:
我在 R
/ggplot2
中找到的唯一 技巧 是 Matt Strimas-Mackey 在他的博客条目 Mapping the Longest Commericial Flights in R, see the Bounding box and graticules 部分以及 make_bbox
和 project_recenter
函数。
这些代码很多,我想知道是否有一些
sf
或 geom_sf
代码会生成 cleaner/simpler 代码,所以我尝试了:
# whole world WSG84 bounding box
sphere <- ne_download(category = "physical", type = "wgs84_bounding_box", returnclass = "sf")
sphere_laea <- st_transform(sphere, crs)
ggplot() +
geom_sf(data = sphere, fill = "#D8F4FF") +
coord_sf(crs = crs) +
geom_sf(data = ctrys50m, alpha = 0.15, fill="grey") +
coord_map() +
coord_sf(crs = crs) +
theme_map()
我得到的只是一个额外的 "anti-meridian"(注意来自北极的线...)并且没有充满 #D8F4FF
的 海洋 。 .
底部的多边形非常不规则(D3.js 大师做了一些聪明的 adaptive resampling 来提高投影线的准确性...)
关于我为 ggplot2 世界地图获取整个世界多边形的尝试有什么问题吗? (感谢您阅读到这里!)
我还在探索 sf
的魔力的过程中,因此可能有更直接的解决方案来解决您的问题。不过,您可能会发现这种方法很有用:
为了提取地球球体的多边形,只需使用所需投影的经纬网,创建一个凸包并合并生成的多边形。
library(ggplot2)
library(sf)
library(rnaturalearth)
library(dplyr)
crs <- "+proj=laea +lat_0=52 +lon_0=10 +x_0=4321000 +y_0=3210000
+datum=WGS84 +units=m +no_defs"
ctrys50m <- ne_countries(scale = 50, type = "countries", returnclass = "sf") %>%
select(iso_a3, iso_n3, admin)
sphere <- st_graticule(st_transform(ctrys50m, crs = crs)) %>%
st_convex_hull() %>%
summarise(geometry = st_union(geometry))
ggplot() +
geom_sf(data = sphere, fill = "#D8F4FF", alpha = 0.7) +
geom_sf(data = ctrys50m, fill="grey") +
#coord_sf(crs = crs) + # not necessary because the crs from the first layer is being used.
theme_bw()
这为您提供了以下图,它仍然有一些可见的角,但根据您的目的可能已经足够了。
按照 Dave 的建议,我创建了一个足够小的新经纬网,以便凸包操作能够很好地逼近地球的边界。 下面的代码给出了很好的结果(见后图):
library(ggplot2)
library(sf)
library(rnaturalearth)
library(dplyr)
crs <- "+proj=laea +lat_0=52 +lon_0=10 +x_0=4321000 +y_0=3210000 +datum=WGS84 +units=m +no_defs"
ctrys50m <- ne_countries(scale = 50, type = "countries", returnclass = "sf") %>%
select(iso_a3, iso_n3, admin)
sphere <- st_graticule(ndiscr = 10000, margin = 10e-6) %>%
st_transform(crs = crs) %>%
st_convex_hull() %>%
summarise(geometry = st_union(geometry))
ggplot() +
geom_sf(data = sphere, fill = "#D8F4FF", alpha = 0.7) +
geom_sf(data = ctrys50m, fill="grey") +
theme_bw()