使用 openrouteservice-r 为位置数据框创建多个等时线

Creating multiple isochrones with openrouteservice-r for a dataframe of locations

我想做的事情:

我有一个包含多个点位置的 sf 对象。对于每个位置,我想使用 openrouteservice-r 包生成具有不同参数的等时线。

对象看起来像这样:

library(sf)
library(dplyr)
library(openrouteservice)
dd <- data.frame(x = c(-89.33, -89.33, -89.33, -89.33, -89.55, -89.55, -89.55, -89.55),
                 y = c(43.12, 43.12, 43.12, 43.12, 43.12, 43.12, 43.12, 43.12),
                 bike_type = c("bike", "bike", "e-bike", "e-bike", "bike", "bike", "e-bike", "e-bike"),
                 time = c(300, 600, 300, 600, 300, 600, 300, 600))

df <- st_as_sf(dd, coords = c("x","y"))
df

我创建了一个带有三个参数的辅助函数,通过 ors_isochrones 和 returns 等时线的几何形状(多边形)运行它们:

# requires API key: https://openrouteservice.org/dev/#/login
# ors_api_key(key, service = "openrouteservice")

create_iso <- function(location, profile_1 = "e-bike", range_1){
  iso <- ors_isochrones(locations = st_coordinates(location), 
                                 profile = ors_profile(mode = profile_1),
                                 range = range_1,
                       output = "sf")
  iso$geometry
}

我的想法是,现在我可以从 mutate 中调用该函数到位置数据框:

df  %>% 
  mutate(iso = create_iso(geometry, profile, time))

什么有效:

  1. df 的单行执行此操作:
> df[1,]  %>% 
+   mutate(iso = create_iso(geometry, bike_type, time))
[1] 300
Simple feature collection with 1 feature and 2 fields
Active geometry column: geometry
Geometry type: POINT
Dimension:     XY
Bounding box:  xmin: -89.33044 ymin: 43.12018 xmax: -89.33044 ymax: 43.12018
CRS:           NA
  bike_type time                   geometry                            iso
1      bike  300 POINT (-89.33044 43.12018) POLYGON ((-89.34975 43.1200...
  1. 在保持其他两个参数不变的情况下对 df 的多行执行此操作:
df[4:7,]  %>%
  mutate(iso = create_iso(geometry, "e-bike", 100))

什么不起作用

在提供所有三个参数的同时为多行执行此操作

df[4:7,]  %>% 
+   mutate(iso = create_iso(geometry, bike_type, time))
[1] 600 300 600 300
Error in `stopifnot()`:
! Problem while computing `iso = create_iso(geometry, bike_type,
  time)`.
Caused by error in `match.arg()`:
! 'arg' must be of length 1
Run `rlang::last_error()` to see where the error occurred.
Called from: signal_abort(cnd, .file)

完整的代表

library(sf)
#> Warning: package 'sf' was built under R version 4.1.3
#> Linking to GEOS 3.9.1, GDAL 3.2.1, PROJ 7.2.1; sf_use_s2() is TRUE
library(dplyr)
#> Warning: package 'dplyr' was built under R version 4.1.3
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(openrouteservice)
#> Registered S3 method overwritten by 'geojsonlint':
#>   method         from 
#>   print.location dplyr
dd <- data.frame(x = c(-89.33044, -89.33044, -89.33044, -89.33044, -89.55, -89.55, -89.55, -89.55),
                 y = c(43.12018, 43.12018, 43.12018, 43.12018, 43.12019, 43.12019, 43.12019, 43.12019),
                 bike_type = c("bike", "bike", "e-bike", "e-bike", "bike", "bike", "e-bike", "e-bike"),
                 time = c(300, 600, 300, 600, 300, 600, 300, 600))

df <- st_as_sf(dd, coords = c("x","y"))
df
#> Simple feature collection with 8 features and 2 fields
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: -89.55 ymin: 43.12018 xmax: -89.33044 ymax: 43.12019
#> CRS:           NA
#>   bike_type time                   geometry
#> 1      bike  300 POINT (-89.33044 43.12018)
#> 2      bike  600 POINT (-89.33044 43.12018)
#> 3    e-bike  300 POINT (-89.33044 43.12018)
#> 4    e-bike  600 POINT (-89.33044 43.12018)
#> 5      bike  300    POINT (-89.55 43.12019)
#> 6      bike  600    POINT (-89.55 43.12019)
#> 7    e-bike  300    POINT (-89.55 43.12019)
#> 8    e-bike  600    POINT (-89.55 43.12019)

create_iso <- function(location, profile_1 = "e-bike", range_1){
  print(range_1)
  iso <- ors_isochrones(locations = st_coordinates(location), 
                                 profile = ors_profile(mode = profile_1),
                                 range = range_1,
                       output = "sf")
  iso$geometry
}

x <- df[4:7,]  %>% 
  mutate(iso = create_iso(geometry, bike_type, time))
#> [1] 600 300 600 300
#> Error in `stopifnot()`:
#> ! Problem while computing `iso = create_iso(geometry, bike_type, time)`.
#> Caused by error in `match.arg()`:
#> ! 'arg' must be of length 1

reprex package (v2.0.1)

于 2022-04-14 创建

要将自定义函数应用于 data.frame 的每一行,您可以使用 rowwise():

library(dplyr)

df %>% 
  rowwise() %>% 
  mutate(iso = create_iso(geometry, bike_type, time))