R/distance_to_centroid.R

In ropensci/spatsoc: Group Animal Relocation Data by Spatial and Temporal Relationship

#' Distance to group centroid
#'
#' \code{distance_to_centroid} calculates the distance of each relocation to the
#' centroid of the spatiotemporal group identified by \code{group_pts}. The
#' function accepts a \code{data.table} with relocation data appended with a
#' \code{group} column from \code{group_pts} and centroid columns from
#' \code{centroid_group}. Relocation data should be in planar coordinates
#' provided in two columns representing the X and Y coordinates.
#'
#' The \code{DT} must be a \code{data.table}. If your data is a
#' \code{data.frame}, you can convert it by reference using
#' \code{\link[data.table:setDT]{data.table::setDT}} or by reassigning using
#' \code{\link[data.table:data.table]{data.table::data.table}}.
#'
#' This function expects a \code{group} column present generated with the
#' \code{group_pts} function and centroid coordinate columns generated with the
#' \code{centroid_group} function. The \code{coords} and \code{group} arguments
#' expect the names of columns in \code{DT} which correspond to the X and Y
#' coordinates and group columns. The \code{return_rank} argument controls if
#' the rank of each individual's distance to the group centroid is also
#' returned. The \code{ties.method} argument is passed to
#' \code{data.table::frank}, see details at
#' \code{\link[data.table:frank]{?data.table::frank}}.
#'
#' @param DT input data.table with centroid columns generated by eg.
#'   \code{centroid_group}
#' @param group group column name, generated by \code{group_pts}, default
#'   'group'
#' @param return_rank boolean if rank distance should also be returned, default
#'   FALSE
#' @param ties.method see \code{\link[data.table:frank]{?data.table::frank}}
#' @inheritParams group_pts
#'
#' @return \code{distance_to_centroid} returns the input \code{DT} appended with
#'   a \code{distance_centroid} column indicating the distance to group centroid
#'   and, optionally, a \code{rank_distance_centroid} column indicating the
#'   within group rank distance to group centroid (if \code{return_rank =
#'   TRUE}).
#'
#'   A message is returned when \code{distance_centroid} and optional
#'   \code{rank_distance_centroid} columns already exist in the input \code{DT},
#'   because they will be overwritten.
#'
#' @export
#' @family Distance functions
#' @seealso [centroid_group], [group_pts]
#' @references
#' See examples of using distance to group centroid:
#'  * <https://doi.org/10.1016/j.anbehav.2021.08.004>
#'  * <https://doi.org/10.1111/eth.12336>
#'  * <https://doi.org/10.1007/s13364-018-0400-2>
#'
#' @examples
#' # Load data.table
#' library(data.table)
#' \dontshow{data.table::setDTthreads(1)}
#'
#' # Read example data
#' DT <- fread(system.file("extdata", "DT.csv", package = "spatsoc"))
#'
#' # Cast the character column to POSIXct
#' DT[, datetime := as.POSIXct(datetime, tz = 'UTC')]
#'
#' # Temporal grouping
#' group_times(DT, datetime = 'datetime', threshold = '20 minutes')
#'
#' # Spatial grouping with timegroup
#' group_pts(DT, threshold = 5, id = 'ID',
#'           coords = c('X', 'Y'), timegroup = 'timegroup')
#'
#' # Calculate group centroid
#' centroid_group(DT, coords = c('X', 'Y'), group = 'group', na.rm = TRUE)
#'
#' # Calculate distance to group centroid
#' distance_to_centroid(
#'   DT,
#'   coords = c('X', 'Y'),
#'   group = 'group',
#'   return_rank = TRUE
#' )
distance_to_centroid <- function(
    DT = NULL,
    coords = NULL,
    group = 'group',
    return_rank = FALSE,
    ties.method = NULL) {

  # Due to NSE notes in R CMD check
  distance_centroid <- rank_distance_centroid <- NULL

  if (is.null(DT)) {
    stop('input DT required')
  }

  if (length(coords) != 2) {
    stop('coords requires a vector of column names for coordinates X and Y')
  }

  if (is.null(return_rank)) {
    stop('return_rank required')
  }

  xcol <- data.table::first(coords)
  ycol <- data.table::last(coords)
  pre <- 'centroid_'
  centroid_xcol <- paste0(pre, xcol)
  centroid_ycol <- paste0(pre, ycol)
  centroid_coords  <- c(centroid_xcol, centroid_ycol)

  if (any(!(coords %in% colnames(DT)))) {
    stop(paste0(
      as.character(paste(setdiff(
        coords,
        colnames(DT)
      ), collapse = ', ')),
      ' field(s) provided are not present in input DT'
    ))
  }

  if (any(!(DT[, vapply(.SD, is.numeric, TRUE), .SDcols = c(coords)]))) {
    stop('coords must be numeric')
  }

  if (any(!(centroid_coords %in% colnames(DT)
  ))) {
    stop(paste0(
      as.character(paste(setdiff(
        centroid_coords,
        colnames(DT)
      ), collapse = ', ')),
      ' field(s) provided are not present in DT, did you run centroid_group?'
    ))
  }

  if (any(!(DT[, vapply(.SD, is.numeric, TRUE), .SDcols = c(centroid_coords)]))) {
    stop('centroid coords must be numeric')
  }

  if ('distance_centroid' %in% colnames(DT)) {
    message('distance_centroid column will be overwritten by this function')
    data.table::set(DT, j = 'distance_centroid', value = NULL)
  }

  DT[, distance_centroid :=
       sqrt((.SD[[xcol]] - .SD[[centroid_xcol]])^2 +
              (.SD[[ycol]] - .SD[[centroid_ycol]])^2)]

  if (return_rank) {
    if (is.null(group)) {
      stop('group column name required')
    }

    if (!group %in% colnames(DT)) {
      stop('group column not present in input DT, did you run group_pts?')
    }

    if ('rank_distance_centroid' %in% colnames(DT)) {
      message(
        'rank_distance_centroid column will be overwritten by this function'
      )
      data.table::set(DT, j = 'rank_distance_centroid', value = NULL)
    }

    DT[, rank_distance_centroid :=
         data.table::frank(distance_centroid,  ties.method = ties.method),
       by = c(group)]
  }
  return(DT[])
}