#' 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)][])
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.