Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Added a test city (streets and river centerline) to use for testing rcoins #27

Merged
merged 15 commits into from
Dec 16, 2024
Merged
Show file tree
Hide file tree
Changes from 14 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
@@ -1,2 +1,4 @@
^LICENSE\.md$
^\.github$
^data-raw$
^environment\.yml$
6 changes: 5 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -15,9 +15,13 @@ Roxygen: list(markdown = TRUE)
RoxygenNote: 7.3.2
Suggests:
testthat (>= 3.0.0),
sfnetworks
sfnetworks,
osmdata
Config/testthat/edition: 3
Imports:
dplyr,
sf,
sfheaders
Depends:
R (>= 2.10)
vanlankveldthijs marked this conversation as resolved.
Show resolved Hide resolved
LazyData: true
6 changes: 6 additions & 0 deletions R/data.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
#' rcoins test data
#'
#' Data extracted from OpenStreetMap for testing the rcoins package.
#'
#' @source OpenStreetMap
"bucharest"
108 changes: 108 additions & 0 deletions data-raw/bucharest.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,108 @@
library(dplyr)
library(osmdata)
library(rlang)
library(sf)
library(usethis)


get_osm_bb <- function(city_name) {
bb <- getbb(city_name)
vanlankveldthijs marked this conversation as resolved.
Show resolved Hide resolved
bb <- bb |> as.vector()
names(bb) <- c("xmin", "ymin", "xmax", "ymax")
bb <- st_bbox(bb, crs = 4326)
return(bb)
}

osmdata_as_sf <- function(key, value, bb) {
bb |>
opq() |>
vanlankveldthijs marked this conversation as resolved.
Show resolved Hide resolved
add_osm_feature(key = key, value = value) |>
vanlankveldthijs marked this conversation as resolved.
Show resolved Hide resolved
osmdata_sf()
vanlankveldthijs marked this conversation as resolved.
Show resolved Hide resolved
}

get_osm_streets <- function(bb, crs, highway_values = NULL) {
if (is.null(highway_values)) {
highway_values <- c("motorway", "trunk", "primary", "secondary", "tertiary")
}

link_values <- sapply(X = highway_values,
FUN = \(x) sprintf("%s_link", x),
USE.NAMES = FALSE)

streets <- osmdata_as_sf("highway", c(highway_values, link_values), bb)

# Cast polygons (closed streets) into lines
poly_to_lines <- suppressWarnings(
streets$osm_polygons |> st_cast("LINESTRING")
)

# Combine all features in one data frame
streets_lines <- streets$osm_lines |>
bind_rows(poly_to_lines) |>
select("highway") |>
rename(!!sym("type") := !!sym("highway")) |>
st_transform(crs)

return(streets_lines)
}

get_osm_river <- function(river_name, bb, crs) {
# Get the river centreline
river_centerline <- osmdata_as_sf("waterway", "river", bb)
river_centerline <- river_centerline$osm_multilines |>
filter(.data$name == river_name) |>
st_transform(crs) |>
st_geometry()

return(river_centerline)
}

get_osmdata <- function(city_name, river_name, crs, buffer = NULL) {
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)

osm_data <- list(
bb = bb,
river_centerline = river,
streets = streets
)

return(osm_data)
}


# Set the parameters
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
)

# Fix encoding issue in the WKT string of city boundary
fix_wkt_encoding <- function(x) {
wkt <- st_crs(x)$wkt
st_crs(x)$wkt <- gsub("°|º", "\\\u00b0", wkt)
x
}
bucharest <- lapply(bucharest, fix_wkt_encoding)

# Save as package data
use_data(bucharest, overwrite = TRUE)
Binary file added data/bucharest.rda
Binary file not shown.
1 change: 1 addition & 0 deletions environment.yml
Original file line number Diff line number Diff line change
Expand Up @@ -14,3 +14,4 @@ dependencies:
- r-testthat >=3.0.0
# Others
- r-lintr
- r-osmdata
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Maybe put r-osmdata right after r-sfnetworks in the list, as it is part of the "Suggests" section?

19 changes: 19 additions & 0 deletions man/bucharest.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

7 changes: 7 additions & 0 deletions tests/testthat/test-data.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
test_that("the test data can be loaded", {
streets <- bucharest$streets
expect_true(length(streets) > 0)

river <- bucharest$river_centerline
expect_true(length(river) > 0)
})
Loading