Test on real data (#46)

Co-authored-by: Claudiu Forgaci <[email protected]>

Author: fnattino

NEWS.md

@@ -9,6 +9,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 - DOI is added to CITATION.cff and README (badge)
 - Contributing guidelines are added to the package
+- A test on real (packaged) data is included
+
+## Changed
+
+- Data resized to city boundary (buffer is dropped)
 
 ## Fixed
 

R/data.R

@@ -2,5 +2,5 @@
 #'
 #' Data extracted from OpenStreetMap for testing the rcoins package.
 #'
-#' @source OpenStreetMap
+#' @source <https://www.openstreetmap.org/about>
 "bucharest"

data-raw/bucharest.R

@@ -51,24 +51,16 @@ get_osm_river <- function(river_name, bb, crs) {
   river_centerline <- osmdata_as_sf("waterway", "river", bb)
   river_centerline <- river_centerline$osm_multilines |>
     filter(.data$name == river_name) |>
+    st_filter(st_as_sfc(bb), .predicate = st_intersects) |>
     st_transform(crs) |>
     st_geometry()
 
   return(river_centerline)
 }
 
-get_osmdata <- function(city_name, river_name, crs, buffer = NULL) {
+get_osmdata <- function(city_name, river_name, crs) {
   bb <- get_osm_bb(city_name)
 
-  if (!is.null(buffer)) {
-    bb <- bb |>
-      st_as_sfc() |>
-      st_transform(crs = crs) |>
-      st_buffer(buffer) |>
-      st_transform(crs = 4326) |>
-      st_bbox()
-  }
-
   streets <- get_osm_streets(bb, crs)
   river <- get_osm_river(river_name, bb, crs)
 
@@ -86,14 +78,12 @@ get_osmdata <- function(city_name, river_name, crs, buffer = NULL) {
 city_name <- "Bucharest"
 river_name <- "Dâmbovița"
 epsg_code <- 32635
-bbox_buffer <- 2000 # m
 
 # Fetch the data
 bucharest <- get_osmdata(
   city_name,
   river_name,
-  crs = epsg_code,
-  buffer = bbox_buffer
+  crs = epsg_code
 )
 
 # Fix encoding issue in the WKT string of city boundary

data/bucharest.rda

@@ -195,3 +195,32 @@ test_that("a ring is recognized when from_edge is specified", {
   actual <- stroke(sfc, from_edge = 1)
   expect_setequal(actual, expected)
 })
+
+test_that("flow mode does not break edges on a real dataset", {
+  edges <- sf::st_geometry(bucharest$streets)
+
+  strokes <- rcoins::stroke(edges, flow_mode = TRUE)
+
+  # find out which of the initial edges are contained in each of the strokes
+  # NOTE: edges included in self-intersecting strokes can be missed by the
+  # following command, if the test fails double check the input!
+  contains <- sf::st_contains(strokes, edges)
+
+  # merge the groups of edges in (multi)linestrings
+  merge_edges <- function(idx) {
+    union <- sf::st_union(edges[idx])
+    if (sf::st_geometry_type(union) == "LINESTRING") {
+      return(union)
+    } else {
+      return(sf::st_line_merge(union))
+    }
+  }
+  edges_merged <- sf::st_sfc(sapply(contains, merge_edges),
+                             crs = sf::st_crs(edges))
+
+  # compare the grouped edges to the strokes: if identical, this means that
+  # the strokes contain full edges, i.e. flow_mode is respected
+  # NOTE: element-wise comparison works even if "strokes" consists of only
+  # linestrings, while "edges_merged" includes some multilinestrings
+  expect_true(all(strokes == edges_merged))
+})