Code review 2024 12 18

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

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)

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)

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)}."
+      )
+  )
+}

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
   }
 

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))
+
 })

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))
 
 })