R/leader_direction_group.R

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

#' Leadership along group direction
#'
#' Given the mean direction of a group of animals, \code{leader_direction_group}
#' shifts the coordinate system to a new origin at the group centroid and
#' rotates the coordinate system by the mean direction to return each
#' individual's position along the mean direction, representing leadership in
#' terms of the front-back position in each group's mean direction.
#'
#' The function accepts a \code{data.table} with relocation data appended with a
#' \code{group_direction} column from \code{direction_group} and group centroid
#' columns from \code{centroid_group}. Relocation data should be 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}}.
#'
#' The \code{group_direction} argument expects the names of columns in \code{DT}
#' which correspond to the mean group direction generated by
#' \code{direction_group}. The mean group direction column is expected in units
#' of radians. The \code{coords} arguments expects the names of columns in
#' \code{DT} which correspond to the X and Y coordinate columns. The
#' \code{return_rank} argument controls if the rank of each individual's
#' distance to the group centroid is also returned. If \code{return_rank} is
#' TRUE, the \code{group} argument is required to specify the group column
#' generated by \code{group_pts}. The \code{ties.method} argument is passed to
#' \code{data.table::frank}, see details at
#' \code{\link[data.table:frank]{?data.table::frank}}.
#'
#' @return \code{leader_direction_group} returns the input \code{DT} appended
#'   with a \code{position_group_direction} column indicating the position along
#'   the group direction in the units of the projection and, optionally when
#'   \code{return_rank = TRUE}, a \code{rank_position_group_direction} column
#'   indicating the the ranked position along the group direction.
#'
#'   A message is returned when \code{position_group_direction} or
#'   \code{rank_position_group_direction} columns already exist in the input
#'   \code{DT}, because they will be overwritten.
#'
#' @param DT input data.table with group direction columns generated by
#'   \code{direction_group} and centroid columns generated by
#'   \code{centroid_group}
#' @inheritParams distance_to_centroid
#' @inheritParams group_pts
#' @param group_direction group_direction column name generated using
#'   \code{direction_group}, default 'group_direction'
#'
#' @export
#' @seealso \code{\link{direction_group}}, \code{\link{centroid_group}}
#' @family Leadership functions
#'
#' @references
#' See examples of measuring leadership along group direction (also called
#' forefront index):
#'  * <https://doi.org/10.1371/journal.pone.0036567>
#'  * <https://doi.org/10.1111/jfb.15315>
#'  * <https://doi.org/10.1098/rspb.2021.0839>
#'
#' @examples
#' # Load data.table
#' library(data.table)
#' \dontshow{data.table::setDTthreads(1)}
#'
#' # Read example data
#' DT <- fread(system.file("extdata", "DT.csv", package = "spatsoc"))
#'
#' # (Subset example data to reduce example run time)
#' DT <- DT[year(datetime) == 2016]
#'
#' # 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 = 50, id = 'ID',
#'           coords = c('X', 'Y'), timegroup = 'timegroup')
#'
#' # Calculate direction at each step
#' direction_step(
#'   DT = DT,
#'   id = 'ID',
#'   coords = c('X', 'Y'),
#'   projection = 32736
#' )
#'
#' # Calculate group centroid
#' centroid_group(DT, coords = c('X', 'Y'))
#'
#' # Calculate group direction
#' direction_group(DT)
#'
#' # Calculate leader in terms of position along group direction
#' leader_direction_group(DT, coords = c('X', 'Y'))
leader_direction_group <- function(
    DT = NULL,
    group_direction = 'group_direction',
    coords = NULL,
    group = 'group',
    return_rank = FALSE,
    ties.method = 'average') {
  # Due to NSE notes
  position_group_direction <- rank_position_group_direction <- 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')
  }

  xcol <- data.table::first(coords)
  ycol <- data.table::last(coords)

  centroid_xcol <- paste0('centroid_', gsub(' ', '', xcol))
  centroid_ycol <- paste0('centroid_', gsub(' ', '', ycol))

  check_cols <- c(coords, group_direction, centroid_xcol, centroid_ycol)

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

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

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

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

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

  if (DT[, !inherits(.SD[[1]], 'units'), .SDcols = c(group_direction)] ||
      DT[, units(.SD[[1]])$numerator != 'rad', .SDcols = c(group_direction)]) {
    stop(
      'units(DT$group_direction) is not radians, did you use direction_group?'
    )
  }

  DT[, position_group_direction :=
       cos(units::drop_units(.SD[[1]])) * (.SD[[2]] - .SD[[4]]) +
       sin(units::drop_units(.SD[[1]])) * (.SD[[3]] - .SD[[5]]),
     by = .I,
     .SDcols = c(group_direction, xcol, ycol, centroid_xcol, centroid_ycol)]

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

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

    DT[, rank_position_group_direction :=
         data.table::frank(-position_group_direction,
                           ties.method = ties.method),
       by = c(group)]
  }

  return(DT[])
}