Add process_surface() and dist_btw_clicks() functions.

R/dists.R

@@ -68,6 +68,50 @@ dist_btw_receivers <-
 
 }
 
+
+######################################
+######################################
+#### dist_btw_clicks()
+
+#' @title Calculate the distance between sequential mouse clicks on a map
+#' @description This function calculates the distance between sequential mouse clicks on a plotted map, by combining \code{\link[graphics]{locator}} with a distance calculator, such as \code{\link[raster]{pointDistance}}.
+#'
+#' @param calc_distance A function that calculates distances between two sets of points, such as \code{\link[raster]{pointDistance}}. The first two arguments of this function must accept a dataframe comprising the x and y coordinates of the first and second set of points respectively. The function must return a numeric vector of distances between these.
+#' @param ... Additional arguments passed to \code{calc_distance}, such as \code{lonlat} for \code{\link[raster]{pointDistance}}.
+#' @param add_paths (optional) A named list of arguments, passed to \code{\link[prettyGraphics]{add_sp_path}}, to customise the paths added to the plot. \code{add_paths = NULL} suppresses this option.
+#'
+#' @return The function returns a dataframe with an integer ID for each path segment (`segment'), the first and second x and y coordinates (`x', `x2', `y', `y2`) and the distances between these points (`dist'). If \code{add_paths} is not \code{NULL}, the segments are drawn on the map.
+#'
+#' @examples
+#' \dontrun{
+#' raster::plot(dat_gebco)
+#' dist_btw_clicks(lonlat = FALSE)
+#' }
+#'
+#' @author Edward Lavender
+#' @export
+#'
+
+dist_btw_clicks <- function(calc_distance = raster::pointDistance,..., add_paths = list(length = 0.025)){
+  cat("Please click locations on the map and press [Esc] when you are done...\n")
+  dat <- locator()
+  cat("Getting distances...\n")
+  dat <- data.frame(segment = 1:length(dat$x),
+                    x = dat$x,
+                    x2 = dplyr::lead(dat$x),
+                    y = dat$y,
+                    y2 = dplyr::lead(dat$y))
+  if(!is.null(add_paths)){
+    add_paths$x <- dat$x
+    add_paths$y <- dat$y
+    do.call(prettyGraphics::add_sp_path, add_paths)
+  }
+  dat <- dat[complete.cases(dat), ]
+  dat$dist <- raster::pointDistance(dat[, c("x", "y")], dat[, c("x2", "y2")],...)
+  return(dat)
+}
+
+
 ######################################
 ######################################
 #### dist_btw_points_3d()

R/flapper-package.R

@@ -24,6 +24,7 @@
 #'     \item \link{process_false_detections_sf} passes putative false detections through a spatial filter which incorporates ancillary information on receiver locations and animal swimming speeds to interrogate their plausibility;
 #'     \item \link{process_quality_check} passes acoustic data through some basic quality checks prior to analysis;
 #'     \item \link{process_behav_rest} identifies `resting' behaviour within depth time series;
+#'     \item \link{process_surface} determines an 'optimum' \code{\link[raster]{raster}} aggregation method and error induced by this process;
 #'    }
 #' }
 #'
@@ -44,6 +45,7 @@
 #' \itemize{
 #'   \item Euclidean distances
 #'   \itemize{
+#'     \item \link{dist_btw_clicks} calculates distances and draws segments between sequential mouse clicks on a map;
 #'     \item \link{dist_btw_receivers} calculates the Euclidean distances between all combinations of receivers;
 #'     \item \link{dist_btw_points_3d} calculates the Euclidean distances between points in three-dimensional space;
 #'     \item \link{dist_over_surface} calculates the Euclidean distance along a path over a three-dimensional surface;

R/processing.R

@@ -695,3 +695,105 @@ process_behav_rest <- function(archival,
   #### Return outputs
   return(archival$state_2)
 }
