Merge pull request #68 from ropensci/feat/dist-bearing-to-leader

Feat/distance and direction to leader

NAMESPACE

@@ -9,7 +9,9 @@ export(direction_group)
 export(direction_polarization)
 export(direction_step)
 export(direction_to_centroid)
+export(direction_to_leader)
 export(distance_to_centroid)
+export(distance_to_leader)
 export(dyad_id)
 export(edge_dist)
 export(edge_nn)

R/direction_group.R

@@ -16,8 +16,8 @@
 #' direction column is expected in units of radians and the mean calculated with
 #' [CircStats::circ.mean()].
 #'
-#' @param DT input data.table with distance column generated by
-#'   \code{distance_step} and group column generated with \code{group_pts}
+#' @param DT input data.table with direction column generated by
+#'   \code{direction_step} and group column generated with \code{group_pts}
 #' @param direction character string of direction column name, default
 #'   "direction"
 #' @param group character string of group column name, default "group"

R/direction_to_centroid.R

@@ -18,6 +18,7 @@
 #' expect the names of columns in \code{DT} which correspond to the X and Y
 #' coordinates and group columns.
 #'
+#' @inheritParams distance_to_centroid
 #' @inheritParams group_pts
 #'
 #' @return \code{direction_to_centroid} returns the input \code{DT} appended

R/direction_to_leader.R

@@ -0,0 +1,174 @@
+#' Direction to group leader
+#'
+#' \code{direction_to_leader} calculates the direction to the leader of each
+#' spatiotemporal group. The function accepts a \code{data.table} with
+#' relocation data appended with a \code{rank_position_group_direction} column
+#' indicating the ranked position along the group direction generated with
+#' \code{leader_direction_group(return_rank = TRUE)}. 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{rank_position_group_direction} column
+#' generated with \code{leader_direction_group(return_rank = TRUE)},
+#' a \code{group} column generated with the
+#' \code{group_pts} 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.
+#'
+#' @inheritParams distance_to_leader
+#'
+#' @return \code{direction_to_leader} returns the input \code{DT} appended with
+#'   a \code{direction_leader} column indicating the direction to the group leader.
+#'
+#'   A message is returned when the \code{direction_leader} column is already exist in the input \code{DT}
+#'   because it will be overwritten.
+#'
+#' @export
+#' @family Direction functions
+#' @seealso [distance_to_leader], [leader_direction_group], [group_pts]
+#' @references
+#'
+#' See examples of using direction to leader and position within group:
+#'  * <https://doi.org/10.1016/j.anbehav.2023.09.009>
+#'  * <https://doi.org/10.1016/j.beproc.2013.10.007>
+#'  * <https://doi.org/10.1371/journal.pone.0036567>
+#'
+#' @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'),
+#'   return_rank = TRUE
+#' )
+#'
+#' # Calculate direction to leader
+#' direction_to_leader(DT, coords = c('X', 'Y'))
+direction_to_leader <- function(
+    DT = NULL,
+    coords = NULL,
+    group = 'group') {
+  # Due to NSE notes
+  direction_leader <- rank_position_group_direction <- has_leader <-
+    zzz_N_by_group <- . <- NULL
+
+  if (is.null(DT)) {
+    stop('input DT required')
+  }
+
+  if (is.null(group)) {
+    stop('group column name required')
+  }
+
+  if (length(coords) != 2) {
+    stop('coords requires a vector of column names for coordinates X and Y')
+  }
+
+  if (!group %in% colnames(DT)) {
+    stop('group column not present in input DT, did you run group_pts?')
+  }
+
+  check_cols <- c(coords, group)
+
+  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')
+  }
+
+  leader_col <- 'rank_position_group_direction'
+
+  if (!leader_col %in% colnames(DT)) {
+    stop(paste0(
+      leader_col,
+      ' column not present in input DT, ',
+      'did you run leader_direction_group(return_rank = TRUE)?'))
+  }
+
+  if (!is.numeric(DT[[leader_col]])) {
+    stop(paste0(leader_col, ' column must be numeric'))
+  }
+
+  out_col <- 'direction_leader'
+  if (out_col %in% colnames(DT)) {
+    message(
+      paste0(out_col, ' column will be overwritten by this function')
+    )
+    data.table::set(DT, j = out_col, value = NULL)
+  }
+
+  check_has_leader <- DT[, .(
+    has_leader = any(rank_position_group_direction == 1)),
+    by = c(group)][!(has_leader)]
+
+  if (check_has_leader[, .N > 0]) {
+    warning(
+      'groups found missing leader (rank_position_group_direction == 1): \n',
+      check_has_leader[, paste(group, collapse = ', ')]
+    )
+  }
+
+  zzz_leader_coords <- c('zzz_leader_xcol', 'zzz_leader_ycol')
+  DT[, c(zzz_leader_coords) :=
+       .SD[which(rank_position_group_direction == 1)],
+     .SDcols = c(coords),
+     by = c(group)]
+
+  DT[!group %in% check_has_leader$group, direction_leader := fifelse(
+    .SD[[1]] == .SD[[3]] &
+      .SD[[2]] == .SD[[4]],
+    NaN,
+    atan2(.SD[[4]] - .SD[[2]], (.SD[[3]] - .SD[[1]]))
+  ),
+  .SDcols = c(coords, zzz_leader_coords)]
+
+  data.table::set(DT, j = zzz_leader_coords, value = NULL)
+
+  return(DT[])
+}

