sfnetwork morph to_spatial_contracted simplyfy TRUE

42 Views Asked by At

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)

enter image description here

0

There are 0 best solutions below