R/dyads.R

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

#' Dyad ID
#'
#' Generate a dyad ID for edge list generated by \code{\link{edge_nn}} or
#' \code{\link{edge_dist}}.
#'
#' An undirected edge identifier between, for example individuals A and B will
#' be A-B (and reverse B and A will be A-B). Internally sorts and pastes id
#' columns.
#'
#' More details in the edge and dyad vignette (in progress).
#'
#' @param id1 ID1 column name generated by `edge_dist` or `edge_nn`
#' @param id2 ID2 column name generated by `edge_dist` or `edge_nn`
#' @param DT input data.table with columns id1 and id2, as generated by
#'   `edge_dist` or `edge_nn`
#'
#' @return `dyad_id` returns the input `data.table` with appended "dyadID"
#'   column
#'
#' @export
#'
#' @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')
#'
#' # Edge list generation
#' edges <- edge_dist(
#'     DT,
#'     threshold = 100,
#'     id = 'ID',
#'     coords = c('X', 'Y'),
#'     timegroup = 'timegroup',
#'     returnDist = TRUE,
#'     fillNA = TRUE
#'   )
#'
#' # Generate dyad IDs
#' dyad_id(edges, 'ID1', 'ID2')
dyad_id <- function(DT = NULL, id1 = NULL, id2 = NULL) {
  # due to NSE notes in R CMD check
  ID1 <- ID2 <- dyadID <- NULL

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

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

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

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

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

  ids <- unique(stats::na.omit(c(DT[[id1]], DT[[id2]])))
  dyads <- data.table::CJ(ID1 = ids, ID2 = ids)[ID1 != ID2]
  dyads[, dyadID :=
          apply(
            X = .SD,
            MARGIN = 1,
            FUN = function(x)
              paste(sort(x), collapse = '-')
          )]

  data.table::setnames(dyads, c('ID1', 'ID2'), c(id1, id2))

  return(DT[dyads, dyadID := dyadID, on = c(id1, id2)][])
}