From 8038e659cdb3c89ed4a014764c8836390ce49339 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 19 Jul 2024 11:58:14 -0300 Subject: [PATCH] fst group_leader --- R/group_leader.R | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) create mode 100644 R/group_leader.R diff --git a/R/group_leader.R b/R/group_leader.R new file mode 100644 index 0000000..0b9b511 --- /dev/null +++ b/R/group_leader.R @@ -0,0 +1,48 @@ +#' Position along group's mean bearing as leadership order +#' +#' Given the mean bearing of a group of animals, shifts the coordinate +#' system to a new origin at the group centroid and rotates the coordinate system +#' by the mean bearing. Returns the distance along the mean bearing as +#' the front-back position in group. +#' +#' @param DT +#' @param group_bearing group_bearing column name generated by eg. group_bearing, +#' default 'group_mean_bearing' +#' @param coords character vector of column names for x, y +#' @param group group column generated by eg. group_pts +#' @param return_rank if rank along mean bearing should also be returned, +#' used by functions bearing_to_leader, distance_to_leader +#' @param ties.method default: 'average', see ?data.table::frank. Note if +#' multiple individuals in a group have identical coordinates, they will +#' receive an average rank (eg. 1.5, 2.5) which may indicate some data cleaning +#' is required. +group_leader <- function(DT, group_bearing = 'group_mean_bearing', coords = c('x', 'y'), + group = 'group', return_rank = FALSE, + ties.method = 'average') { + + xcol <- first(coords) + ycol <- last(coords) + xcol_group <- paste0('group_mean_', xcol) + ycol_group <- paste0('group_mean_', ycol) + + stopifnot(group_bearing %in% colnames(DT)) + stopifnot(group %in% colnames(DT)) + stopifnot(xcol %in% colnames(DT)) + stopifnot(ycol %in% colnames(DT)) + stopifnot(xcol_group %in% colnames(DT)) + stopifnot(ycol_group %in% colnames(DT)) + + DT[, dist_along_group_bearing := + cos(.SD[[group_bearing]]) * (.SD[[xcol]] - .SD[[xcol_group]]) + + sin(.SD[[group_bearing]]) * (.SD[[ycol]] - .SD[[ycol_group]]), + by = .I] + + if (return_rank) { + DT[, N_by_group := .N, by = c(group)] + DT[, rank_dist_along_group_bearing := + data.table::frank(-dist_along_group_bearing, ties.method = ties.method), + by = c(group)] + } + + return(DT) +}