diff --git a/NAMESPACE b/NAMESPACE index 09a06a9b..fb42a191 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method(plot,delineation) export(as_bbox) export(as_network) export(cache_directory) diff --git a/NEWS.md b/NEWS.md index 9c6060e0..0d69d002 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,11 +5,16 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 # [Unreleased] +## Changed + +- `delineate()` returns now an S3 object of class `delineation`. + ## Added - Package-level documentation has been added. - Assertions using the `checkmate` package were added to input parameters throughout the package. - Examples were expanded to demonstrates the use of all parameters. +- A `plot()` method was created for objects of class `delineation`. ## Fixed diff --git a/R/delineate.R b/R/delineate.R index 0383dcfe..085c9ebf 100644 --- a/R/delineate.R +++ b/R/delineate.R @@ -104,6 +104,11 @@ delineate <- function( city_boundary = FALSE, force_download = force_download ) + delineations$streets <- osm_data$streets + delineations$railways <- osm_data$railways + delineations$river_centerline <- osm_data$river_centerline + delineations$river_surface <- osm_data$river_surface + # If not provided, determine the CRS if (is.null(crs)) crs <- get_utm_zone(osm_data$bb) @@ -153,5 +158,6 @@ delineate <- function( osm_data$buildings) } + class(delineations) <- c("delineation", "list") delineations } diff --git a/R/visualisation.R b/R/visualisation.R new file mode 100644 index 00000000..9e359673 --- /dev/null +++ b/R/visualisation.R @@ -0,0 +1,66 @@ +#' Plot a delineation object +#' +#' This function provides a way to quickly visulise how the layers of a +#' delineation object fit together. A delineation object typically includes the +#' base layers `streets`, `railways`, `river_centerline` and `river_surface`, +#' and the delineations of the `valley`, `corridor`, `segments`, and +#' `riverspace`. Depending on the delineation object, some of the delineation +#' layers may not be present and thus will not be plotted. +#' +#' @param x An object of class `delineation`. This is typically the output +#' of the `delineate()` function. +#' @param ... Additional arguments passed to the `plot()` function for +#' the `segments` and `corridor` layers. +#' +#' @returns A plot visualizing the delineation object. +#' @export +#' +#' @examplesIf interactive() +#' bd <- delineate("Bucharest", "Dâmbovița") +#' plot(bd) +plot.delineation <- function(x, ...) { + if (!inherits(x, "delineation")) { + stop("The object is not of class 'delineation'") + } + + x <- unclass(x) + + # Set plot extent with first layer + if (!is.null(x$corridor)) { + plot(x$corridor) + } else if (!is.null(x$riverspace)) { + # The only case when corridor may be absent + plot(x$riverspace, col = "lightblue", border = NA, add = TRUE) + } else { + stop("No delineation layers present in the delineation object.") + } + + base_layers <- c("streets", "railways", "river_centerline") + if (!all(base_layers %in% names(x))) { + warning(paste("Not all base layers found in the delineation object.", + "Plotting without those.")) + } + + # Plot the layers + if (!is.null(x$valley)) { + plot(x$valley, col = "grey80", border = NA, add = TRUE) + } + if (!is.null(x$river_surface)) { + plot(x$river_surface, col = "blue", border = NA, add = TRUE) + } + if (!is.null(x$river_centerline)) { + plot(x$river_centerline, col = "blue", add = TRUE) + } + if (!is.null(x$railways)) { + plot(x$railways, add = TRUE, lwd = 0.5) + } + if (!is.null(x$streets)) { + plot(x$streets, add = TRUE) + } + if (!is.null(x$segments)) { + plot(x$segments, ..., add = TRUE, lwd = 2) + } + if (!is.null(x$corridor)) { + plot(x$corridor, ..., add = TRUE, lwd = 3) + } +} diff --git a/README.Rmd b/README.Rmd index d643d8f2..d8c182d9 100644 --- a/README.Rmd +++ b/README.Rmd @@ -55,24 +55,12 @@ library(rcrisp) # Set location parameters city_name <- "Bucharest" river_name <- "Dâmbovița" -epsg_code <- 32635 - -# Get base layer for plotting -bb <- get_osm_bb(city_name) -streets <- get_osm_streets(bb, epsg_code)$geometry -railways <- get_osm_railways(bb, epsg_code)$geometry # Delineate river corridor bd <- delineate(city_name, river_name, segments = TRUE) -corridor <- bd$corridor -segments <- bd$segments - -# Plot results -plot(corridor) -plot(railways, col = "darkgrey", add = TRUE, lwd = 0.5) -plot(streets, add = TRUE) -plot(segments, border = "orange", add = TRUE, lwd = 3) -plot(corridor, border = "red", add = TRUE, lwd = 3) + +# Plot delineation object +plot(bd) ``` ## Contributing diff --git a/README.md b/README.md index 73069dbb..6b43d591 100644 --- a/README.md +++ b/README.md @@ -45,24 +45,12 @@ library(rcrisp) # Set location parameters city_name <- "Bucharest" river_name <- "Dâmbovița" -epsg_code <- 32635 - -# Get base layer for plotting -bb <- get_osm_bb(city_name) -streets <- get_osm_streets(bb, epsg_code)$geometry -railways <- get_osm_railways(bb, epsg_code)$geometry # Delineate river corridor bd <- delineate(city_name, river_name, segments = TRUE) -corridor <- bd$corridor -segments <- bd$segments - -# Plot results -plot(corridor) -plot(railways, col = "darkgrey", add = TRUE, lwd = 0.5) -plot(streets, add = TRUE) -plot(segments, border = "orange", add = TRUE, lwd = 3) -plot(corridor, border = "red", add = TRUE, lwd = 3) + +# Plot delineation object +plot(bd) ``` diff --git a/man/figures/README-example-1.png b/man/figures/README-example-1.png index 3c1d5b28..48fc7547 100644 Binary files a/man/figures/README-example-1.png and b/man/figures/README-example-1.png differ diff --git a/man/plot.delineation.Rd b/man/plot.delineation.Rd new file mode 100644 index 00000000..0fab128d --- /dev/null +++ b/man/plot.delineation.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/visualisation.R +\name{plot.delineation} +\alias{plot.delineation} +\title{Plot a delineation object} +\usage{ +\method{plot}{delineation}(x, ...) +} +\arguments{ +\item{x}{An object of class \code{delineation}. This is typically the output +of the \code{delineate()} function.} + +\item{...}{Additional arguments passed to the \code{plot()} function for +the \code{segments} and \code{corridor} layers.} +} +\value{ +A plot visualizing the delineation object. +} +\description{ +This function provides a way to quickly visulise how the layers of a +delineation object fit together. A delineation object typically includes the +base layers \code{streets}, \code{railways}, \code{river_centerline} and \code{river_surface}, +and the delineations of the \code{valley}, \code{corridor}, \code{segments}, and +\code{riverspace}. Depending on the delineation object, some of the delineation +layers may not be present and thus will not be plotted. +} +\examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +bd <- delineate("Bucharest", "Dâmbovița") +plot(bd) +\dontshow{\}) # examplesIf} +} diff --git a/tests/testthat/test-cache.R b/tests/testthat/test-cache.R index 74061fcc..6406eec6 100644 --- a/tests/testthat/test-cache.R +++ b/tests/testthat/test-cache.R @@ -146,7 +146,8 @@ test_that("Cache checks raise warnings when old cached files are found", { ) with_mocked_bindings(file.info = function(...) mocked_file_info_response, .package = "base", - expect_type(check_cache(), "character")) + expect_warning(check_cache(), + "Clean up files older than 30 days")) }) test_that("Cache checks raise warnings when large cached files are found", { @@ -156,5 +157,6 @@ test_that("Cache checks raise warnings when large cached files are found", { ) with_mocked_bindings(file.info = function(...) mocked_file_info_response, .package = "base", - expect_type(check_cache(), "character")) + expect_warning(check_cache(), + "Clean up files older than 30 days")) }) diff --git a/tests/testthat/test-delineate.R b/tests/testthat/test-delineate.R index 2c121313..3242fc47 100644 --- a/tests/testthat/test-delineate.R +++ b/tests/testthat/test-delineate.R @@ -22,10 +22,12 @@ test_that("Delineate returns all required delineation units", { riverspace = TRUE) |> suppressWarnings()) expect_setequal(names(delineations), - c("valley", "corridor", "segments", "riverspace")) + c("streets", "railways", "river_centerline", "river_surface", + "valley", "corridor", "segments", "riverspace")) geometry_types <- sapply(delineations, sf::st_geometry_type) # segments include multiple geometries, flatten array for comparison - expect_in(do.call(c, geometry_types), c("POLYGON", "MULTIPOLYGON")) + expect_in(do.call(c, geometry_types), + c("POLYGON", "MULTIPOLYGON", "LINESTRING", "MULTILINESTRING")) }) test_that("Delineate does not return the valley if the buffer method is used", { @@ -46,5 +48,7 @@ test_that("Delineate does not return the valley if the buffer method is used", { segments = FALSE, riverspace = FALSE) |> suppressWarnings()) - expect_equal(names(delineations), "corridor") + expect_setequal(names(delineations), + c("streets", "railways", "river_centerline", "river_surface", + "corridor")) }) diff --git a/tests/testthat/test-visualisation.R b/tests/testthat/test-visualisation.R new file mode 100644 index 00000000..349bb300 --- /dev/null +++ b/tests/testthat/test-visualisation.R @@ -0,0 +1,32 @@ +delineation_object <- list( + streets = bucharest_osm$streets, + railways = bucharest_osm$railways, + river_centerline = bucharest_osm$river_centerline, + corridor = bucharest_dambovita$corridor +) +class(delineation_object) <- c("delineation", "list") + +base_layers <- c("streets", "railways", "river_centerline") + +test_that("plot.delineation works with valid input", { + expect_silent(plot(delineation_object)) # Should not throw an error +}) + +test_that("plot.delineation throws error if input has no delineation layer", { + delineation_object_nd <- delineation_object[base_layers] + expect_error(plot(delineation_object_nd)) +}) + +test_that("plot.delineation warns if one or more base layers are missing", { + delineation_object_nb <- + delineation_object[setdiff(names(delineation_object), base_layers)] + class(delineation_object_nb) <- c("delineation", "list") + expect_warning(plot(delineation_object_nb), + "Not all base layers found in the delineation object.") +}) + +test_that("plot.delineation throws error with input of wrong class", { + delineation_object_unclass <- unclass(delineation_object) + expect_error(plot.delineation(delineation_object_unclass), + "The object is not of class 'delineation'") +})