I have a question regarding covert(., to_spatial_contracted, simplyfy = TRUE).
I like to run the morpher grouped on sf polygones. So first I create my sfnetwork (sf_ml) and polygon (poly).
Finally I run a spatial join, excluding the NA Values and run the morpher function. However, from here https://luukvdmeer.github.io/sfnetworks/articles/sfn05_morphers.html I expect "simplify = TRUE will remove the multiple and loop edges after contraction". But for me it seems like the there are still a lot non needed edges. The red line is the one I would expect.
SO: what do I get wrong?
library(sf)
library(sfnetworks)
s1 <- st_multilinestring(list(rbind(c(0,3), c(0,4))))
s2 <- st_multilinestring(list(rbind(c(0,4), c(1,5))))
s3 <- st_multilinestring(list(rbind(c(1,5), c(2,5))))
s4 <- st_multilinestring(list(rbind(c(2,5), c(2.5,5))))
s5 <- st_multilinestring(list(rbind(c(2.7,5), c(4,5))))
s6 <- st_multilinestring(list(rbind(c(4,5), c(4.5,4))))
s7 <- st_multilinestring(list(rbind(c(4.5,4), c(5,4))))
sf_ml <- st_sf(section = 1 ,geometry=st_sfc(list(s1,s2,s3,s4,s5,s6,s7)))
sf_ml$group <- c(1,1,2,NA,NA,2,1)
sf_ml <- st_cast(sf_ml, "LINESTRING")
sf_ml <- as_sfnetwork(sf_ml)
sf_ml <-sf_ml %>% mutate(random = 1:9 )
poly <- sf_ml %>% activate(nodes) %>%
filter(random == c(1,2,3)) %>%
st_as_sf(coords = c("lon", "lat"),
crs = 32611) %>%
st_bbox() %>%
st_as_sfc() %>%
st_buffer(., dist = 0.1) %>% st_sf() %>%
mutate(grouping_variable = 1)
poly1 <- sf_ml %>% activate(nodes) %>%
filter(random %in% c(4,5)) %>%
st_as_sf(coords = c("lon", "lat"),
crs = 32611) %>%
st_bbox() %>%
st_as_sfc() %>%
st_buffer(., dist = 0.1) %>% st_sf() %>%
mutate(grouping_variable = 2)
poly <- rbind(poly1, poly)
plot(sf_ml)
plot(poly, add = TRUE, fill = NULL)
test <- sf_ml %>% st_join(., poly)
test <- test %>% filter(!is.na(grouping_variable))
test2 <- convert(test, to_spatial_contracted, grouping_variable, summarise_attributes = list(
grouping_variable = "first",
random = "first"),simplyfy = TRUE, .clean = FALSE)
plot(sf_ml)
plot(st_as_sf(test2)["grouping_variable"], add = TRUE, cex = 2, pch = 20)
plot(test2, cex = 2, add= TRUE, pch = 20, col = "blue")
plot(test2 %>% activate(edges) %>% filter(!edge_is_loop()) %>% st_as_sf() %>% st_geometry(), col = "red", add = TRUE)
plot(test2 %>% activate(nodes) %>% st_as_sf() %>% st_geometry(), col = "red", add = TRUE)
