diff --git a/NEWS.md b/NEWS.md index 0857bcd..7ad328a 100644 --- a/NEWS.md +++ b/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 diff --git a/R/data.R b/R/data.R index 2bdd118..8240248 100644 --- a/R/data.R +++ b/R/data.R @@ -2,5 +2,5 @@ #' #' Data extracted from OpenStreetMap for testing the rcoins package. #' -#' @source OpenStreetMap +#' @source "bucharest" diff --git a/data-raw/bucharest.R b/data-raw/bucharest.R index 015eaab..fc6d991 100644 --- a/data-raw/bucharest.R +++ b/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 diff --git a/data/bucharest.rda b/data/bucharest.rda index b08fdda..ad38730 100644 Binary files a/data/bucharest.rda and b/data/bucharest.rda differ diff --git a/tests/testthat/test-stroke.R b/tests/testthat/test-stroke.R index 1cf05cc..bd21163 100644 --- a/tests/testthat/test-stroke.R +++ b/tests/testthat/test-stroke.R @@ -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)) +})