+
+
+#########################################
+#########################################
+#### process_surface()
+
+#' @title Process a Raster* by aggregation and quantify the error induced by this process
+#' @description This function reduces the resolution of a \code{\link[raster]{raster}} by multiple aggregation methods and then quantifies the relative error induced by each method from the differences between the original values and the aggregated values. To implement the function, a \code{\link[raster]{raster}} (\code{x}) must be supplied as well as an aggregation factor (\code{fact}) and a named list of functions (\code{stat}) used to aggregate the \code{\link[raster]{raster}}. The \code{\link[raster]{raster}} is aggregated using each method (function) and mapped back onto the original resolution for calculation of the differences between the original \code{\link[raster]{raster}} and the aggregated \code{\link[raster]{raster}}(s). The function returns a visual statistical summary of the differences (if \code{plot = TRUE}) and a named list comprising the aggregated \code{\link[raster]{raster}}(s) and the re-sampled version(s) of those mapped back onto the original resolution.
+#'
+#' @param x A \code{\link[raster]{raster}} to be processed. For implementations preceding a call to of one of \code{\link[flapper]{flapper}}'s particle filtering algorithms, \code{x} should be planar (i.e., Universal Transverse Mercator projection) with equal resolution in the x, y directions and identical units in the x, y and z directions (e.g., see \code{\link[flapper]{dcpf}}).
+#' @param fact A positive integer that defines by how much \code{x} should be aggregated (see \code{\link[raster]{aggregate}}).
+#' @param stat A named list of functions used to aggregate \code{x} (see the \code{fun} argument of \code{\link[raster]{aggregate}}).
+#' @param ... Additional arguments passed to \code{\link[raster]{aggregate}} to control aggregation.
+#' @param plot A logical input that defines whether or not to plot a summary of the differences between the original \code{\link[raster]{raster}} (\code{x}) and the aggregated \code{\link[raster]{raster}}(s). If specified, the minimum, median and maximum difference are shown for each statistic (\code{stat}).
+#' @param cl (optional) A cluster object created by \code{\link[parallel]{makeCluster}}. If supplied, the connection to the cluster is stopped within the function.
+#' @param varlist (optional) A character vector of names of objects to export, to be passed to the \code{varlist} argument of \code{\link[parallel]{clusterExport}}. This may be required if \code{cl} is supplied. Exported objects must be located in the global environment.
+#' @param verbose A logical input that defines whether or not to print messages to the console to relay function progress.
+#'
+#' @details This function was motivated by the particle filtering algorithms in \code{\link[flapper]{flapper}} (e.g., \code{\link[flapper]{dcpf}}). For these algorithms, it is computationally beneficial to reduce \code{\link[raster]{raster}} resolution, where possible, by aggregation. To facilitate this process, this function quantifies the relative error induced by different aggregation functions. If appropriate, the particle filtering algorithm(s) can then be implemented using the aggregated \code{\link[raster]{raster}} that minimises the error, with the magnitude of that error propagated via the \code{depth_error} parameter.
+#'
+#' @return The function returns a plot of the differences between the original and aggregated \code{\link[raster]{raster}}(s), if \code{plot = TRUE}, and a named list of (a) the aggregated \code{\link[raster]{raster}}(s) (`agg_by_stat'), (b) the aggregated, resampled \code{\link[raster]{raster}}(s) (`agg_by_stat_rs') and (c) the summary statistics plotted.
+#'
+#' @examples
+#' # Define the raster for which to implement the function
+#' x <- dat_gebco
+#' blank <- raster::raster(raster::extent(x), crs = raster::crs(x), resolution = 250)
+#' x <- raster::resample(x, blank, method = "bilinear")
+#' # Implement function using a list of statistics
+#' out <- process_surface(x, fact = 2, stat = list(min = min, mean = mean, median = median, max = max))
+#' summary(out)
+#'
+#' @seealso \code{\link[raster]{aggregate}}, \code{\link[raster]{resample}}
+#' @author Edward Lavender
+#' @export
+
+process_surface <- function(x,
+                            fact = 2L,
+                            stat = list(mean = mean),...,
+                            plot = TRUE,
+                            cl = NULL, varlist = NULL,
+                            verbose = TRUE){
+
+  # Set up function
+  t_onset <- Sys.time()
+  cat_to_console <- function(..., show = verbose) if(show) cat(paste(..., "\n"))
+  cat_to_console(paste0("flapper::process_surface() called (@ ", t_onset, ")..."))
+  check_named_list(input = stat)
+
+  # Define blank raster with same extent
+  x_blank <- x
+
+  # Aggregate raster by each statistic
+  cat_to_console("... Aggregating raster...")
+  if(!is.null(cl) & !is.null(varlist)) parallel::clusterExport(cl = cl, varlist = varlist)
+  x_agg_by_stat <- pbapply::pblapply(stat, cl = cl, function(foo){
+    x_agg <- raster::aggregate(x, fact = fact, fun = foo,...)
+    return(x_agg)
+  })
+
+  # Re-sample aggregated rasters to original resolution
+  cat_to_console("... Resampling aggregated raster(s) back onto the original resolution...")
+  x_agg_by_stat_rs <- pbapply::pblapply(x_agg_by_stat, cl = cl, function(x_agg){
+    x_agg_rs <- raster::resample(x_agg, x_blank, method = "ngb")
+    return(x_agg_rs)
+  })
+  if(!is.null(cl)) parallel::stopCluster(cl)
+
+  # Get differences between original raster and aggregated (resampled) rasters for each statistic
+  cat_to_console("... Computing differences between the original and aggregated raster(s)...")
+  x_agg_by_stat_rs_diff <- pbapply::pblapply(x_agg_by_stat_rs, function(x_agg_rs){
+    x_agg_rs_diff <- x - x_agg_rs
+    return(x_agg_rs_diff)
+  })
+
+  # Summarise differences
+  if(plot){
+    cat_to_console("... Summarising the differences between rasters across statistic(s)...")
+    mins <- sapply(x_agg_by_stat_rs_diff, raster::cellStats, stat = "min")
+    meds <- sapply(x_agg_by_stat_rs_diff, raster::cellStats, stat = "mean")
+    maxs <- sapply(x_agg_by_stat_rs_diff, raster::cellStats, stat = "max")
+    xp <- factor(names(stat), levels = names(stat))
+    prettyGraphics::pretty_plot(xp, meds,
+                                ylim = range(c(mins, maxs)),
+                                type = "n", xlab= "Statistic", ylab = "Difference [x - x_agg]")
+    prettyGraphics::add_error_bars(x = xp, fit = meds, lwr = mins, upr = maxs)
+    x_summary_stats <- data.frame(stat = names(stat),
+                                min = mins,
+                                median = meds,
+                                max = maxs)
+  } else x_summary_stats <- NULL
+
+
+  # Return outputs
+  out <- list(agg_by_stat = x_agg_by_stat,
+              agg_by_stat_rs_diff = x_agg_by_stat_rs_diff,
+              summary_stats = x_summary_stats)
+  t_end <- Sys.time()
+  duration <- difftime(t_end, t_onset, units = "mins")
+  cat_to_console(paste0("... flapper::process_surface() call completed (@ ", t_end, ") after ~", round(duration, digits = 2), " minutes."))
+  return(out)
+
+}

