如何创建多行字符串 sf 对象以在 Leaflet 地图中创建时间滑块

Question

我正在尝试创建一张传单地图，其中显示了一年中不同月份的不同移动路径。 IE。我有一个显示每月多次旅程的数据集，我想使用 leaflet.extras2 包的 addTimeslider 功能分别显示每个月的移动路径。

为此，我一直在尝试调整我在此处找到的 SymbolixAU 发布的代码：leaflet add multiple polylines

此代码使用包括 st_linestring 在内的 sf 函数来创建一个对象，该对象可提供给 addPolylines 传单函数以一次显示所有移动路径。

我很确定我的目的（每个月分别显示数据）我必须使用 st_multilinestring，它需要一个矩阵列表，其中包含每行多条折线的坐标（每行一行月）而不是每行一条折线。

一旦我有了它，我想我可以将该对象提供给 leaflet.extras2 的 addTimeslider 函数来实现我需要的。我对此非常确定，因为当我在 AddTimeslider 功能中使用使用 sf_linestring 创建的 sf 对象时，我能够一次将地图上的时间滑块用于单独的移动路径。

但是，我已经尝试了几个小时，但一直没有成功。非常感谢任何指点，谢谢。

一些示例数据：

#load packages

library(dplyr)
library(leaflet)
library(leaflet.extras2)
library(sf)
library(data.table)

# create the example dataset

data <- structure(list(arrival_month = structure(c(3L, 3L, 4L, 4L, 4L, 
5L, 5L, 6L, 6L, 6L), .Label = c("January", "February", "March", 
"April", "May", "June", "July", "August", "September", "October", 
"November", "December"), class = c("ordered", "factor")), start_lat = c(33.40693, 
33.64672, 33.57127, 33.42848, 33.54936, 33.53418, 33.60399, 33.49554, 
33.5056, 33.61696), start_long = c(-112.0298, -111.9255, -112.049, 
-112.0998, -112.0912, -112.0911, -111.9273, -111.9687, -112.0563, 
-111.9866), finish_lat...4 = c(33.40687, 33.64776, 33.57125, 
33.42853, 33.54893, 33.53488, 33.60401, 33.49647, 33.5056, 33.61654
), finish_lat...5 = c(-112.0343, -111.9303, -112.0481, -112.0993, 
-112.0912, -112.0911, -111.931, -111.9711, -112.0541, -111.986
)), row.names = c(NA, -10L), class = c("data.table", "data.frame"
), .internal.selfref = <pointer: 0x0000026e5df41ef0>)

我对代码的尝试：


# Convert the data into a list of matrices for each month

mnths <- c("May","March","April","June")


mat_list <- list()



for (i in mnths) {
  
  month <- as.matrix(data %>% filter(arrival_month == i) %>% select(-1)) 
  mat_list[[i]] <- month
  
}

# convert to an sf object


data_DT <- setDT(data)

sf <- data_DT[
  , {
    geometry <- sf::st_multilinestring(x = mat_list)
    geometry <- sf::st_sfc(geometry)
    geometry <- sf::st_sf(geometry = geometry)
  }
  , by = arrival_month
  ]

sf <- sf::st_as_sf(sf)

这会产生以下结果：

这是不正确的，因为每一行都包含所有月份的坐标，而不仅仅是相应行中月份的坐标。我不知道从哪里开始 - 任何帮助将不胜感激。

谢谢

Answer 1

今天我会稍微不同，利用 {sfheaders} 构建线串。

library(sfheaders)
library(sf)
library(data.table)


setDT( data )

data[, line_id := .I ]  ## Assuming each row is a line

## create a long-form of the data
dt_line <- rbindlist(
  list(
    data[, .(arrival_month, line_id, lon = start_long, lat = start_lat, sequence = 1)]
    , data[, .(arrival_month, line_id, lon = finish_lat...5, lat = finish_lat...4, sequence = 2)] ## I think 'finish_lat...5' is actually the 'long' 
  )
)

setorder(dt_line, line_id, sequence)

sf <- sfheaders::sf_multilinestring(
  obj = dt_line
  , x = "lon"
  , y = "lat"
  , multilinestring_id = "arrival_month"
  , linestring_id = "line_id"
  , keep = T
)

sf::st_crs( sf ) <- 4326 ## Assuming it's in Web Mercator 

# Simple feature collection with 4 features and 2 fields
# Geometry type: MULTILINESTRING
# Dimension:     XY
# Bounding box:  xmin: -112.0998 ymin: 33.40687 xmax: -111.9255 ymax: 33.64776
# Geodetic CRS:  WGS 84
#.  arrival_month sequence                       geometry
# 1             3        1 MULTILINESTRING ((-112.0298...
# 2             4        1 MULTILINESTRING ((-112.049 ...
# 3             5        1 MULTILINESTRING ((-112.0911...
# 4             6        1 MULTILINESTRING ((-111.9687...

注意 arrival_month 已重新编码为它的因子水平。

Answer 2

我设法调整了 SymbolixAU 提供的代码以满足我的目的，使用 sf_multilinestring 而不是 sf_line 字符串：

## Generate data

data <- structure(list(arrival_month = structure(c(3L, 3L, 4L, 4L, 4L, 
5L, 5L, 6L, 6L, 6L), .Label = c("January", "February", "March", 
"April", "May", "June", "July", "August", "September", "October", 
"November", "December"), class = c("ordered", "factor")), start_lat = c(33.40693, 
33.64672, 33.57127, 33.42848, 33.54936, 33.53418, 33.60399, 33.49554, 
33.5056, 33.61696), start_long = c(-112.0298, -111.9255, -112.049, 
-112.0998, -112.0912, -112.0911, -111.9273, -111.9687, -112.0563, 
-111.9866), finish_lat...4 = c(33.40687, 33.64776, 33.57125, 
33.42853, 33.54893, 33.53488, 33.60401, 33.49647, 33.5056, 33.61654
), finish_lat...5 = c(-112.0343, -111.9303, -112.0481, -112.0993, 
-112.0912, -112.0911, -111.931, -111.9711, -112.0541, -111.986
)), row.names = c(NA, -10L), class = c("data.table", "data.frame"
))

## Add id column and convert to data table

data[, line_id := .I ]

setDT(data)

## create a long-form of the data

dt_line <- rbindlist(
  list(
    data[, .(arrival_month, line_id, lon = start_long, lat = start_lat, sequence = 1)]
    , data[, .(arrival_month, line_id, lon = finish_lat...5, lat = finish_lat...4, sequence = 2)] ## I think 'finish_lat...5' is actually the 'long' 
  )
)

setorder(dt_line, line_id, sequence)

## Create multistring sf object

sf <- sfheaders::sf_multilinestring(
  obj = dt_line
  , x = "lon"
  , y = "lat"
  , linestring_id = "line_id"
  , multilinestring_id = "arrival_month"
  , keep = TRUE
)

sf::st_as_sf(sf)

## Convert arrival_month back to factor

sf$arrival_month <- as.factor(sf$arrival_month)

可能不是最优雅的，但这个可以。

关键是使用 sf_multilinestring 和 include/specify linestring_id 和 multilinestring_id 来区分不同的多段线。

这是结果：

现在，当在 AddTimeslider 中使用此 sf 对象时，它的行为符合预期。

大部分代码归功于 SymbolixAU，并让我注意到 sfheaders 包

如何创建多行字符串 sf 对象以在 Leaflet 地图中创建时间滑块

How to create multiline string sf object to create a time slider in Leaflet map

mapping

r-leaflet

sf