R/distance_to_centroid.R

@@ -22,12 +22,14 @@
 #' \code{data.table::frank}, see details at
 #' \code{\link[data.table:frank]{?data.table::frank}}.
 #'
-#' @inheritParams group_pts
+#' @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

R/distance_to_leader.R

@@ -0,0 +1,177 @@
+#' Distance to group leader
+#'
+#' \code{distance_to_leader} calculates the distance to the leader of each
+#' spatiotemporal group. The function accepts a \code{data.table} with
+#' relocation data appended with a \code{rank_position_group_direction} column
+#' indicating the ranked position along the group direction generated with
+#' \code{leader_direction_group(return_rank = TRUE)}. 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{rank_position_group_direction} column
+#' generated with \code{leader_direction_group(return_rank = TRUE)},
+#' a \code{group} column generated with the
+#' \code{group_pts} 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.
+#'
+#' @param DT input data.table with 'rank_position_group_direction' column
+#'   generated by \code{leader_direction_group} and group column generated by
+#'   \code{group_pts}
+#' @inheritParams leader_direction_group
+#'
+#' @return \code{distance_to_leader} returns the input \code{DT} appended with
+#'   a \code{distance_leader} column indicating the distance to the group leader.
+#'
+#'   A message is returned when the \code{distance_leader} column is already exist in the input \code{DT}
+#'   because it will be overwritten.
+#'
+#' @export
+#' @family Distance functions
+#' @seealso [direction_to_leader], [leader_direction_group], [group_pts]
+#' @references
+#'
+#' See examples of using distance to leader and position within group:
+#'  * <https://doi.org/10.1111/jfb.15315>
+#'  * <https://doi.org/10.1098/rspb.2017.2629>
+#'  * <https://doi.org/10.1016/j.anbehav.2023.09.009>
+#'
+#' @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')]
+#'
+#' # (Subset example data to reduce example run time)
+#' DT <- DT[year(datetime) == 2016]
+#'
+#' # 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'),
+#'   return_rank = TRUE
+#' )
+#'
+#' # Calculate distance to leader
+#' distance_to_leader(DT, coords = c('X', 'Y'))
+distance_to_leader <- function(
+    DT = NULL,
+    coords = NULL,
+    group = 'group') {
+  # Due to NSE notes
+  distance_leader <- zzz_N_by_group <- rank_position_group_direction <-
+    has_leader <- . <- NULL
+
+  if (is.null(DT)) {
+    stop('input DT required')
+  }
+
+  if (is.null(group)) {
+    stop('group column name required')
+  }
+
+  if (length(coords) != 2) {
+    stop('coords requires a vector of column names for coordinates X and Y')
+  }
+
+  if (!group %in% colnames(DT)) {
+    stop('group column not present in input DT, did you run group_pts?')
+  }
+
+  check_cols <- c(coords, group)
+
+  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')
+  }
+
+  leader_col <- 'rank_position_group_direction'
+
+  if (!leader_col %in% colnames(DT)) {
+    stop(paste0(
+      leader_col,
+      ' column not present in input DT, ',
+      'did you run leader_direction_group(return_rank = TRUE)?'))
+  }
+
+  if (!is.numeric(DT[[leader_col]])) {
+    stop(paste0(leader_col, ' column must be numeric'))
+  }
+
+
+  out_col <- 'distance_leader'
+  if (out_col %in% colnames(DT)) {
+    message(
+      paste0(out_col, ' column will be overwritten by this function')
+    )
+    data.table::set(DT, j = out_col, value = NULL)
+  }
+
+  DT[, zzz_N_by_group := .N, by = c(group)]
+
+  check_has_leader <- DT[, .(
+    has_leader = any(rank_position_group_direction == 1)),
+    by = c(group)][!(has_leader)]
+
+  if (check_has_leader[, .N > 0]) {
+    warning(
+      'groups found missing leader (rank_position_group_direction == 1): \n',
+      check_has_leader[, paste(group, collapse = ', ')]
+    )
+  }
+
+  DT[!group %in% check_has_leader$group,
+     c(out_col) := fifelse(
+       zzz_N_by_group > 1,
+       as.matrix(
+         stats::dist(cbind(.SD[[1]], .SD[[2]]))
+       )[, which(.SD[[3]] == 1)],
+       0
+     ),
+     .SDcols = c(coords, 'rank_position_group_direction'),
+     by = c(group)]
+
+  data.table::set(DT, j = 'zzz_N_by_group', value = NULL)
+
+  return(DT[])
+}