如何使用 R 修复跨越国际日期变更线的路径
How to remedy a path that crosses the international dateline with R
阿罗哈!我正在尝试使用 R 和一系列 Lat/Lon 点在世界地图上绘制多艘船的路径。
一切都很好,直到船越过国际日期变更线 (-180/180),路径在地图上跳跃。
我尝试在 R 中应用 st_wrap_dateline() 函数,但它看起来只适用于具有两个点的数据集,一个开始和结束坐标。
下面是我的 R 代码以及生成的绘图的屏幕截图 - 非常感谢任何帮助!
# Download background Blue Marble Globe image
download.file("https://www.researchvessels.org/images/nasa_base_v2.png", "nasa_base_v2.png", mode="wb")
# Download ship lat/lon data
download.file("https://www.researchvessels.org/images/shipdata.RDATA", "shipdata.RDATA", mode="wb")
load("shipdata.RDATA", envir = parent.frame(), verbose=TRUE)
# Ensure that the required packages are installed
list.of.packages <- c("ggplot2", "sf", "dplyr", "png", "grid")
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
if(length(new.packages)>0) {install.packages(new.packages)}
library(ggplot2)
library(sf)
library(dplyr)
library(png)
library(grid)
bluemarble_bg <- png::readPNG("nasa_base_v2.png")
xlim = c(-180.0,180.0)
ylim = c(-90.0,90.0)
shiptracks$Date.Time <- as.POSIXct(shiptracks$Date.Time, tz="GMT", origin="1970-01-01")
pal <- c("ShipA" = "#488f31",
"ShipB" = "#FF00FF",
"ShipC" = "#fff1a9",
"ShipD" = "#f19d61",
"ShipE" = "#de425b")
shiptracks %>% group_by(Vessels.Name)
shiptracks <- st_as_sf(shiptracks, coords=c("Lon", "Lat")) %>% st_set_crs(4326)
shiptracks <- cbind(shiptracks, st_coordinates(shiptracks))
shiptracks <- shiptracks %>%
st_sf() %>%
st_wrap_dateline(options = c("WRAPDATELINE=YES", "DATELINEOFFSET=180"),
quiet = FALSE) %>%
sf::st_sf(crs = 4326)
shipmap <- ggplot(shiptracks, aes(x=X, y=Y, group = Vessels.Name)) +
coord_sf(xlim = xlim, ylim = ylim, expand = FALSE,
crs = 4326,
datum = sf::st_crs(4326), label_graticule = waiver(),
label_axes = waiver(), ndiscr = 100, default = FALSE,
clip = "on") +
annotation_custom(rasterGrob(bluemarble_bg,
width = unit(1,"npc"),
height = unit(1,"npc")),
-Inf, Inf, -Inf, Inf) +
geom_path(data = shiptracks, group = shiptracks$Vessels.Name, color=pal[shiptracks$Vessels.Name],
aes(x=X, y=Y), cex=1, show.legend = TRUE) +
geom_point(data = shiptracks, group = shiptracks$Vessels.Name, color=pal[shiptracks$Vessels.Name], aes(x=X, y=Y), cex=1, show.legend = TRUE) +
theme(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.background = element_blank(),
panel.border = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_blank(),
plot.margin = unit(c(0, 0, 0, 0), "mm"),
panel.spacing = unit(0, "mm"),
legend.position = c(-120, -20),
legend.title = element_text(size = 7),
legend.text = element_text(size = 5),
legend.key.size = unit(0.01, "npc"))
shipmap
在你 运行 st_wrap_dateline
你有一个 POINT
几何图形的数据框。点不能越过日期变更线,所以什么都没有改变。
您需要通过分组和构建来创建 LINESTRING
或 MULTILINESTRING
几何图形的数据框,因此您最终会得到每条船舶航迹一行,而不是每个船舶位置一行分组变量。
然后 st_wrap_dateline
会将日期线处的对象拆分为 MULTILINESTRING
个对象。
然后您可以在 ggplot
调用中使用 geom_sf
来绘制线条,这些线条将在日期变更线处被分成几部分。
第 1 步,从轨道创建线条:
tracks = shiptracks %>% group_by(Vessels.Name) %>%
summarise(do_union=FALSE) %>% st_cast("LINESTRING")
ggplot() + geom_sf(data=tracks,aes(col=Vessels.Name))
现在包装它并绘制:
tracks = st_wrap_dateline(tracks)
ggplot() + geom_sf(data=tracks,aes(col=Vessels.Name))
(提示:请尝试将您的代码保持在最低限度 - 我在这方面的第一次努力失败了,因为您必须使用我所拥有的某些东西的更新版本,以及您的情节中的众多选项之一(waiver()
我认为)没有被识别。简化一切有时也会揭示问题所在,或者至少可以更快地找到它。它还鼓励人们回答。当我第一次看到这个和它的 60 行时我不想再看下去的代码。)
阿罗哈!我正在尝试使用 R 和一系列 Lat/Lon 点在世界地图上绘制多艘船的路径。
一切都很好,直到船越过国际日期变更线 (-180/180),路径在地图上跳跃。
我尝试在 R 中应用 st_wrap_dateline() 函数,但它看起来只适用于具有两个点的数据集,一个开始和结束坐标。
下面是我的 R 代码以及生成的绘图的屏幕截图 - 非常感谢任何帮助!
# Download background Blue Marble Globe image
download.file("https://www.researchvessels.org/images/nasa_base_v2.png", "nasa_base_v2.png", mode="wb")
# Download ship lat/lon data
download.file("https://www.researchvessels.org/images/shipdata.RDATA", "shipdata.RDATA", mode="wb")
load("shipdata.RDATA", envir = parent.frame(), verbose=TRUE)
# Ensure that the required packages are installed
list.of.packages <- c("ggplot2", "sf", "dplyr", "png", "grid")
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
if(length(new.packages)>0) {install.packages(new.packages)}
library(ggplot2)
library(sf)
library(dplyr)
library(png)
library(grid)
bluemarble_bg <- png::readPNG("nasa_base_v2.png")
xlim = c(-180.0,180.0)
ylim = c(-90.0,90.0)
shiptracks$Date.Time <- as.POSIXct(shiptracks$Date.Time, tz="GMT", origin="1970-01-01")
pal <- c("ShipA" = "#488f31",
"ShipB" = "#FF00FF",
"ShipC" = "#fff1a9",
"ShipD" = "#f19d61",
"ShipE" = "#de425b")
shiptracks %>% group_by(Vessels.Name)
shiptracks <- st_as_sf(shiptracks, coords=c("Lon", "Lat")) %>% st_set_crs(4326)
shiptracks <- cbind(shiptracks, st_coordinates(shiptracks))
shiptracks <- shiptracks %>%
st_sf() %>%
st_wrap_dateline(options = c("WRAPDATELINE=YES", "DATELINEOFFSET=180"),
quiet = FALSE) %>%
sf::st_sf(crs = 4326)
shipmap <- ggplot(shiptracks, aes(x=X, y=Y, group = Vessels.Name)) +
coord_sf(xlim = xlim, ylim = ylim, expand = FALSE,
crs = 4326,
datum = sf::st_crs(4326), label_graticule = waiver(),
label_axes = waiver(), ndiscr = 100, default = FALSE,
clip = "on") +
annotation_custom(rasterGrob(bluemarble_bg,
width = unit(1,"npc"),
height = unit(1,"npc")),
-Inf, Inf, -Inf, Inf) +
geom_path(data = shiptracks, group = shiptracks$Vessels.Name, color=pal[shiptracks$Vessels.Name],
aes(x=X, y=Y), cex=1, show.legend = TRUE) +
geom_point(data = shiptracks, group = shiptracks$Vessels.Name, color=pal[shiptracks$Vessels.Name], aes(x=X, y=Y), cex=1, show.legend = TRUE) +
theme(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.background = element_blank(),
panel.border = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_blank(),
plot.margin = unit(c(0, 0, 0, 0), "mm"),
panel.spacing = unit(0, "mm"),
legend.position = c(-120, -20),
legend.title = element_text(size = 7),
legend.text = element_text(size = 5),
legend.key.size = unit(0.01, "npc"))
shipmap
在你 运行 st_wrap_dateline
你有一个 POINT
几何图形的数据框。点不能越过日期变更线,所以什么都没有改变。
您需要通过分组和构建来创建 LINESTRING
或 MULTILINESTRING
几何图形的数据框,因此您最终会得到每条船舶航迹一行,而不是每个船舶位置一行分组变量。
然后 st_wrap_dateline
会将日期线处的对象拆分为 MULTILINESTRING
个对象。
然后您可以在 ggplot
调用中使用 geom_sf
来绘制线条,这些线条将在日期变更线处被分成几部分。
第 1 步,从轨道创建线条:
tracks = shiptracks %>% group_by(Vessels.Name) %>%
summarise(do_union=FALSE) %>% st_cast("LINESTRING")
ggplot() + geom_sf(data=tracks,aes(col=Vessels.Name))
现在包装它并绘制:
tracks = st_wrap_dateline(tracks)
ggplot() + geom_sf(data=tracks,aes(col=Vessels.Name))
(提示:请尝试将您的代码保持在最低限度 - 我在这方面的第一次努力失败了,因为您必须使用我所拥有的某些东西的更新版本,以及您的情节中的众多选项之一(waiver()
我认为)没有被识别。简化一切有时也会揭示问题所在,或者至少可以更快地找到它。它还鼓励人们回答。当我第一次看到这个和它的 60 行时我不想再看下去的代码。)