README.Rmd

@@ -95,6 +95,7 @@ A number of functions facilitate the acquisition, assembly, processing and check
     * `process_false_detections_sf()` passes putative false detections through a spatial filter which incorporates information on receiver locations and animal swimming speeds to interrogate their plausibility;
     * `process_quality_check()` passes acoustic data through some basic quality checks prior to analysis; 
     * `process_behav_rest()` identifies 'resting' behaviour within depth time series;
+    * `process_surface()` determines an 'optimum' raster aggregation method and error induced by this process;
 
 ## Spatial tools 
 
@@ -112,6 +113,7 @@ A number of functions facilitate spatial operations that support ecological inve
 
 Some functions facilitate standard distance calculations using Euclidean distances:
 
+* `dist_btw_clicks()` calculates distances and draws segments between sequential mouse clicks on a map; 
 * `dist_btw_receivers()` calculates the Euclidean distances between all combinations of receivers;
 * `dist_btw_points_3d()` calculates the Euclidean distances between points in three-dimensional space;
 * `dist_over_surface()` calculates the total Euclidean distance along a path over a three-dimensional surface;

README.md

@@ -208,6 +208,8 @@ and checking of passive acoustic telemetry time series:
         basic quality checks prior to analysis;
       - `process_behav_rest()` identifies ‘resting’ behaviour within
         depth time series;
+      - `process_surface()` determines an ‘optimum’ raster aggregation
+        method and error induced by this process;
 
 ## Spatial tools
 
@@ -235,6 +237,8 @@ ecological investigations and space use algorithms:
 Some functions facilitate standard distance calculations using Euclidean
 distances:
 
+  - `dist_btw_clicks()` calculates distances and draws segments between
+    sequential mouse clicks on a map;
   - `dist_btw_receivers()` calculates the Euclidean distances between
     all combinations of receivers;
   - `dist_btw_points_3d()` calculates the Euclidean distances between