Nothing
#' Generate group by individual matrix
#'
#'
#' \code{get_gbi} generates a group by individual matrix. The function accepts a
#' \code{data.table} with individual identifiers and a group column. The group
#' by individual matrix can then be used to build a network using
#' \code{\link[asnipe:get_network]{asnipe::get_network}}.
#'
#' 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}}.
#'
#' The \code{group} argument expects the name of a column which corresponds to
#' an integer group identifier (generated by \code{\link{spatsoc}}'s grouping
#' functions).
#'
#' The \code{id} argument expects the name of a column which corresponds to the
#' individual identifier.
#'
#' @return \code{get_gbi} returns a group by individual matrix (columns
#' represent individuals and rows represent groups).
#'
#' Note that \code{get_gbi} is identical in function for turning the outputs
#' of \code{spatsoc} into social networks as
#' \code{\link[asnipe:get_group_by_individual]{asnipe::get_group_by_individual}}
#' but is more efficient thanks to
#' \code{\link[data.table:dcast.data.table]{data.table::dcast}}.
#'
#' @inheritParams group_pts
#' @param group Character string of group column (generated from one of
#' spatsoc's spatial grouping functions)
#' @export
#'
#' @seealso \code{\link{group_pts}} \code{\link{group_lines}}
#' \code{\link{group_polys}}
#' @family Social network tools
#'
#' @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')]
#' DT[, yr := year(datetime)]
#'
#' # EPSG code for example data
#' utm <- 'EPSG:32736'
#'
#' group_polys(DT, area = FALSE, hrType = 'mcp',
#' hrParams = list(percent = 95),
#' projection = utm, id = 'ID', coords = c('X', 'Y'),
#' splitBy = 'yr')
#'
#' gbiMtrx <- get_gbi(DT = DT, group = 'group', id = 'ID')
#'
get_gbi <-
function(DT = NULL,
group = 'group',
id = NULL) {
if (is.null(DT)) {
stop('input DT required')
}
if (is.null(group)) {
stop('group field required')
}
if (is.null(id)) {
stop('ID field required')
}
if (any(!(c(group, id) %in% colnames(DT)))) {
stop(paste0(
as.character(paste(setdiff(
c(group, id),
colnames(DT)
), collapse = ', ')),
' field(s) provided are not present in input DT'
))
}
if (anyNA(DT[[group]])) {
warning('DT contains NA(s) in group column, these rows will be dropped')
}
uDT <-
stats::na.omit(unique(DT[, .SD, .SDcols = c(group, id)]),
cols = group)
cDT <-
data.table::dcast(
uDT,
formula = stats::reformulate(id, group),
fun.aggregate = length,
value.var = group
)
ids <- colnames(cDT)[!grepl(group, colnames(cDT))]
m <- as.matrix(cDT[, .SD, .SDcols = ids])
rownames(m) <- cDT[[group]]
return(m)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.