From 5c93dab66025d2bd1fac7d1fb5b1a62db801911b Mon Sep 17 00:00:00 2001 From: njtierney Date: Wed, 18 Dec 2024 10:43:40 +1000 Subject: [PATCH 1/2] small tweaks regarding cli/explaining variables --- R/calculate_travel_time.R | 37 +++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 16 deletions(-) diff --git a/R/calculate_travel_time.R b/R/calculate_travel_time.R index 94b5fd1..11d74f2 100644 --- a/R/calculate_travel_time.R +++ b/R/calculate_travel_time.R @@ -71,36 +71,41 @@ calculate_travel_time <- function( overwrite = FALSE ){ - if(!is.null(filename)){ - if(file.exists(filename) & !overwrite){ - - warning(sprintf( - "%s exists\n - Using existing file\n - to re-generate, - change overwrite to TRUE %s", - filename, - filename - )) + # wrap into a function + # warn_if_filename_already_used(filename, overwrite) + filename_used <- !is.null(filename) + filename_exists_and_no_overwrite <- file.exists(filename) && !overwrite + warn_user_not_overwrite <- filename_used && filename_exists_and_no_overwrite + if (warn_user_not_overwrite) { + + cli::cli_warn( + message = c( + "x" = "{.path {filename}} already exists", + "Using existing file, {.path {filename}}", + "i" = "To re-generate file, change {.arg overwrite} to {.code TRUE}" + ) + ) - return(terra::rast(filename)) + return(terra::rast(filename)) - } } - if(!"SpatRaster" %in% class(friction_surface)){ - stop("friction_surface must be a SpatRaster class object") + if (!inherits(friction_surface, "SpatRaster")){ + cli::cli_abort( + "{.arg friction_surface} must be a {.cls SpatRaster}." + ) } + # explaining variable if(!any(c("matrix", "data.frame", "SpatVector") %in% class(points))){ stop("points must be a SpatVector, data.frame, or matrix") } + # use inherits if("SpatVector" %in% class(points)){ points <- terra::geom(points)[,c("x", "y")] } - #npoints <- nrow(points) friction <- raster::raster(friction_surface) From 4cfee91db5605d15f9ecc5529613cf8ad8003dd0 Mon Sep 17 00:00:00 2001 From: njtierney Date: Wed, 18 Dec 2024 11:33:18 +1000 Subject: [PATCH 2/2] various code review: * add cli * use S3 methods for new function, ext_matrix * update tests to use inherits --- DESCRIPTION | 27 +++++++-- NAMESPACE | 7 +++ R/ext_matrix.R | 76 ++++++++++++++++++++++++ R/get_friction_surface.R | 49 +++++---------- man/ext_matrix.Rd | 24 ++++++++ man/get_friction_surface.Rd | 12 ++-- tests/testthat/test-ext_from_terra.R | 7 +-- tests/testthat/test-ext_vect_to_matrix.R | 4 +- 8 files changed, 153 insertions(+), 53 deletions(-) create mode 100644 R/ext_matrix.R create mode 100644 man/ext_matrix.Rd diff --git a/DESCRIPTION b/DESCRIPTION index fbaa310..7ac2188 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,14 +2,31 @@ Package: traveltime Title: Calculate Travel Times Over Space Version: 0.0.0.9000 Authors@R: c( - person("Gerry", "Ryan", , "gerard.ryan@telethonkids.org.au", role = c("aut", "cre"), - comment = c(ORCID = "0000-0003-0183-7630")), - person("Daniel", "Weiss", role = "aut", comment = c(ORCID = "0000-0002-6175-5648")), - person("Nicholas", "Tierney", role = "ctb", comment = c(ORCID = "0000-0000-0000-0000")) + person( + given = "Gerry", + family = "Ryan", + email = "gerard.ryan@telethonkids.org.au", + role = c("aut", "cre"), + comment = c(ORCID = "0000-0003-0183-7630") + ), + person( + given = "Daniel", + family = "Weiss", + role = "aut", + comment = c(ORCID = "0000-0002-6175-5648") + ), + person( + given = "Nicholas", + family = "Tierney", + email = "nicholas.tierney@gmail.com", + role = c("ctb"), + comment = c(ORCID = "0000-0003-1460-8722") + ) ) Description: Calculate travel time over a friction surface from a specified set of locations. License: MIT + file LICENSE Imports: + cli, gdistance, malariaAtlas, raster, @@ -21,7 +38,7 @@ Suggests: testthat (>= 3.0.0) Config/testthat/edition: 3 Depends: - R (>= 3.5) + R (>= 4.1.0) LazyData: true URL: https://idem-lab.github.io/traveltime/ BugReports: https://github.com/idem-lab/traveltime/issues diff --git a/NAMESPACE b/NAMESPACE index e86b8c3..2df1349 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,13 @@ # Generated by roxygen2: do not edit by hand +S3method(ext_matrix,SpatExtent) +S3method(ext_matrix,SpatRaster) +S3method(ext_matrix,SpatVector) +S3method(ext_matrix,default) +S3method(ext_matrix,matrix) +S3method(ext_matrix,vector) export(calculate_travel_time) export(ext_from_terra) +export(ext_matrix) export(ext_vect_to_matrix) export(get_friction_surface) diff --git a/R/ext_matrix.R b/R/ext_matrix.R new file mode 100644 index 0000000..d93b033 --- /dev/null +++ b/R/ext_matrix.R @@ -0,0 +1,76 @@ +#' @title Convert extent to matrix +#' +#' @description +#' This function converts from formats ... +#' TODO - explain why we need to do this, which is that we need a special esoteric format +#' +#' @param x `numeric` length 4, consisting of `c(xmin, xmax, ymin, ymax)` +#' dimensions of extent +#' +#' @return 2x2 `matrix` - explain esoteric format of matrix +#' +#' @examples +#' ext_matrix(c(111,112,0, 1)) +#' # TODO +#' # add examples of all SpatRaster, SpatVector, etc. +#' @export +ext_matrix <- function(x, ...){ + UseMethod("ext_matrix") +} + +#' @export +ext_matrix.SpatExtent <- function(x, ...){ + extent <- ext_vect_to_matrix(x) + extent +} + +#' @export +ext_matrix.SpatRaster <- function(x, ...){ + extent <- ext_from_terra(x) + extent +} + +#' @export +ext_matrix.SpatVector <- function(x, ...){ + extent <- ext_from_terra(x) + extent +} + +#' @export +ext_matrix.vector <- function(x){ + if (length(extent) != 4){ + cli::cli_abort( + message = c( + "{.arg extent} as numeric must be length 4", + "We see {.arg extent} has having length: {.val {length(extent)}}." + ) + ) + } + extent <- ext_vect_to_matrix(extent) + extent +} + +#' @export +ext_matrix.matrix <- function(x, ...){ + is_2x2 <- identical(dim(x), c(2L,2L)) + if(!is_2x2){ + cli::cli_abort( + message = c( + "If {.arg x} is of class, {.cls matrix}, it must have dimensions: 2x2", + "However, we see that {.arg x} has dimensions: \\ + {.val {paste0(dim(x), collapse = 'x')}}." + ) + ) + } +} + +#' @export +ext_matrix.default <- function(x, ...){ + cli::cli_abort( + message = c( + "{.arg extent} must be of class {.cls numeric, matrix, \\ + SpatExtent, SpatRaster}", + "But we see class: {.cls {class(x)}." + ) + ) +} diff --git a/R/get_friction_surface.R b/R/get_friction_surface.R index d95c7cf..bdf5150 100644 --- a/R/get_friction_surface.R +++ b/R/get_friction_surface.R @@ -1,6 +1,6 @@ #' @title Get friction surface #' @description Wrapper function to download friction surfaces via -#' `malariaAtlas::getRaster` +#' [malariaAtlas::getRaster()]. #' #' @param surface `"motor2020"` or `"walk2020`. #' @param filename `character`. File name for output layer. @@ -9,7 +9,7 @@ #' xmax, ymin, ymax)`, `SpatExtent`, `SpatVector` or `SpatRaster` (from which #' the extent will be taken), or 2x2 `matrix` (see details). #' -#' @details Convenience wrapper to `malariaAtlas::getRaster` to access motorised +#' @details Convenience wrapper to [malariaAtlas::getRaster()] to access motorised #' and walking travel friction layers per Weiss et al. 2020, that adds safety to #' check existing files before download. Surfaces can be downloaded directly #' from: @@ -29,17 +29,16 @@ #' maps of travel time to healthcare facilities. (2020) Nature Medicine. #' \url{https://doi.org/10.1038/s41591-020-1059-1} #' -#' `extent` is passed through is to pass to `malariaAtlas::getRaster` as a 2x2 +#' `extent` is passed through is to pass to [malariaAtlas::getRaster()] as a 2x2 #' matrix. If passed in as a numeric vector, `SpatExtent`, `SpatVector`, or -#' `SpatRaster`, it is converted into a matrix using `ext_vect_to_matrix` and -#' `ext_from_terra`. `matrix` format is as returned by sf::st_bbox() - the +#' `SpatRaster`, it is converted into a matrix using `ext_vect_to_matrix()` and +#' `ext_from_terra()`. `matrix` format is as returned by sf::st_bbox() - the #' first column has the minimum, the second the maximum values; rows 1 & 2 #' represent the x & y dimensions respectively (`matrix(c("xmin", "ymin","xmax", #' "ymax"), nrow = 2, ncol = 2, dimnames = list(c("x", "y"), c("min", "max")))`) #' (use either shp OR extent; if neither is specified global raster is #' returned). `NULL` extent downloads (large) global layer. #' -#' #' @return `SpatRaster` #' @export #' @@ -60,8 +59,6 @@ #' extent = ext #' ) #' -#' @details Additional details... -#' get_friction_surface <- function( surface = c("motor2020", "walk2020"), filename = NULL, @@ -70,6 +67,7 @@ get_friction_surface <- function( ){ surface <- match.arg(surface) + # similar code from calculate_travel_time if(!is.null(filename)){ if(!overwrite & file.exists(filename)){ @@ -83,36 +81,17 @@ get_friction_surface <- function( } } - if (surface == "motor2020") { - surface_name <- "Explorer__2020_motorized_friction_surface" - } else if (surface == "walk2020"){ - surface_name <- "Explorer__2020_walking_only_friction_surface" - } + surface_name <- switch( + surface, + "motor2020" = "Explorer__2020_motorized_friction_surface", + "walk2020" = "Explorer__2020_walking_only_friction_surface" + ) if (is.null(extent)) { - stop("extent missing") - } else if (is.vector(extent)) { - if(length(extent) == 4){ - extent <- ext_vect_to_matrix(extent) - } else { - stop("extent as numeric must be length 4") - } - } else if(any(class(extent) == "SpatExtent")) { - extent <- ext_vect_to_matrix(extent) - } else if(any(class(extent) == "SpatRaster")){ - extent <- ext_from_terra(extent) - }else if(any(class(extent) == "SpatVector")){ - extent <- ext_from_terra(extent) - } else if(is.matrix(extent)){ - if(!all(dim(extent) == c(2,2))){ - stop("Matrix must be 2x2") - } else { - extent <- extent - } - } else { - stop("extent must be numeric, matrix, SpatExtent or SpatRaster") + cli::cli_abort("{.arg extent} must be specified.") } + extent <- ext_matrix(extent) fs <- malariaAtlas::getRaster( dataset_id = surface_name, @@ -130,7 +109,7 @@ get_friction_surface <- function( fs <- terra::rast(filename) - } else{ + } else { fs } diff --git a/man/ext_matrix.Rd b/man/ext_matrix.Rd new file mode 100644 index 0000000..41f3887 --- /dev/null +++ b/man/ext_matrix.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ext_matrix.R +\name{ext_matrix} +\alias{ext_matrix} +\title{Convert extent to matrix} +\usage{ +ext_matrix(x, ...) +} +\arguments{ +\item{x}{\code{numeric} length 4, consisting of \code{c(xmin, xmax, ymin, ymax)} +dimensions of extent} +} +\value{ +2x2 \code{matrix} - explain esoteric format of matrix +} +\description{ +This function converts from formats ... +TODO - explain why we need to do this, which is that we need a special esoteric format +} +\examples{ +ext_matrix(c(111,112,0, 1)) +# TODO +# add examples of all SpatRaster, SpatVector, etc. +} diff --git a/man/get_friction_surface.Rd b/man/get_friction_surface.Rd index 493de63..c7a66fc 100644 --- a/man/get_friction_surface.Rd +++ b/man/get_friction_surface.Rd @@ -26,10 +26,10 @@ the extent will be taken), or 2x2 \code{matrix} (see details).} } \description{ Wrapper function to download friction surfaces via -\code{malariaAtlas::getRaster} +\code{\link[malariaAtlas:getRaster]{malariaAtlas::getRaster()}}. } \details{ -Convenience wrapper to \code{malariaAtlas::getRaster} to access motorised +Convenience wrapper to \code{\link[malariaAtlas:getRaster]{malariaAtlas::getRaster()}} to access motorised and walking travel friction layers per Weiss et al. 2020, that adds safety to check existing files before download. Surfaces can be downloaded directly from: @@ -49,16 +49,14 @@ T. L. Symons, E. Cameron, K. E. Battle, S. Bhatt, and P. W. Gething. Global maps of travel time to healthcare facilities. (2020) Nature Medicine. \url{https://doi.org/10.1038/s41591-020-1059-1} -\code{extent} is passed through is to pass to \code{malariaAtlas::getRaster} as a 2x2 +\code{extent} is passed through is to pass to \code{\link[malariaAtlas:getRaster]{malariaAtlas::getRaster()}} as a 2x2 matrix. If passed in as a numeric vector, \code{SpatExtent}, \code{SpatVector}, or -\code{SpatRaster}, it is converted into a matrix using \code{ext_vect_to_matrix} and -\code{ext_from_terra}. \code{matrix} format is as returned by sf::st_bbox() - the +\code{SpatRaster}, it is converted into a matrix using \code{ext_vect_to_matrix()} and +\code{ext_from_terra()}. \code{matrix} format is as returned by sf::st_bbox() - the first column has the minimum, the second the maximum values; rows 1 & 2 represent the x & y dimensions respectively (\code{matrix(c("xmin", "ymin","xmax", "ymax"), nrow = 2, ncol = 2, dimnames = list(c("x", "y"), c("min", "max")))}) (use either shp OR extent; if neither is specified global raster is returned). \code{NULL} extent downloads (large) global layer. - -Additional details... } \examples{ diff --git a/tests/testthat/test-ext_from_terra.R b/tests/testthat/test-ext_from_terra.R index da56220..4be5f05 100644 --- a/tests/testthat/test-ext_from_terra.R +++ b/tests/testthat/test-ext_from_terra.R @@ -4,11 +4,10 @@ test_that("extent is extent", { extent = terra::ext(c(111, 112, 0, 1)) ) - x <- ext_from_terra(r) + x <- ext_matrix(r) - #expect_is(x, "matrix") expect_type(x, "double") - #expect_s3_class(x, "matrix") - + expect_true(inherits(x, "matrix")) expect_equal(dim(x), c(2, 2)) + }) diff --git a/tests/testthat/test-ext_vect_to_matrix.R b/tests/testthat/test-ext_vect_to_matrix.R index 0d9edda..45625d4 100644 --- a/tests/testthat/test-ext_vect_to_matrix.R +++ b/tests/testthat/test-ext_vect_to_matrix.R @@ -1,8 +1,8 @@ test_that("ext vect to matrix", { x <- ext_vect_to_matrix(c(111,112,0, 1)) - expect_is(x, "matrix") - + expect_true(inherits(x, "matrix")) + expect_type(x, "double") expect_equal(dim(x), c(2, 2)) })