Применить st_intersection к вложенному фрейму данных с map2 - PullRequest
0 голосов
/ 12 сентября 2018

Попытка применить функцию к вложенному фрейму данных.Пример данных:

# required packages
library(dplyr)
library(sf)
library(tidyr)
library(purrr)

# sample data
ln1 <- data.frame(
  id = c(1,1,2,2),
  lon = c(1,4,4,9),
  lat = c(2,9,9,5)
)

ln2 <- data.frame(
  id = c(1,1,2,2),
  lon = c(3,3,6,6),
  lat = c(15,0,15,0)
)

# function for creating an "sf" object
make_sf_lns <- function(x) {
  x %>% st_as_sf(coords = c("lon", "lat"), dim = "XY") %>% 
    st_set_crs(4326) %>% 
    group_by(id) %>% summarise(geometry = st_union(geometry)) %>% 
    st_cast("LINESTRING")
}

# converting data to "sf" objects - "LINESTRING"s
ln1 <- make_sf_lns(ln1)
ln2 <- make_sf_lns(ln2)

Следующая строка кода представляет то, что я намерен сделать:

st_intersection(ln1, ln2)

Но по определенной причине мне нужно применить st_intersection к вложенному фрейму данных, напримерследующее:

# implementation with `tidyr::nest` and `purrr::map2`
ln1 <- ln1 %>% group_by(id) %>% nest()

map2(ln1$data, ln2, ~ st_intersection(.x, .y))

Когда я делаю это, ожидаемый результат представляет собой вложенный фрейм данных с точками пересечения, но вместо этого появляется следующая ошибка:

Error in st_crs(x) == st_crs(y) : Expecting a single value: [extent=2].
In addition: Warning message:
In if (is.na(x)) NA_crs_ else if (inherits(x, "crs")) x else if 
(is.numeric(x)) CPL_crs_from_epsg(as.integer(x)) else if (is.character(x)) { :
  the condition has length > 1 and only the first element will be used

1 Ответ

0 голосов
/ 12 сентября 2018

Проблема в том, что map2 выполняет итерацию параллельно по всем входам, поэтому, помимо итерации по столбцу списка, он также пытается перебирать переменные ln2. Вместо этого используйте map и укажите второй аргумент внутри или после функции:

# iterate across the data column of this
ln1
#> # A tibble: 2 x 2
#>      id data        
#>   <dbl> <list>      
#> 1     1 <sf [1 × 1]>
#> 2     2 <sf [1 × 1]>

# don't iterate across the columns of this
ln2
#> Simple feature collection with 2 features and 1 field
#> geometry type:  LINESTRING
#> dimension:      XY
#> bbox:           xmin: 3 ymin: 0 xmax: 3 ymax: 15
#> epsg (SRID):    4326
#> proj4string:    +proj=longlat +datum=WGS84 +no_defs
#>   id               geometry
#> 1  1 LINESTRING (3 0, 3 15)
#> 2  2 LINESTRING (6 0, 6 15)

# equivalent: map(ln1$data, ~st_intersection(.x, ln2))
map(ln1$data, st_intersection, ln2)
#> although coordinates are longitude/latitude, st_intersection assumes that they are planar
#> Warning: attribute variables are assumed to be spatially constant
#> throughout all geometries
#> although coordinates are longitude/latitude, st_intersection assumes that they are planar
#> Warning: attribute variables are assumed to be spatially constant
#> throughout all geometries
#> [[1]]
#> Simple feature collection with 1 feature and 1 field
#> geometry type:  POINT
#> dimension:      XY
#> bbox:           xmin: 3 ymin: 6.666667 xmax: 3 ymax: 6.666667
#> epsg (SRID):    4326
#> proj4string:    +proj=longlat +datum=WGS84 +no_defs
#>   id           geometry
#> 1  1 POINT (3 6.666667)
#> 
#> [[2]]
#> Simple feature collection with 1 feature and 1 field
#> geometry type:  POINT
#> dimension:      XY
#> bbox:           xmin: 6 ymin: 7.4 xmax: 6 ymax: 7.4
#> epsg (SRID):    4326
#> proj4string:    +proj=longlat +datum=WGS84 +no_defs
#>   id      geometry
#> 1  2 POINT (6 7.4)

Для этого конкретного примера было бы более целесообразно сначала удалить из гнезда, но, вероятно, у вас есть случай, когда такой подход менее желателен.

...