Feat/position along group axis

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)
+}