Issue #133 file locations for distances matrix()

NEWS.md

@@ -22,6 +22,7 @@ Enhancements:
   * New `convertLotekCDMAFile()` function to prepare lotek txt logs for further analyses (issue [#103](https://github.com/hugomflavio/actel/issues/103)).
   * New `plotDot()` function to help users inspect their spatial.txt files (issue [#55](https://github.com/hugomflavio/actel/issues/55)).
   * Improved internal mechanisms for message/warning/debug/stop reporting. new internal function `event()` replaces the old `appendTo()`, `stopAndReport()`, and `emergencyBreak()` (issue [#135](https://github.com/hugomflavio/actel/issues/135))
+  * Added the ability to use output of `loadSpatial()` as 'starters' for `distancesMatrix()` when 'actel' is 'TRUE'. This allows a user to input their spatial.csv if located in a separate working directory (issue [#133](https://github.com/hugomflavio/actel/issues/133))
 
 ## actel 1.3.0
 

R/distances.R

@@ -342,26 +342,35 @@ transitionLayer <- function(x, directions = c(16, 8, 4)){
 
 #' Calculate Distances Matrix
 #'
-#' Using a previously created transition layer (see \code{\link{transitionLayer}}), calculates the distances
-#' between spatial points. Adapted from Grant Adams' script "distance to closest mpa". if the argument 'actel'
-#' is set to TRUE (default), an actel-compatible matrix is generated, and the user will be asked if they would
-#' like to save the matrix as 'distances.csv' in the current directory.
-#'
-#' It is highly recommended to read the manual page regarding distances matrices before running this function.
-#' You can find it here: \href{https://hugomflavio.github.io/actel-website/manual-distances.html}{https://hugomflavio.github.io/actel-website/manual-distances.html}
-#'
-#' @param t.layer A TransitionLayer object, generated by \code{\link{transitionLayer}}.
-#' @param starters A data frame with the points from which to start measuring the distance. Ignored if actel = TRUE (default), as the 'spatial.csv' is loaded as starters.
-#' @param targets A data frame with the points to which a way must be found. Ignored if actel = TRUE (default), as the 'spatial.csv' is loaded as targets.
-#' @param coord.x,coord.y The names of the columns containing the x and y coordinates in the starters and targets. Must be identical in the starters and targets.
-#' @param id.col The name of the column containing the IDs of the points to be used as starters and targets. Must be identical in both files. Ignored if actel = TRUE (default), as the stations' standard names are used.
-#' @param actel Logical: Should the distance matrix be optimized for actel? Defaults to TRUE.
+#' Using a previously created transition layer (see \code{\link{transitionLayer}}), 
+#' calculates the distances between spatial points. Adapted from Grant Adams' 
+#' script "distance to closest mpa". If the argument 'actel' is set to 
+#' TRUE (default), an actel-compatible matrix is generated, and the user will be 
+#' asked if they would like to save the matrix as 'distances.csv' in the current 
+#' directory.
+#'
+#' It is highly recommended to read the manual page regarding distances matrices 
+#' before running this function.
+#' You can find it here:\href{https://hugomflavio.github.io/actel-website/manual-distances.html}{https://hugomflavio.github.io/actel-website/manual-distances.html}
+#'
+#' @param t.layer A TransitionLayer object, generated by 
+#' \code{\link{transitionLayer}}.
+#' @param starters A data frame with the points from which to start measuring 
+#' the distance or the output of `loadSpatial()`.
+#' @param targets A data frame with the points to which a way must be found. 
+#' @param coord.x,coord.y The names of the columns containing the x and y 
+#' coordinates in the starters and targets. Must be identical in the starters 
+#' and targets.
+#' @param id.col The name of the column containing the IDs of the points to 
+#' be used as starters and targets. Must be identical in both files. 
+#' Ignored if actel = TRUE (default), as the stations' standard names are used.
+#' @param actel Logical: Should the distance matrix be optimized for actel? 
+#' Defaults to TRUE.
 #'
 #' @examples
 #' \donttest{
 #' # check if R can run the distance functions
-#' aux <- c(
-#'   length(suppressWarnings(packageDescription("raster"))),
+#' aux <- c(length(suppressWarnings(packageDescription("raster"))),
 #'   length(suppressWarnings(packageDescription("gdistance"))),
 #'   length(suppressWarnings(packageDescription("sp"))),
 #'   length(suppressWarnings(packageDescription("terra"))))
@@ -370,8 +379,10 @@ transitionLayer <- function(x, directions = c(16, 8, 4)){
 #'
 #' if (any(missing.packages)) {
 #'   message("Sorry, this function requires packages '",
-#'     paste(c("raster", "gdistance", "sp", "terra")[missing.packages], collapse = "', '"),
-#'     "' to operate. Please install ", ifelse(sum(missing.packages) > 1, "them", "it"),
+#'     paste(c("raster", "gdistance", "sp", "terra")[missing.packages], 
+#'     collapse = "', '"),
+#'     "' to operate. Please install ", ifelse(sum(missing.packages) > 1, 
+#'     "them", "it"),
 #'     " before proceeding.")
 #' } else {
 #'   # move to a temporary directory
@@ -409,7 +420,7 @@ transitionLayer <- function(x, directions = c(16, 8, 4)){
 #'
 #' @export
 #'
-distancesMatrix <- function(t.layer, starters = NULL, targets = starters,
+distancesMatrix <- function(t.layer, starters = NULL, targets = NULL,
   coord.x = "x", coord.y = "y", id.col = NULL, actel = TRUE){
   # initial checks on package presence
   aux <- c(
@@ -419,41 +430,103 @@ distancesMatrix <- function(t.layer, starters = NULL, targets = starters,
     length(suppressWarnings(packageDescription("terra"))))
   missing.packages <- sapply(aux, function(x) x == 1)
   if (any(missing.packages)) {
-    stop(paste0("This function requires packages '", paste(c("raster", "gdistance", "sp", "terra")[missing.packages], collapse = "', '"),
-      "' to operate. Please install ", ifelse(sum(missing.packages) > 1, "them", "it"), " before proceeding.\n"), call. = FALSE)
+    stop("This function requires packages '", 
+         paste(c("raster", "gdistance", "sp", "terra")[missing.packages], 
+               collapse = "', '"),
+         "' to operate. Please install ", 
+         ifelse(sum(missing.packages) > 1, "them", "it"), 
+         " before proceeding.\n", call. = FALSE)
   }
 
   if (!inherits(t.layer, "TransitionLayer"))
-    stop("Could not recognise 't.layer' as a TransitionLayer object. Make sure to compile it using the function transitionLayer.\n", call. = FALSE)
+    stop("Could not recognise 't.layer' as a TransitionLayer object. Make",
+         " sure to compile it using the function transitionLayer.\n", 
+         call. = FALSE)
 
   if (!is.null(id.col) && length(id.col) > 1)
     stop("Please provide only one column name in 'id.col'", call. = FALSE)
   if (!is.null(id.col) && is.numeric(id.col))
-    stop("Please refer to the column name in 'id.col', rather than the column index.\n", call. = FALSE)
+    stop("Please refer to the column name in 'id.col', rather than the column",
+         " index.\n", call. = FALSE)
 
   if (actel) {
     message("M: Creating actel-compatible distances matrix."); flush.console()
-    if (!is.null(starters) | !is.null(targets))
-      warning("starters' or 'targets' were set but will be ignored because 'actel' is set to TRUE. Set 'actel' to FALSE to use the 'starters' and 'targets' arguments.", call. = FALSE, immediate. = TRUE)
-    starters <- targets <- loadSpatial()
-    if (!is.null(id.col))
-      warning("id.col' was set but will be ignored because 'actel' is set to TRUE. Set 'actel' to FALSE to use the 'id.col' argument.", call. = FALSE, immediate. = TRUE)
+
+    if(!is.null(starters) | !is.null(targets)) {
+      # distancesMatrix() crashes if actel = TRUE and starters/targets were 
+      # supplied but do not contain a column called "Standard.name"
+      if(!is.null(starters) && !("Standard.name" %in% colnames(starters))) {
+        stop("'starters' is missing column called 'Standard.name'",
+             call. = FALSE)
+      }
+
+      if(!is.null(targets) & !any(grepl(c("Standard.name"), 
+                                         colnames(targets)))) {
+        stop("'targets' is missing column called 'Standard.name'",
+             call. = FALSE)
+      }
+    }
+
+    if (!is.null(starters) & !is.null(targets)) {
+      warning("'starters' and 'targets' were specified while 'actel'",
+              " is set to TRUE. Using 'starters' and 'targets' for distances.", 
+              call. = FALSE, immediate. = TRUE) 
+    }
+
+    if (!is.null(starters) & is.null(targets)) {
+        warning("'starters' were specified but 'targets' were not while 'actel'",
+              " is set to TRUE. Using 'starters' for 'targets'.", 
+              call. = FALSE, immediate. = TRUE) 
+
+        targets <- starters
+        }
+
+    if (is.null(starters) & is.null(targets)) {
+        warning("'starters' and 'targets' were not set while 'actel' is set to",
+              " TRUE. Creating 'starters' and 'targets' from 'spatial.csv' ",
+              " in working directory." , call. = FALSE, immediate. = TRUE)
+        starters <- targets <- loadSpatial() 
+        }
+
+    if (!is.null(id.col)) {
+      warning("id.col' was set but will be ignored because 'actel' is set to", 
+              " TRUE. Set 'actel' to FALSE to use the 'id.col' argument.", 
+              call. = FALSE, immediate. = TRUE) 
+      }
     id.col <- "Standard.name"
   }
+
+  # Failsafe from old way code worked where targets used starters by default 
+  # when actel == FALSE
+  if(!actel) {
+    if(is.null(targets)) {
+      targets <- starters
+    }
+  }
 
-  if (!inherits(starters, "data.frame"))
+  if (!inherits(starters, "data.frame")) {
     stop("'starters' must be a data frame.\n", call. = FALSE)
-  if (!inherits(targets, "data.frame"))
+    }
+  if (!inherits(targets, "data.frame")) {
     stop("'targets' must be a data frame.\n", call. = FALSE)
+    }
 
-  if (is.na(match(coord.x, colnames(starters))))
-    stop(paste0("Could not find a column '", coord.x, "' in 'starters'."), call. = FALSE)
-  if (is.na(match(coord.y, colnames(starters))))
-    stop(paste0("Could not find a column '", coord.y, "' in 'starters'."), call. = FALSE)
-  if (is.na(match(coord.x, colnames(targets))))
-    stop(paste0("Could not find a column '", coord.x, "' in 'targets'."), call. = FALSE)
-  if (is.na(match(coord.y, colnames(targets))))
-    stop(paste0("Could not find a column '", coord.y, "' in 'targets'."), call. = FALSE)
+  if (is.na(match(coord.x, colnames(starters)))) {
+    stop(paste0("Could not find a column '", 
+                coord.x, "' in 'starters'."), call. = FALSE)
+  }
+  if (is.na(match(coord.y, colnames(starters)))) {
+    stop(paste0("Could not find a column '", 
+                coord.y, "' in 'starters'."), call. = FALSE)
+  }
+  if (is.na(match(coord.x, colnames(targets)))) {
+    stop(paste0("Could not find a column '", 
+                coord.x, "' in 'targets'."), call. = FALSE)
+    }
+  if (is.na(match(coord.y, colnames(targets)))) {
+    stop(paste0("Could not find a column '", 
+                coord.y, "' in 'targets'."), call. = FALSE)
+  }
 
     starters <- starters[, c(id.col, coord.x, coord.y)]
     colnames(starters) <- c(id.col, "longitude", "latitude")
@@ -465,25 +538,33 @@ distancesMatrix <- function(t.layer, starters = NULL, targets = starters,
     if (!is.na(match(id.col, colnames(starters)))) {
       outputRows <- starters[, id.col]
       if (any(duplicated(outputRows))) {
-        warning("The '", id.col, "' column in 'starters' contains duplicated values; skipping row naming.", immediate. = TRUE, call. = FALSE)
+        warning("The '", id.col, 
+                "' column in 'starters' contains duplicated values;",
+                " skipping row naming.", immediate. = TRUE, call. = FALSE)
         row.rename <- FALSE
       } else {
         row.rename <- TRUE
       }
     } else {
-      warning("Could not find a '", id.col, "' column in 'starters'; skipping row naming.", immediate. = TRUE, call. = FALSE)
+      warning("Could not find a '", id.col, 
+              "' column in 'starters'; skipping row naming.", 
+              immediate. = TRUE, call. = FALSE)
       row.rename <- FALSE
     }
     if (!is.na(match(id.col, colnames(targets)))) {
       outputCols <- targets[, id.col]
       if (any(duplicated(outputCols))) {
-        warning("The '", id.col, "' column in 'targets' contains duplicated values; skipping column naming.", immediate. = TRUE, call. = FALSE)
+        warning("The '", id.col, 
+                "' column in 'targets' contains duplicated values;",
+                " skipping column naming.", immediate. = TRUE, call. = FALSE)
         col.rename <- FALSE
       } else {
         col.rename <- TRUE
       }
     } else {
-      warning("Could not find a '", id.col, "' column in 'targets'; skipping column naming.", immediate. = TRUE, call. = FALSE)
+      warning("Could not find a '", id.col, 
+              "' column in 'targets'; skipping column naming.", 
+              immediate. = TRUE, call. = FALSE)
       col.rename <- FALSE
     }
   } else {
@@ -493,45 +574,110 @@ distancesMatrix <- function(t.layer, starters = NULL, targets = starters,
 
 
   #### Create starters and targets spatial dataframes
-  sp::coordinates(starters) <- ~ longitude + latitude # converts the file to a spatialPoints object
-  raster::crs(starters) <- raster::crs(t.layer) # sets the crs
-
-  sp::coordinates(targets) <- ~ longitude + latitude # converts the file to a spatialPoints object
+  # converts the file to a spatialPoints object
+  sp::coordinates(starters) <- ~ longitude + latitude 
+
+  # sets the crs
+  raster::crs(starters) <- raster::crs(t.layer) 
+
+  # converts the file to a spatialPoints object
+  sp::coordinates(targets) <- ~ longitude + latitude 
   raster::crs(targets) <- raster::crs(t.layer)
 
   # NOTE: THE LINES ABOVE COULD BE CHANGED ONCE gdistance'S
   # FUNCTIONS START LIKING SF OBJECTS LAYER
-  # starters <- sf::st_as_sf(starters, coords = c("longitude","latitude"), crs = ...)
-  # targets <- sf::st_as_sf(targets, coords = c("longitude","latitude"), crs = ...)
+  # starters <- sf::st_as_sf(starters, coords = c("longitude","latitude"), 
+  #   crs = ...)
+  # targets <- sf::st_as_sf(targets, coords = c("longitude","latitude"), 
+  #   crs = ...)
   # NOTE: currently, transition layer objects are not
   # responding correctly to crs requests (e.g. sf::st_crs)
 
   #### Calculate a matrix of distances to each object
   dist.mat <- data.frame(gdistance::costDistance(t.layer, starters, targets))
   if (any(dist.mat == Inf)) {
-    warning("At least one station is completely blocked off from the remaining stations by land. Filling
-the respective fields with NA. If your animals were expected to travel around the areas present
-in the shape file, consider applying a 'buffer' when calculating the transition layer. This
-will artificially add water space around the shape file.", call. = FALSE)
+    warning("At least one station is completely blocked off from the remaining",
+            " stations by land. Filling the respective fields with NA.", 
+            " If your animals were expected to travel around the areas present", 
+            " in the shape file, consider applying a 'buffer' when calculating", 
+            " the transition layer. This will artificially add water space", 
+            " around the shape file.", call. = FALSE)
     dist.mat[dist.mat == Inf] <- NA
   }
 
-  if (row.rename)
+  if (row.rename) {
     rownames(dist.mat) <- outputRows
+  }
 
-  if (col.rename)
+  if (col.rename) {
     colnames(dist.mat) <- outputCols
+  }
 
   if (interactive() & actel) { # nocov start
-    decision <- userInput("Would you like to save an actel-compatible distances matrix as 'distances.csv' in the current work directory?(y/n) ",
+    decision <- userInput(paste0("Would you like to save an actel-compatible", 
+                                 " distances matrix as 'distances.csv'?(y/n)"),
                           choices = c("y", "n"))
     if (decision == "y") {
-      if (file.exists('distances.csv')) {
-        warning("A file 'distances.csv' is already present in the current directory.", call. = FALSE, immediate. = TRUE)
-        decision <- userInput("Continuing will overwrite this file. Would you like to continue?(y/n) ", choices = c("y", "n"))
+       dir_decision <- userInput(paste0("Would you like 'distances.csv'",
+                                        " saved in the current working",
+                                        " directory?(y/n)"),
+                                 choices = c("y", "n"))
+       if (dir_decision == "n") {
+
+         target_dir <- ""
+
+         while (!dir.exists(target_dir)) {
+           target_dir <- readline(paste0("Specify the folder to save",
+                                         " 'distances.csv' to.",
+                                         " Hit enter to skip."))
+           if (nchar(target_dir) == 0) {
+             dir_decision <- "y"
+             break
+           } 
+
+           if (!dir.exists(target_dir)) {
+             dir_decision <- userInput(paste0("Directory specified not found.",
+                                              " Do you want to continue?(y/n)"),
+                                       choices = c("y", "n"))
+             if (dir_decision == "n") {
+               dir_decision <- "y"
+               break
+             }
+           }
+         }
+       }
+     }
+
+    if (decision == "y") {
+
+      if(dir_decision == "n") {
+
+        # If a different directory has been specified, a new path is created  
+        # where 'distances.csv' will be saved
+        path <- paste0(target_dir, "/distances.csv")
+
+      } else {
+        # If no 'path' specified, then 'distances.csv' is saved to the 
+        # current working directory
+
+        path <- paste("distances.csv", sep = "/")
+
+      }
+      # Checks if 'distances.csv' is already in the file path specified
+      if (file.exists(path)) {
+
+        warning("A file 'distances.csv' is already present in the current",
+                " directory.", call. = FALSE, immediate. = TRUE)
+
+        decision <- userInput(paste0("Continuing will overwrite this file.",
+                                     "  Would you like to continue?(y/n) "), 
+                              choices = c("y", "n"))
+      }
+      if (decision == "y") {
+
+        write.csv(round(dist.mat, 0), path, row.names = TRUE)
+
       }
-      if (decision == "y")
-        write.csv(round(dist.mat, 0), "distances.csv", row.names = TRUE)
     }
   } # nocov end
   return(round(dist.mat, 0))