R - Координаты пересечения линий в сюжете - PullRequest
Новая
       3

R - Координаты пересечения линий в сюжете

4 голосов
/ 06 января 2020

Структура данных выглядит следующим образом 

df1 <- structure(list(V2 = 1:10, V1 = c(1.4, 1.5, 1.9, 4.5, 6.7, 7.8, 
8.1, 8.2, 8.3, 8.9)), class = "data.frame", row.names = c(NA, -10L))

df2 <- structure(list(V2 = 1:10, V1 = c(1.43390152077191, 2.30610947613604, 
2.23775280718692, 5.41628585802391, 7.05710641788319, 8.77536501311697, 
8.48437852263451, 8.68867353517562, 8.7907762312796, 8.91225462416187
)), row.names = c(NA, -10L), class = "data.frame")

df3 <- structure(list(V2 = 1:10, V1 = c(2.04147320063785, 2.01257497165352, 
2.22035211822949, 5.08143315766938, 7.31734440829605, 8.23827453767881, 
8.27036898061633, 8.91508049662225, 9.04778654868715, 9.74391470812261
)), row.names = c(NA, -10L), class = "data.frame")

Я строю сюжет и получаю следующее изображение. 

dplyr::bind_rows(df1 = df1, df2 = df2, df3 = df3, .id = "id") %>%
  ggplot() +  aes(V2, V1, color = id) + 
  geom_line() + 
  theme(legend.position = "bottom")

enter image description here

Некоторые линии пересекаются, но эти пересечения, вероятно, отсутствуют в кадрах данных. Можно ли узнать координаты пересечений?

Ответы [ 2 ]

2 голосов
/ 07 января 2020

Вы можете найти координаты, если хотите сделать данные sf-объектом и рассматривать их как пространственные данные.

Добавление к опубликованному вами коду: 

library(sf)

df4 <- dplyr::bind_rows(df1 = df1, df2 = df2, df3 = df3, .id = "id")

df4_sf <- df4 %>%
  st_as_sf(coords = c('V2', 'V1')) %>%
  group_by(id) %>% 
  summarise(zz = 1) %>%  ## I'm not sure this line is needed.
  st_cast('LINESTRING')

# > df4_sf
# Simple feature collection with 3 features and 2 fields
# geometry type:  LINESTRING
# dimension:      XY
# bbox:           xmin: 1 ymin: 1.4 xmax: 10 ymax: 9.743915
# epsg (SRID):    NA
# proj4string:    NA
# # A tibble: 3 x 3
# id       zz                                                                                  geometry
# * <chr> <dbl>                                                                              <LINESTRING>
# 1 df1       1                   (1 1.4, 2 1.5, 3 1.9, 4 4.5, 5 6.7, 6 7.8, 7 8.1, 8 8.2, 9 8.3, 10 8.9)
# 2 df2       1 (1 1.433902, 2 2.306109, 3 2.237753, 4 5.416286, 5 7.057106, 6 8.775365, 7 8.484379, 8...
# 3 df3       1 (1 2.041473, 2 2.012575, 3 2.220352, 4 5.081433, 5 7.317344, 6 8.238275, 7 8.270369, 8...

Теперь есть три строки, каждая из которых представляет один из оригинальных df.

График с использованием geom_sf, показывающий, что он все тот же: 

 ggplot(df4_sf) + geom_sf(aes(color = id)) + theme(legend.position = 'bottom')

enter image description here

Мы видим, что только 2 и 3 пересекаются, поэтому мы рассмотрим только эти два. 

intersections <- st_intersections(df4_sf[2,], df4_sf[3,])
st_coordinates(intersections)

#            X        Y L1
#[1,] 1.674251 2.021989  1
#[2,] 4.562692 6.339562  1
#[3,] 5.326387 7.617924  1
#[4,] 7.485925 8.583651  1

И, наконец, построим все вместе: 

ggplot() +
  geom_sf(data = df4_sf, aes(color = id)) + 
  geom_sf(data = intersections) +
  theme(legend.position = 'bottom')

Дает нам этот сюжет :

enter image description here

0 голосов
/ 07 января 2020

Предполагая, что V2 дискретен и все data.frames имеют одинаковые значения для V2, другая опция использует optim, чтобы найти пересечения в каждом поддиапазоне: 

options(digits=20)
funcLs <- lapply(list(df1, df2, df3), function(DF) approxfun(DF$V2, DF$V1))    
X <- df1$V2

Filter(Negate(is.null), unlist(combn(funcLs, 2L, FUN=function(funcs) {
    mapply(function(lower, upper) {
        res <- optim((lower+upper)/2, function(x) abs(funcs[[1L]](x) - funcs[[2L]](x)), 
            method="Brent", lower=lower, upper=upper, control=list(reltol=1e-10))
        if (res$value < 1e-4 && res$convergence==0L) return(res$par)
    }, X[-length(X)], X[-1L])
}, simplify=FALSE), recursive=FALSE))

вывод: 

[[1]]
[1] 1.67425093704201

[[2]]
[1] 4.5626919006160991

[[3]]
[1] 5.3263874397151056

[[4]]
[1] 7.4859253126769065

чеки: 

sapply(ans, function(x) all.equal(funcLs[[2L]](x), funcLs[[3L]](x)))
#[1] TRUE TRUE TRUE TRUE
...