Update package tests

Author: Michael Harper

NAMESPACE

@@ -8,4 +8,5 @@ export(display_polygon)
 export(extract_id)
 export(list_polygons)
 export(merge_delineated_polygons)
+import(assertthat)
 import(leaflet)

R/assess_polygon.R

@@ -56,7 +56,10 @@ assess_polygons <- function(polygons, survey_points, settlement_points, ornl, me
 
 #' Assess a single polygon
 #'
-#' Internal function that is used
+#' Internal function that is used to diagnose a single Polygon. Please use the
+#'  \code{\link{assess_polygons}} function which is designed to use this function
+#'  across a list of polygons.
+#'
 #' @param polygon_path the relative file path to the polygon shapefile
 #' @param survey_points Optional. The survey points where the delineation should occur
 #' @param settlement_points Optional. The settlement type points layer

R/check_crs.R

@@ -1,17 +1,30 @@
 #' Validate the CRS of a shapefile
 #'
-#' Will extract the coordinate reference system from a polygon and check that it
+#' Will extract the coordinate reference system from a SpatialObject and check that it
 #'  matches a specified reference.
 #'
+#' @param input an object of spatial class.
 #' @param crs_ref the CRS to be compared against. Defaults to WGS84
+#' @param warn print a warning message if they do not match. Default is TRUE
 #'
 #' @export
 #' @author Michael Harper
 #'
 check_crs <- function(input,
-                      crs_ref = "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"){
+                      crs_ref = "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0",
+                      warn = TRUE){
 
+  # Check that the objects are correct
+  assertthat::assert_that(grepl("Spatial",class(input)),
+                          msg = paste0(deparse(substitute(input)), " is not of class 'Spatial'"))
+
+  # Convert crs_ref into CRS object and compare with shapefile
   ref <- sp::CRS(crs_ref)
-  crs_match <- compareCRS(ref, crs(shp))
+  crs_match <- raster::compareCRS(ref, raster::crs(input))
+
+  # Return error message if not matching
+  if(!crs_match & warn) warning("The CRS of the file does not match the reference")
+
+  # Return results
   return(crs_match)
 }

R/display_polygon.R

@@ -22,9 +22,16 @@
 #' @export
 #'
 #' @example R/examples/display_polygon_1.R
+#' @import assertthat
 #'
 display_polygon <- function(shp_path, survey_points = NULL, settlement_point = NULL){
 
+  # Check inputs
+  assertthat::assert_that(has_extension(shp_path, "shp"))
+  assertthat::assert_that(is.readable(shp_path))
+  if(!is.null(survey_points)) assertthat::assert_that(is.spatial(survey_points))
+  if(!is.null(settlement_point)) assertthat::assert_that(is.spatial(settlement_point))
+
   # Load the shapefile
   shp <- raster::shapefile(x = shp_path)
 
@@ -70,12 +77,12 @@ display_polygon <- function(shp_path, survey_points = NULL, settlement_point = N
   if(!is.null(survey_points)){
 
     # Load survey point
-    survey_points_data <- shapefile(survey_points)
-    survey_points_data$FID <- 0:(nrow(survey_points_data)-1) # Add FID to object
+    survey_points_id <- survey_points
+    survey_points_id$FID <- 0:(nrow(survey_points_id)-1) # Add FID to object
 
     # Find the coordinate ID which matches
     id <- extract_id(shp_path)   # Extract the ID from the file name
-    survey_points_id <- survey_points_data[survey_points_data$FID == id,]
+    survey_points_id <- survey_points_id[survey_points_id$FID == id,]
     coords <- coordinates(survey_points_id)
 
     # Add markers to map

R/extract_id.R

@@ -15,8 +15,12 @@
 #'
 extract_id <- function(filepath){
 
+  # Make sure input is character
+  assertthat::assert_that(is.character(filepath),
+              msg = paste0(deparse(substitute(filepath)), " is not a character vector"))
+
   id <- basename(filepath) %>%
-    stringr::str_extract(pattern = "[:digit:]{3}") %>%
+    stringr::str_extract(pattern = "[:digit:]{1,3}") %>%
     as.numeric()
 
   return(id)

R/merge_delineated_polygons.R

@@ -14,6 +14,11 @@
 #'
 merge_delineated_polygons <- function(shp_paths, message = TRUE){
 
+  # Check that paths exist
+  for(i in shp_paths){
+    assertthat::assert_that(assertthat::is.readable(i))
+  }
+
   # Load the polygons and merge into single object
   if(message) message("Loading Polygons")
   shp_loaded <- pbapply::pblapply(shp_paths, function(x) raster::shapefile(x = x))

R/utilities.R

@@ -0,0 +1,6 @@
+
+#' Check if an object is a spatial class
+#'
+is.spatial <- function(object){
+    assertthat::assert_that(grepl("Spatial",class(object)),
+                            msg = paste0(deparse(substitute(object)), " is not of class a spatial object"))}