From 483b59e80fe5fd9b3d4f3fcb74014ce9dc691b60 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 19 Jul 2024 12:03:12 -0300 Subject: [PATCH 001/104] fst edge delay --- R/edge_delay.R | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) create mode 100644 R/edge_delay.R diff --git a/R/edge_delay.R b/R/edge_delay.R new file mode 100644 index 00000000..da9654c2 --- /dev/null +++ b/R/edge_delay.R @@ -0,0 +1,58 @@ +#' Directional correlation delay edge lists +#' +#' Temporal delay in absolute bearing between individuals +#' +#' @param DT relocation data +#' @param edges edges generated with edges_dist +#' @param window integer window in timegroups generated with group_times +edge_delay <- function(DT, id = NULL, edges, window = NULL) { + stopifnot(!is.null(id)) + stopifnot(!is.null(window)) + + stopifnot(id %in% colnames(DT)) + + setnames(DT, id, 'id') + + stopifnot('dyadID' %in% colnames(edges)) + stopifnot('timegroup' %in% colnames(edges)) + stopifnot('fusionID' %in% colnames(edges)) + stopifnot('dyadID' %in% colnames(edges)) + + stopifnot('bearing' %in% colnames(DT)) + stopifnot('timegroup' %in% colnames(DT)) + + # TODO: check window isnt in colnames + + setorder(DT, timegroup) + + id_tg <- edges[!is.na(fusionID), .( + tg = unique(timegroup), + dyadID = unique(dyadID), + ID1 = first(ID1), + ID2 = first(ID2) + ), by = fusionID] + id_tg[, min_tg := data.table::fifelse(tg - window < min(tg), min(tg), tg - window), + by = fusionID] + id_tg[, max_tg := data.table::fifelse(tg + window < min(tg), min(tg), tg + window), + by = fusionID] + + id_tg[, delay_tg := { + focal_bearing <- DT[timegroup == .BY$tg & id == ID1, bearing] + DT[between(timegroup, min_tg, max_tg) & id == ID2, + timegroup[which.min(delta_rad(focal_bearing, bearing))]] + }, by = .(tg, dyadID)] + + id_tg[, dir_corr_delay := tg - delay_tg] + + data.table::setnames(id_tg, c('tg'), c('timegroup')) + data.table::set(id_tg, j = c('min_tg', 'max_tg','delay_tg'), value = NULL) + data.table::setorder(id_tg, timegroup, ID1, ID2, dir_corr_delay) + + out <- data.table::rbindlist(list( + id_tg, + id_tg[, .(timegroup, dyadID, fusionID, + ID1 = ID2, ID2 = ID1, dir_corr_delay = - dir_corr_delay)] + ), use.names = TRUE) + + return(out) +} From 0b89f6d0b286d68c3928852d2583cb67c3ca334f Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 1 Nov 2024 16:25:21 -0300 Subject: [PATCH 002/104] internal delta_rad function --- R/internal.R | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 R/internal.R diff --git a/R/internal.R b/R/internal.R new file mode 100644 index 00000000..2811ff04 --- /dev/null +++ b/R/internal.R @@ -0,0 +1,29 @@ +#' Difference of two angles measured in radians +#' +#' Internal function +#' +#' @param target angle in radians +#' @param source angle in radians +#' @param signed boolean if signed difference should be returned, default FALSE +#' +#' @return +#' @references adapted from https://stackoverflow.com/a/7869457 +#' +#' @examples +delta_rad <- function(target, source, signed = FALSE) { + if (!inherits(target, 'units') || units(target$numerator != 'rad')) { + stop('units(targets) is not radians') + } + if (!inherits(source, 'units') || units(target$numerator != 'rad')) { + stop('units(source) is not radians') + } + + d <- source - target + d <- (d + pi) %% (2 * pi) - pi + + if (signed) { + return(d) + } else { + return(abs(d)) + } +} From 455568e29e72798de2d783eb815725575f2a91d7 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 16:44:32 -0400 Subject: [PATCH 003/104] title --- R/edge_delay.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index da9654c2..65ba66c8 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -1,4 +1,4 @@ -#' Directional correlation delay edge lists +#' Directional correlation delay based edge lists #' #' Temporal delay in absolute bearing between individuals #' From a458550ac578104a1dd1c1176424048ab13a7d93 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 16:44:38 -0400 Subject: [PATCH 004/104] description --- R/edge_delay.R | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 65ba66c8..cdcd6317 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -1,11 +1,26 @@ #' Directional correlation delay based edge lists #' -#' Temporal delay in absolute bearing between individuals +#' \code{edge_delay} returns edge lists defined by the directional correlation +#' delay between individuals. The function expects a \code{data.table} with +#' relocation data, distance based edge lists, individual identifiers and a window argument. The +#' window argument is used to specify the temporal window within which to consider +#' the directional correlation delay. Relocation data should be in two columns +#' representing the X and Y coordinates. +#' +#' The \code{DT} and \code{edges} must be \code{data.table}s. 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{DT} and \code{edges} are internally matched in this function using +#' the columns \code{timegroup} (from \code{group_times}) and \code{ID1} and +#' \code{ID2} (in \code{edges}, from \code{dyad_id}) with \code{id} (in +#' \code{DT}). This function expects a \code{fusionID} present, generated with +#' the \code{fusion_id} function. The \code{timegroup} argument expects the +#' names of a column in \code{edges} which correspond to the timegroup column. +#' The \code{id}, \code{direction} and \code{timegroup} arguments expect the names +#' of a column in \code{DT} which correspond to the id, direction and +#' timegroup columns. #' -#' @param DT relocation data -#' @param edges edges generated with edges_dist -#' @param window integer window in timegroups generated with group_times -edge_delay <- function(DT, id = NULL, edges, window = NULL) { stopifnot(!is.null(id)) stopifnot(!is.null(window)) From 79d67929f295bc6ab83d1c8eb8ef1279f23f2a89 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 16:44:41 -0400 Subject: [PATCH 005/104] params --- R/edge_delay.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/edge_delay.R b/R/edge_delay.R index cdcd6317..b091061d 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -21,6 +21,11 @@ #' of a column in \code{DT} which correspond to the id, direction and #' timegroup columns. #' +#' @inheritParams centroid_fusion +#' @inheritParams direction_group +#' @param window temporal window in unit of timegroup column generated with +#' \code{group_times}, eg. \code{window = 4} corresponds to the 4 timegroups +#' before and after the focal observation stopifnot(!is.null(id)) stopifnot(!is.null(window)) From 6f864c60f0fd193f48f601139a6f8f952c3e5a8a Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 16:44:43 -0400 Subject: [PATCH 006/104] return --- R/edge_delay.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/edge_delay.R b/R/edge_delay.R index b091061d..17795a36 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -26,6 +26,11 @@ #' @param window temporal window in unit of timegroup column generated with #' \code{group_times}, eg. \code{window = 4} corresponds to the 4 timegroups #' before and after the focal observation +#' +#' @return \code{edge_delay} returns the input \code{edges} appended with +#' a 'dir_corr_delay' column indicating the temporal delay (in units of +#' timegroups) at which ID1's direction of movement is most similar to +#' ID2's direction of movement, within the temporal window defined. stopifnot(!is.null(id)) stopifnot(!is.null(window)) From 7dfb16a2de1562d7e59eeef80186e21fc291647b Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 16:46:22 -0400 Subject: [PATCH 007/104] example --- R/edge_delay.R | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/R/edge_delay.R b/R/edge_delay.R index 17795a36..43d666bf 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -31,6 +31,62 @@ #' a 'dir_corr_delay' column indicating the temporal delay (in units of #' timegroups) at which ID1's direction of movement is most similar to #' ID2's direction of movement, within the temporal window defined. +#' +#' @export +#' +#' @family Edge-list generation +#' +#' @examples +#' # Load data.table +#' library(data.table) +#' \dontshow{data.table::setDTthreads(1)} +#' +#' # Read example data +#' DT <- fread(system.file("extdata", "DT.csv", package = "spatsoc")) +#' +#' # Select only individuals A, B, C for this example +#' DT <- DT[ID %in% c('A', 'B', 'C')] +#' +#' # Cast the character column to POSIXct +#' DT[, datetime := as.POSIXct(datetime, tz = 'UTC')] +#' +#' # Temporal grouping +#' group_times(DT, datetime = 'datetime', threshold = '20 minutes') +#' +#' # Calculate direction +#' direction_step( +#' DT = DT, +#' id = 'ID', +#' coords = c('X', 'Y'), +#' projection = 32736 +#' ) +#' +#' # Distance based edge list generation +#' edges <- edge_dist( +#' DT, +#' threshold = 100, +#' id = 'ID', +#' coords = c('X', 'Y'), +#' timegroup = 'timegroup', +#' returnDist = TRUE, +#' fillNA = FALSE +#' ) +#' +#' # Generate dyad id +#' dyad_id(edges, id1 = 'ID1', id2 = 'ID2') +#' +#' # Generate fusion id +#' fusion_id(edges, threshold = 100) +#' +#' # Directional correlation delay +#' delay <- edge_delay( +#' DT, +#' edges, +#' window = 3, +#' id = 'id' +#' ) +#' +#' print(delay) stopifnot(!is.null(id)) stopifnot(!is.null(window)) From 331960db91b4a0b8c41f04c31da2e7ec9bb320b3 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 16:46:25 -0400 Subject: [PATCH 008/104] args --- R/edge_delay.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/R/edge_delay.R b/R/edge_delay.R index 43d666bf..650b6da4 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -87,6 +87,14 @@ #' ) #' #' print(delay) +edge_delay <- function( + DT, + edges, + window, + id = NULL, + direction = 'direction', + timegroup = 'timegroup') { + stopifnot(!is.null(id)) stopifnot(!is.null(window)) From 02886352d99808dc8243a8e7e885db38f33af6e4 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:12:48 -0400 Subject: [PATCH 009/104] rm timegroup arg --- R/edge_delay.R | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 650b6da4..36ecf59d 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -15,11 +15,9 @@ #' the columns \code{timegroup} (from \code{group_times}) and \code{ID1} and #' \code{ID2} (in \code{edges}, from \code{dyad_id}) with \code{id} (in #' \code{DT}). This function expects a \code{fusionID} present, generated with -#' the \code{fusion_id} function. The \code{timegroup} argument expects the -#' names of a column in \code{edges} which correspond to the timegroup column. -#' The \code{id}, \code{direction} and \code{timegroup} arguments expect the names -#' of a column in \code{DT} which correspond to the id, direction and -#' timegroup columns. +#' the \code{fusion_id} function. +#' The \code{id}, and \code{direction} arguments expect the names +#' of a column in \code{DT} which correspond to the id, and direction columns. #' #' @inheritParams centroid_fusion #' @inheritParams direction_group @@ -92,8 +90,7 @@ edge_delay <- function( edges, window, id = NULL, - direction = 'direction', - timegroup = 'timegroup') { + direction = 'direction') { stopifnot(!is.null(id)) stopifnot(!is.null(window)) From 1e431c4aaaaff2f369deb913f63cc279db0e8b8e Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:12:55 -0400 Subject: [PATCH 010/104] fix id colname --- R/edge_delay.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 36ecf59d..0535b4a8 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -81,7 +81,7 @@ #' DT, #' edges, #' window = 3, -#' id = 'id' +#' id = 'ID' #' ) #' #' print(delay) From 567aba6cbec32ab64e99a373197f86135f12445c Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:13:00 -0400 Subject: [PATCH 011/104] set window default null --- R/edge_delay.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 0535b4a8..1af36441 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -88,7 +88,7 @@ edge_delay <- function( DT, edges, - window, + window = NULL, id = NULL, direction = 'direction') { From 1b25f48911ceda89a2b8ba533fb7ca393794977e Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:13:06 -0400 Subject: [PATCH 012/104] check dt --- R/edge_delay.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 1af36441..d226c9de 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -92,8 +92,9 @@ edge_delay <- function( id = NULL, direction = 'direction') { - stopifnot(!is.null(id)) - stopifnot(!is.null(window)) + if (is.null(DT)) { + stop('input DT required') + } stopifnot(id %in% colnames(DT)) From 2918e1c05f1f2564eb80601dd1faf1ce441c836e Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:13:08 -0400 Subject: [PATCH 013/104] check edges --- R/edge_delay.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index d226c9de..269ac2d6 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -96,7 +96,9 @@ edge_delay <- function( stop('input DT required') } - stopifnot(id %in% colnames(DT)) + if (is.null(edges)) { + stop('input edges required') + } setnames(DT, id, 'id') From 891b1c070de2302b8d298b79ceb7f6b6f0290680 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:13:15 -0400 Subject: [PATCH 014/104] check id colname --- R/edge_delay.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 269ac2d6..7ccf91c8 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -100,7 +100,9 @@ edge_delay <- function( stop('input edges required') } - setnames(DT, id, 'id') + if (is.null(id)) { + stop('id column name required') + } stopifnot('dyadID' %in% colnames(edges)) stopifnot('timegroup' %in% colnames(edges)) From 03908e305d0454cf540472b53e55b891fc1eb8b6 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:13:28 -0400 Subject: [PATCH 015/104] check cols --- R/edge_delay.R | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 7ccf91c8..9bf6cd98 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -104,13 +104,28 @@ edge_delay <- function( stop('id column name required') } - stopifnot('dyadID' %in% colnames(edges)) - stopifnot('timegroup' %in% colnames(edges)) - stopifnot('fusionID' %in% colnames(edges)) - stopifnot('dyadID' %in% colnames(edges)) + check_cols_edges <- c('ID1', 'ID2', timegroup) + if (any(!(check_cols_edges %in% colnames(edges)))) { + stop(paste0( + as.character(paste(setdiff( + check_cols_edges, + colnames(edges) + ), collapse = ', ')), + ' field(s) provided are not present in input DT' + )) + } - stopifnot('bearing' %in% colnames(DT)) - stopifnot('timegroup' %in% colnames(DT)) + check_cols_DT <- c(id, timegroup, direction) + if (any(!(check_cols_DT %in% colnames(DT) + ))) { + stop(paste0( + as.character(paste(setdiff( + check_cols_DT, + colnames(DT) + ), collapse = ', ')), + ' field(s) provided are not present in input DT' + )) + } # TODO: check window isnt in colnames From a72103992b497cbc4f2a6e2dee9d60c72d84169c Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:13:31 -0400 Subject: [PATCH 016/104] check window --- R/edge_delay.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/edge_delay.R b/R/edge_delay.R index 9bf6cd98..0eac74cf 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -127,6 +127,13 @@ edge_delay <- function( )) } + if (is.null(window)) { + stop('window is required') + } + + if (!is.numeric(window)) { + stop('window should be a numeric, in the units of timegroup') + } # TODO: check window isnt in colnames setorder(DT, timegroup) From b74e4b8f1f99f246e4b5a96e7364241c094d418d Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:13:35 -0400 Subject: [PATCH 017/104] check dyad, fusion ids --- R/edge_delay.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/R/edge_delay.R b/R/edge_delay.R index 0eac74cf..a5afc5d9 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -134,6 +134,14 @@ edge_delay <- function( if (!is.numeric(window)) { stop('window should be a numeric, in the units of timegroup') } + + if (!'fusionID' %in% colnames(edges)) { + stop('fusionID not present in edges, did you run fusion_id?') + } + + if (!'dyadID' %in% colnames(edges)) { + stop('dyadID not present in edges, did you run dyad_id?') + } # TODO: check window isnt in colnames setorder(DT, timegroup) From a94bada135fdf5992fa4092143e30ec50c2f1f68 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:32:22 -0400 Subject: [PATCH 018/104] fix check numerator brackets --- R/internal.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/internal.R b/R/internal.R index 2811ff04..3f23d7c0 100644 --- a/R/internal.R +++ b/R/internal.R @@ -11,10 +11,10 @@ #' #' @examples delta_rad <- function(target, source, signed = FALSE) { - if (!inherits(target, 'units') || units(target$numerator != 'rad')) { + if (!inherits(target, 'units') || units(target)$numerator != 'rad') { stop('units(targets) is not radians') } - if (!inherits(source, 'units') || units(target$numerator != 'rad')) { + if (!inherits(source, 'units') || units(source)$numerator != 'rad') { stop('units(source) is not radians') } From 294d5ce7158fdf4d91ce429f849af51612acf2cc Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:32:29 -0400 Subject: [PATCH 019/104] fix units --- R/internal.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/internal.R b/R/internal.R index 3f23d7c0..6811a400 100644 --- a/R/internal.R +++ b/R/internal.R @@ -19,7 +19,8 @@ delta_rad <- function(target, source, signed = FALSE) { } d <- source - target - d <- (d + pi) %% (2 * pi) - pi + pi_rad <- units::as_units(pi, 'rad') + d <- (d + pi_rad) %% (2 * pi_rad) - pi_rad if (signed) { return(d) From 595ce9da6a3c21c3f87b9e8e3e91b314d32fc21f Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:36:09 -0400 Subject: [PATCH 020/104] check if window in colnames, zz temporarily if so --- R/edge_delay.R | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index a5afc5d9..ce6b3d7a 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -142,7 +142,13 @@ edge_delay <- function( if (!'dyadID' %in% colnames(edges)) { stop('dyadID not present in edges, did you run dyad_id?') } - # TODO: check window isnt in colnames + if ('window' %in% colnames(DT)) { + setnames(DT, 'window', 'zz_window') + } + + if ('window' %in% colnames(edges)) { + setnames(edges, 'window', 'zz_window') + } setorder(DT, timegroup) @@ -175,5 +181,13 @@ edge_delay <- function( ID1 = ID2, ID2 = ID1, dir_corr_delay = - dir_corr_delay)] ), use.names = TRUE) + if ('zz_window' %in% colnames(DT)) { + setnames(DT, 'zz_window', 'window') + } + + if ('zz_window' %in% colnames(edges)) { + setnames(edges, 'zz_window', 'window') + } + return(out) } From f85b1e894123009ae7ad5e09f805417f9dbfe74f Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:40:41 -0400 Subject: [PATCH 021/104] use three zees --- R/edge_delay.R | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index ce6b3d7a..6a82e3b2 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -143,13 +143,14 @@ edge_delay <- function( stop('dyadID not present in edges, did you run dyad_id?') } if ('window' %in% colnames(DT)) { - setnames(DT, 'window', 'zz_window') + setnames(DT, 'window', 'zzz_window') } if ('window' %in% colnames(edges)) { - setnames(edges, 'window', 'zz_window') + setnames(edges, 'window', 'zzz_window') } + setnames(DT, id, 'zzz_id') setorder(DT, timegroup) id_tg <- edges[!is.na(fusionID), .( @@ -165,9 +166,9 @@ edge_delay <- function( id_tg[, delay_tg := { focal_bearing <- DT[timegroup == .BY$tg & id == ID1, bearing] - DT[between(timegroup, min_tg, max_tg) & id == ID2, - timegroup[which.min(delta_rad(focal_bearing, bearing))]] - }, by = .(tg, dyadID)] + DT[between(timegroup, min_tg, max_tg) & zzz_id == ID2, + timegroup[which.min(delta_rad(focal_direction, direction))]] + by = c('tg', 'dyadID')] id_tg[, dir_corr_delay := tg - delay_tg] @@ -181,12 +182,12 @@ edge_delay <- function( ID1 = ID2, ID2 = ID1, dir_corr_delay = - dir_corr_delay)] ), use.names = TRUE) - if ('zz_window' %in% colnames(DT)) { - setnames(DT, 'zz_window', 'window') + if ('zzz_window' %in% colnames(DT)) { + setnames(DT, 'zzz_window', 'window') } - if ('zz_window' %in% colnames(edges)) { - setnames(edges, 'zz_window', 'window') + if ('zzz_window' %in% colnames(edges)) { + setnames(edges, 'zzz_window', 'window') } return(out) From 2f434ca734a6424410ac1908dd5bd226c110ae61 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:40:59 -0400 Subject: [PATCH 022/104] tidy --- R/edge_delay.R | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 6a82e3b2..cc9233a1 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -142,6 +142,8 @@ edge_delay <- function( if (!'dyadID' %in% colnames(edges)) { stop('dyadID not present in edges, did you run dyad_id?') } + + if ('window' %in% colnames(DT)) { setnames(DT, 'window', 'zzz_window') } @@ -158,11 +160,15 @@ edge_delay <- function( dyadID = unique(dyadID), ID1 = first(ID1), ID2 = first(ID2) - ), by = fusionID] - id_tg[, min_tg := data.table::fifelse(tg - window < min(tg), min(tg), tg - window), - by = fusionID] - id_tg[, max_tg := data.table::fifelse(tg + window < min(tg), min(tg), tg + window), - by = fusionID] + ), by = c('fusionID')] + + id_tg[, min_tg := + data.table::fifelse(tg - window < min(tg), min(tg), tg - window), + by = c('fusionID')] + + id_tg[, max_tg := + data.table::fifelse(tg + window < min(tg), min(tg), tg + window), + by = c('fusionID')] id_tg[, delay_tg := { focal_bearing <- DT[timegroup == .BY$tg & id == ID1, bearing] From f55753cc065eed684180107875693fae9527175b Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:41:05 -0400 Subject: [PATCH 023/104] fix direction not bearing --- R/edge_delay.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index cc9233a1..517f094b 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -171,9 +171,10 @@ edge_delay <- function( by = c('fusionID')] id_tg[, delay_tg := { - focal_bearing <- DT[timegroup == .BY$tg & id == ID1, bearing] + focal_direction <- DT[timegroup == .BY$tg & zzz_id == ID1, direction] DT[between(timegroup, min_tg, max_tg) & zzz_id == ID2, timegroup[which.min(delta_rad(focal_direction, direction))]] + }, by = c('tg', 'dyadID')] id_tg[, dir_corr_delay := tg - delay_tg] From 42fbf67fa20dd553ce491fadd5a3bb6f18d99af2 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 17:41:11 -0400 Subject: [PATCH 024/104] tidy --- R/edge_delay.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 517f094b..fb47f7d7 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -179,8 +179,9 @@ edge_delay <- function( id_tg[, dir_corr_delay := tg - delay_tg] - data.table::setnames(id_tg, c('tg'), c('timegroup')) + data.table::setnames(id_tg, 'tg', 'timegroup') data.table::set(id_tg, j = c('min_tg', 'max_tg','delay_tg'), value = NULL) + data.table::setorder(id_tg, timegroup, ID1, ID2, dir_corr_delay) out <- data.table::rbindlist(list( From 444652704b0c76db5ec26d678f6383409788bce3 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 18:42:52 -0400 Subject: [PATCH 025/104] fix reset zzz id --- R/edge_delay.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/edge_delay.R b/R/edge_delay.R index fb47f7d7..6f76c16e 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -190,6 +190,9 @@ edge_delay <- function( ID1 = ID2, ID2 = ID1, dir_corr_delay = - dir_corr_delay)] ), use.names = TRUE) + + setnames(DT, 'zzz_id', id) + if ('zzz_window' %in% colnames(DT)) { setnames(DT, 'zzz_window', 'window') } From 981c2acaeb486e8e787d6dbb2924c3fcf4fdfb54 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 18:43:29 -0400 Subject: [PATCH 026/104] todo check max tg --- R/edge_delay.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/edge_delay.R b/R/edge_delay.R index 6f76c16e..cd60e43b 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -168,6 +168,8 @@ edge_delay <- function( id_tg[, max_tg := data.table::fifelse(tg + window < min(tg), min(tg), tg + window), + # TODO: check max_tg + # data.table::fifelse(tg + window > max(tg), max(tg), tg + window), by = c('fusionID')] id_tg[, delay_tg := { From d3b1cbb67413fb91c8ec253f9884ae74b350ebc7 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 19:07:04 -0400 Subject: [PATCH 027/104] fix timegroup char since not arg --- R/edge_delay.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index cd60e43b..4e3a7714 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -104,7 +104,7 @@ edge_delay <- function( stop('id column name required') } - check_cols_edges <- c('ID1', 'ID2', timegroup) + check_cols_edges <- c('ID1', 'ID2', 'timegroup') if (any(!(check_cols_edges %in% colnames(edges)))) { stop(paste0( as.character(paste(setdiff( @@ -115,7 +115,7 @@ edge_delay <- function( )) } - check_cols_DT <- c(id, timegroup, direction) + check_cols_DT <- c(id, 'timegroup', direction) if (any(!(check_cols_DT %in% colnames(DT) ))) { stop(paste0( @@ -153,7 +153,7 @@ edge_delay <- function( } setnames(DT, id, 'zzz_id') - setorder(DT, timegroup) + data.table::setorderv(DT, 'timegroup') id_tg <- edges[!is.na(fusionID), .( tg = unique(timegroup), From d54bf05eae7481438ed5bde152db69f7caa8e76b Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 19:36:23 -0400 Subject: [PATCH 028/104] rm setnames, use env --- R/edge_delay.R | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 4e3a7714..6f6cba9f 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -152,7 +152,6 @@ edge_delay <- function( setnames(edges, 'window', 'zzz_window') } - setnames(DT, id, 'zzz_id') data.table::setorderv(DT, 'timegroup') id_tg <- edges[!is.na(fusionID), .( @@ -173,9 +172,11 @@ edge_delay <- function( by = c('fusionID')] id_tg[, delay_tg := { - focal_direction <- DT[timegroup == .BY$tg & zzz_id == ID1, direction] - DT[between(timegroup, min_tg, max_tg) & zzz_id == ID2, - timegroup[which.min(delta_rad(focal_direction, direction))]] + focal_direction <- DT[timegroup == .BY$tg & + id == ID1, direction] + DT[between(timegroup, min_tg, max_tg) & id == ID2, + timegroup[which.min(delta_rad(focal_direction, direction))], + env = list(id = 'id')] }, by = c('tg', 'dyadID')] @@ -192,9 +193,6 @@ edge_delay <- function( ID1 = ID2, ID2 = ID1, dir_corr_delay = - dir_corr_delay)] ), use.names = TRUE) - - setnames(DT, 'zzz_id', id) - if ('zzz_window' %in% colnames(DT)) { setnames(DT, 'zzz_window', 'window') } @@ -205,3 +203,4 @@ edge_delay <- function( return(out) } + From ada1d55cf4ad1539da90a745bf203df792f9936c Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 19:39:26 -0400 Subject: [PATCH 029/104] fst test edge_delay --- tests/testthat/test-edge-delay.R | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 tests/testthat/test-edge-delay.R diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R new file mode 100644 index 00000000..8a98ed50 --- /dev/null +++ b/tests/testthat/test-edge-delay.R @@ -0,0 +1,2 @@ +# Test edge_delay +context('test edge_delay') From 5538f3080f816467c815fbafc2462c91efdb3a3f Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 19:39:51 -0400 Subject: [PATCH 030/104] test setup --- tests/testthat/test-edge-delay.R | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 8a98ed50..5f89f8f8 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -1,2 +1,29 @@ # Test edge_delay context('test edge_delay') + +library(spatsoc) + +DT <- fread('../testdata/DT.csv') +id <- 'ID' +datetime <- 'datetime' +timethreshold <- '20 minutes' +threshold <- 50 +coords <- c('X', 'Y') +timegroup <- 'timegroup' +group <- 'group' +projection <- 32736 +window <- 3 + + +DT[, datetime := as.POSIXct(datetime, tz = 'UTC')] +group_times(DT, datetime = datetime, threshold = timethreshold) +direction_step(DT, id, coords, projection) +edges <- edge_dist(DT, threshold = threshold, id = id, + timegroup = timegroup, returnDist = TRUE, fillNA = FALSE) +dyad_id(edges, id1 = 'ID1', id2 = 'ID2') +fusion_id(edges, threshold = threshold) + +clean_DT <- copy(DT) +clean_edges <- copy(edges) + +# edge_delay(DT = DT, edges = edges, id = id, window = window) From ac2091a5ae0e3594bac11402903fa23604ba6e0a Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 19:41:48 -0400 Subject: [PATCH 031/104] reorg args --- R/edge_delay.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 6f6cba9f..bb05a702 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -7,11 +7,11 @@ #' the directional correlation delay. Relocation data should be in two columns #' representing the X and Y coordinates. #' -#' The \code{DT} and \code{edges} must be \code{data.table}s. If your data is a +#' The \code{edges} and \code{DT} must be \code{data.table}s. 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{DT} and \code{edges} are internally matched in this function using +#' The \code{edges} and \code{DT} are internally matched in this function using #' the columns \code{timegroup} (from \code{group_times}) and \code{ID1} and #' \code{ID2} (in \code{edges}, from \code{dyad_id}) with \code{id} (in #' \code{DT}). This function expects a \code{fusionID} present, generated with @@ -78,16 +78,16 @@ #' #' # Directional correlation delay #' delay <- edge_delay( -#' DT, -#' edges, +#' edges = edges, +#' DT = DT, #' window = 3, #' id = 'ID' #' ) #' #' print(delay) edge_delay <- function( - DT, edges, + DT, window = NULL, id = NULL, direction = 'direction') { From 21808d2ac4a44e10df361afeeff2ee2cf92baf0c Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 19:46:47 -0400 Subject: [PATCH 032/104] test required arg --- tests/testthat/test-edge-delay.R | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 5f89f8f8..b2136760 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -27,3 +27,16 @@ clean_DT <- copy(DT) clean_edges <- copy(edges) # edge_delay(DT = DT, edges = edges, id = id, window = window) + +test_that('edges, DT are required', { + expect_error(edge_delay(edges, DT = NULL)) + expect_error(edge_delay(edges = NULL, DT)) +}) + +test_that('arguments required, otherwise error detected', { + expect_error(edge_delay(edges, DT, id = NULL), + 'id column name required') + expect_error(edge_delay(edges, DT, id = id, window = NULL), + 'window is required') +}) + From 6a12bb57ec687d5b7df84cdd67e85911054c9f97 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 19:46:52 -0400 Subject: [PATCH 033/104] test window numeric --- tests/testthat/test-edge-delay.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index b2136760..459644d9 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -40,3 +40,8 @@ test_that('arguments required, otherwise error detected', { 'window is required') }) +test_that('window is numeric', { + expect_error(edge_delay(edges, DT, id = id, window = 'potato'), + 'numeric') +}) + From 8ad56a552faa4a3d1f201dee17ebe708546ab8a1 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 19:47:02 -0400 Subject: [PATCH 034/104] test colnames exist --- tests/testthat/test-edge-delay.R | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 459644d9..49c501ac 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -45,3 +45,31 @@ test_that('window is numeric', { 'numeric') }) +test_that('column names must exist in DT', { + expect_error(edge_delay(edges, DT, id = 'potato'), + 'potato field') + + copy_edges <- copy(clean_edges) + copy_edges[, timegroup := NULL] + expect_error(edge_delay(edges, DT, id = id), + 'timegroup field') + + copy_edges <- copy(clean_edges) + copy_edges[, fusionID := NULL] + expect_error(edge_delay(edges, DT, id = id), + 'fusionID field') + + copy_edges <- copy(clean_edges) + copy_edges[, dyadID := NULL] + expect_error(edge_delay(edges, DT, id = id), + 'dyadID field') + + expect_error(edge_delay(edges, DT, id = id, direction = 'potato'), + 'direction field') + + copy_DT <- copy(clean_DT) + copy_DT[, timegroup := NULL] + expect_error(edge_delay(edges, DT, id = id), + 'timegroup field') +}) + From ccadff47ec5dafdbba9285111b8eca0f2b62fdf1 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 19:47:11 -0400 Subject: [PATCH 035/104] test returned object --- tests/testthat/test-edge-delay.R | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 49c501ac..003ce81f 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -73,3 +73,23 @@ test_that('column names must exist in DT', { 'timegroup field') }) +test_that('no rows are added to the result edges', { + expect_equal(nrow(edges), + nrow(edge_delay(edges, DT, id = id, window = window))) +}) + +test_that('two columns added to the result DT', { + copyEdges <- copy(edges) + + expect_equal(ncol(copyEdges) + 1, + ncol(edge_delay(edges, DT, id = id, window = window))) +}) + +test_that('column added to the result DT is double', { + expect_type(edge_delay(edges, DT, id = id, window = window)$dir_corr_delay, 'double') +}) + +test_that('returns a data.table', { + expect_s3_class(edge_delay(edges, DT, id = id, window = window), 'data.table') +}) + From 7752d041174c6929f36a103e394f7dcdd5351087 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 19:52:05 -0400 Subject: [PATCH 036/104] fix missing coords arg --- tests/testthat/test-edge-delay.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 003ce81f..ce37680f 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -19,7 +19,8 @@ DT[, datetime := as.POSIXct(datetime, tz = 'UTC')] group_times(DT, datetime = datetime, threshold = timethreshold) direction_step(DT, id, coords, projection) edges <- edge_dist(DT, threshold = threshold, id = id, - timegroup = timegroup, returnDist = TRUE, fillNA = FALSE) + coords = coords, timegroup = timegroup, + returnDist = TRUE, fillNA = FALSE) dyad_id(edges, id1 = 'ID1', id2 = 'ID2') fusion_id(edges, threshold = threshold) From 90bc8ed88563b547f2b44b10e0f74d08957c64a2 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 20:04:30 -0400 Subject: [PATCH 037/104] fix use copy edges/dt --- tests/testthat/test-edge-delay.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index ce37680f..267928ac 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -52,17 +52,17 @@ test_that('column names must exist in DT', { copy_edges <- copy(clean_edges) copy_edges[, timegroup := NULL] - expect_error(edge_delay(edges, DT, id = id), + expect_error(edge_delay(copy_edges, DT, id = id, window = window), 'timegroup field') copy_edges <- copy(clean_edges) copy_edges[, fusionID := NULL] - expect_error(edge_delay(edges, DT, id = id), + expect_error(edge_delay(copy_edges, DT, id = id, window = window), 'fusionID field') copy_edges <- copy(clean_edges) copy_edges[, dyadID := NULL] - expect_error(edge_delay(edges, DT, id = id), + expect_error(edge_delay(copy_edges, DT, id = id, window = window), 'dyadID field') expect_error(edge_delay(edges, DT, id = id, direction = 'potato'), @@ -70,7 +70,7 @@ test_that('column names must exist in DT', { copy_DT <- copy(clean_DT) copy_DT[, timegroup := NULL] - expect_error(edge_delay(edges, DT, id = id), + expect_error(edge_delay(edges, copy_DT, id = id, window = window), 'timegroup field') }) From 116dab6cf33ad1e20922017e0ac9724de47ca352 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 20:04:40 -0400 Subject: [PATCH 038/104] fix len to match expected output cols --- tests/testthat/test-edge-delay.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 267928ac..7b7004a4 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -82,7 +82,8 @@ test_that('no rows are added to the result edges', { test_that('two columns added to the result DT', { copyEdges <- copy(edges) - expect_equal(ncol(copyEdges) + 1, + expect_equal(length(c('ID1', 'ID2', 'timegroup', + 'dyadID', 'fusionID', 'dir_corr_delay')), ncol(edge_delay(edges, DT, id = id, window = window))) }) From 86c2b969f1dfe0bda6b24435aafc8364dde30c8d Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 20:04:50 -0400 Subject: [PATCH 039/104] fix integer returned --- tests/testthat/test-edge-delay.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 7b7004a4..b32bae99 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -87,8 +87,8 @@ test_that('two columns added to the result DT', { ncol(edge_delay(edges, DT, id = id, window = window))) }) -test_that('column added to the result DT is double', { - expect_type(edge_delay(edges, DT, id = id, window = window)$dir_corr_delay, 'double') +test_that('column added to the result DT is integer', { + expect_type(edge_delay(edges, DT, id = id, window = window)$dir_corr_delay, 'integer') }) test_that('returns a data.table', { From 2f67e07623acadb70de21dace4ae36becd6557dd Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 20:04:58 -0400 Subject: [PATCH 040/104] fix potato field --- tests/testthat/test-edge-delay.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index b32bae99..064e42de 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -65,8 +65,9 @@ test_that('column names must exist in DT', { expect_error(edge_delay(copy_edges, DT, id = id, window = window), 'dyadID field') - expect_error(edge_delay(edges, DT, id = id, direction = 'potato'), - 'direction field') + expect_error(edge_delay(edges, DT, id = id, window = window, + direction = 'potato'), + 'potato field') copy_DT <- copy(clean_DT) copy_DT[, timegroup := NULL] From 39fc13643086ba4b9eb4e00aa9096776ec1db2bd Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 20:05:18 -0400 Subject: [PATCH 041/104] fix make consistent error msg --- R/edge_delay.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index bb05a702..b3a3c629 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -136,11 +136,11 @@ edge_delay <- function( } if (!'fusionID' %in% colnames(edges)) { - stop('fusionID not present in edges, did you run fusion_id?') + stop('fusionID field not present in edges, did you run fusion_id?') } if (!'dyadID' %in% colnames(edges)) { - stop('dyadID not present in edges, did you run dyad_id?') + stop('dyadID field not present in edges, did you run dyad_id?') } From 68d9221e25ca2eb27cd525f27ee941cdae125b50 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 19 Nov 2024 20:16:00 -0400 Subject: [PATCH 042/104] todo expected tests --- tests/testthat/test-edge-delay.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 064e42de..b98b3a72 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -96,3 +96,4 @@ test_that('returns a data.table', { expect_s3_class(edge_delay(edges, DT, id = id, window = window), 'data.table') }) +# TODO: expected results tests From 52ed518494e68645a9f0a8059f073d87b547e9f9 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 26 Nov 2024 10:15:25 -0400 Subject: [PATCH 043/104] fst expected results test --- tests/testthat/test-edge-delay.R | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index b98b3a72..116631d9 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -96,4 +96,25 @@ test_that('returns a data.table', { expect_s3_class(edge_delay(edges, DT, id = id, window = window), 'data.table') }) -# TODO: expected results tests + +N_id <- 5 +DT_expect <- data.table( + X = rep(c(0, 5, 5, 0, 0), each = N_id), + Y = rep(c(0, 0, 5, 5, 0), each = N_id), + ID = LETTERS[seq.int(N_id)] +) +DT_expect[, timegroup := seq.int(.GRP)[.GRP] + seq.int(.N), by = ID] +setorder(DT_expect, timegroup) +direction_step(DT_expect, id, coords, projection = 4326) +DT_expect + +edges_expect <- edge_dist(DT_expect, threshold = 100, id, coords, timegroup, + returnDist = TRUE) +dyad_id(edges_expect, 'ID1', 'ID2') +fusion_id(edges_expect) + +DT_expect[ID %in% c('A', 'B')] +edges_expect[dyadID == 'A-B'] +edge_delay(edges_expect[dyadID == 'A-B'], + DT_expect[ID %in% c('A', 'B')], + window = 1, id = id) From 95646f81d274124cf3f7ebcc10b12eba62e9c546 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 26 Nov 2024 16:02:12 -0400 Subject: [PATCH 044/104] note requires version of units with PR fixing modulus operator --- R/internal.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/internal.R b/R/internal.R index 6811a400..ab97ac48 100644 --- a/R/internal.R +++ b/R/internal.R @@ -28,3 +28,7 @@ delta_rad <- function(target, source, signed = FALSE) { return(abs(d)) } } + + +# Requires version with this PR merged +# remotes::install_github('https://github.com/r-quantities/units/pull/365') From d39acb4d26ef8d8c25c5345e23cd79d7d21a0b94 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 26 Nov 2024 16:08:35 -0400 Subject: [PATCH 045/104] rename function --- R/internal.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/internal.R b/R/internal.R index ab97ac48..9e670422 100644 --- a/R/internal.R +++ b/R/internal.R @@ -10,9 +10,9 @@ #' @references adapted from https://stackoverflow.com/a/7869457 #' #' @examples -delta_rad <- function(target, source, signed = FALSE) { if (!inherits(target, 'units') || units(target)$numerator != 'rad') { stop('units(targets) is not radians') +diff_rad <- function(x, y, signed = FALSE) { } if (!inherits(source, 'units') || units(source)$numerator != 'rad') { stop('units(source) is not radians') From ed784cb5e8078e704f5dff452d2fea042fcb5bd5 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 26 Nov 2024 16:08:40 -0400 Subject: [PATCH 046/104] rename args --- R/internal.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/internal.R b/R/internal.R index 9e670422..3647dc5c 100644 --- a/R/internal.R +++ b/R/internal.R @@ -10,15 +10,15 @@ #' @references adapted from https://stackoverflow.com/a/7869457 #' #' @examples - if (!inherits(target, 'units') || units(target)$numerator != 'rad') { - stop('units(targets) is not radians') diff_rad <- function(x, y, signed = FALSE) { + if (!inherits(x, 'units') || units(x)$numerator != 'rad') { + stop('units(x) is not radians') } - if (!inherits(source, 'units') || units(source)$numerator != 'rad') { - stop('units(source) is not radians') + if (!inherits(y, 'units') || units(y)$numerator != 'rad') { + stop('units(y) is not radians') } - d <- source - target + d <- y - x pi_rad <- units::as_units(pi, 'rad') d <- (d + pi_rad) %% (2 * pi_rad) - pi_rad From f88f6131ee0609586b42fcf7e6635b3d72dcea7e Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 26 Nov 2024 16:08:54 -0400 Subject: [PATCH 047/104] fst test diff_rad --- tests/testthat/test-diff-rad.R | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 tests/testthat/test-diff-rad.R diff --git a/tests/testthat/test-diff-rad.R b/tests/testthat/test-diff-rad.R new file mode 100644 index 00000000..7b9fb42b --- /dev/null +++ b/tests/testthat/test-diff-rad.R @@ -0,0 +1,3 @@ +# Test diff_rad +context('test diff_rad') + From adf903d17ac87d90316adfad52ad1d2ac269402c Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 26 Nov 2024 16:08:57 -0400 Subject: [PATCH 048/104] setup --- tests/testthat/test-diff-rad.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/tests/testthat/test-diff-rad.R b/tests/testthat/test-diff-rad.R index 7b9fb42b..9a3d9431 100644 --- a/tests/testthat/test-diff-rad.R +++ b/tests/testthat/test-diff-rad.R @@ -1,3 +1,10 @@ # Test diff_rad context('test diff_rad') +library(units) + +pt_01 <- as_units(0.1, 'rad') +pt_02 <- as_units(0.2, 'rad') +pi_rad <- as_units(pi, 'rad') + + From c23f7869de11f0950cb47a99d8d780f4a5c6d6a8 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 26 Nov 2024 16:09:07 -0400 Subject: [PATCH 049/104] test diff rad --- tests/testthat/test-diff-rad.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/testthat/test-diff-rad.R b/tests/testthat/test-diff-rad.R index 9a3d9431..53bf9695 100644 --- a/tests/testthat/test-diff-rad.R +++ b/tests/testthat/test-diff-rad.R @@ -8,3 +8,13 @@ pt_02 <- as_units(0.2, 'rad') pi_rad <- as_units(pi, 'rad') +expect_equal(diff_rad(pt_01, pt_02, TRUE), pt_01) +expect_equal(diff_rad(pt_01, pt_02 + 2 * pi_rad, TRUE), pt_01) +expect_equal(diff_rad(pt_01, pt_02 - 2 * pi_rad, TRUE), pt_01) +expect_equal(diff_rad(pt_01 + 2 * pi_rad, pt_02, TRUE), pt_01) +expect_equal(diff_rad(pt_01 - 2 * pi_rad, pt_02, TRUE), pt_01) +expect_equal(diff_rad(pt_02, pt_01, TRUE), -pt_01) +expect_equal(diff_rad(pt_02 + 2 * pi_rad, pt_01, TRUE), -pt_01) +expect_equal(diff_rad(pt_02 - 2 * pi_rad, pt_01, TRUE), -pt_01) +expect_equal(diff_rad(pt_02, pt_01 + 2 * pi_rad, TRUE), -pt_01) +expect_equal(diff_rad(pt_02, pt_01 - 2 * pi_rad, TRUE), -pt_01) From 3f30aa1f808a243ed0d79c22ffe797ca11b90ddc Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 26 Nov 2024 16:16:27 -0400 Subject: [PATCH 050/104] also test not signed --- tests/testthat/test-diff-rad.R | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-diff-rad.R b/tests/testthat/test-diff-rad.R index 53bf9695..ddcd4aa1 100644 --- a/tests/testthat/test-diff-rad.R +++ b/tests/testthat/test-diff-rad.R @@ -7,7 +7,7 @@ pt_01 <- as_units(0.1, 'rad') pt_02 <- as_units(0.2, 'rad') pi_rad <- as_units(pi, 'rad') - +# Adapted from: https://gist.github.com/bradphelan/7fe21ad8ebfcb43696b8 expect_equal(diff_rad(pt_01, pt_02, TRUE), pt_01) expect_equal(diff_rad(pt_01, pt_02 + 2 * pi_rad, TRUE), pt_01) expect_equal(diff_rad(pt_01, pt_02 - 2 * pi_rad, TRUE), pt_01) @@ -18,3 +18,15 @@ expect_equal(diff_rad(pt_02 + 2 * pi_rad, pt_01, TRUE), -pt_01) expect_equal(diff_rad(pt_02 - 2 * pi_rad, pt_01, TRUE), -pt_01) expect_equal(diff_rad(pt_02, pt_01 + 2 * pi_rad, TRUE), -pt_01) expect_equal(diff_rad(pt_02, pt_01 - 2 * pi_rad, TRUE), -pt_01) + +expect_equal(diff_rad(pt_01, pt_02, FALSE), pt_01) +expect_equal(diff_rad(pt_01, pt_02 + 2 * pi_rad, FALSE), pt_01) +expect_equal(diff_rad(pt_01, pt_02 - 2 * pi_rad, FALSE), pt_01) +expect_equal(diff_rad(pt_01 + 2 * pi_rad, pt_02, FALSE), pt_01) +expect_equal(diff_rad(pt_01 - 2 * pi_rad, pt_02, FALSE), pt_01) +expect_equal(diff_rad(pt_02, pt_01, FALSE), pt_01) +expect_equal(diff_rad(pt_02 + 2 * pi_rad, pt_01, FALSE), pt_01) +expect_equal(diff_rad(pt_02 - 2 * pi_rad, pt_01, FALSE), pt_01) +expect_equal(diff_rad(pt_02, pt_01 + 2 * pi_rad, FALSE), pt_01) +expect_equal(diff_rad(pt_02, pt_01 - 2 * pi_rad, FALSE), pt_01) + From 51fb9c17deb9256b714dfeada3c8ec67d4bd8974 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 26 Nov 2024 11:06:47 -0400 Subject: [PATCH 051/104] add example --- R/internal.R | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/R/internal.R b/R/internal.R index 3647dc5c..12e45265 100644 --- a/R/internal.R +++ b/R/internal.R @@ -10,6 +10,29 @@ #' @references adapted from https://stackoverflow.com/a/7869457 #' #' @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')] +#' +#' # Set order using data.table::setorder +#' setorder(DT, datetime) +#' +#' # Calculate direction +#' direction_step( +#' DT = DT, +#' id = 'ID', +#' coords = c('X', 'Y'), +#' projection = 32736 +#' ) +#' +#' # Differences +#' DT[, diff_rad(direction[1], direction[2])] diff_rad <- function(x, y, signed = FALSE) { if (!inherits(x, 'units') || units(x)$numerator != 'rad') { stop('units(x) is not radians') From 69c5e4561006c81838a53ef6c1e866cb46d5b740 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Tue, 26 Nov 2024 11:06:53 -0400 Subject: [PATCH 052/104] extra brackets --- R/internal.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/internal.R b/R/internal.R index 12e45265..bdf93f0f 100644 --- a/R/internal.R +++ b/R/internal.R @@ -43,7 +43,7 @@ diff_rad <- function(x, y, signed = FALSE) { d <- y - x pi_rad <- units::as_units(pi, 'rad') - d <- (d + pi_rad) %% (2 * pi_rad) - pi_rad + d <- ((d + pi_rad) %% (2 * pi_rad)) - pi_rad if (signed) { return(d) From df9558f489ce9a079631fe9add72f7338e2b4292 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 16:17:40 -0400 Subject: [PATCH 053/104] edit description --- R/edge_delay.R | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index b3a3c629..841226e4 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -1,11 +1,12 @@ #' Directional correlation delay based edge lists #' #' \code{edge_delay} returns edge lists defined by the directional correlation -#' delay between individuals. The function expects a \code{data.table} with -#' relocation data, distance based edge lists, individual identifiers and a window argument. The -#' window argument is used to specify the temporal window within which to consider -#' the directional correlation delay. Relocation data should be in two columns -#' representing the X and Y coordinates. +#' delay between individuals. The function expects a distance based edge list +#' generated by edge_dist, a \code{data.table} with relocation data, individual +#' identifiers and a window argument. The window argument is used to specify the +#' temporal window within which to measure the directional correlation delay. +#' Relocation data should be in two columns representing the X and Y +#' coordinates. #' #' The \code{edges} and \code{DT} must be \code{data.table}s. If your data is a #' \code{data.frame}, you can convert it by reference using From 824e34dc0af917056f15e9090ba17f29c810888d Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 16:17:45 -0400 Subject: [PATCH 054/104] add references --- R/edge_delay.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/R/edge_delay.R b/R/edge_delay.R index 841226e4..3286200d 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -33,6 +33,17 @@ #' #' @export #' +#' @references +#' +#' The directional correlation delay is defined in Nagy et al 2010 +#' (). +#' +#' See examples of measuring the directional correlation delay: +#' * +#' * +#' * +#' * +#' #' @family Edge-list generation #' #' @examples From 2390e5f91571a50cd10cbc71d5a350076ee53365 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 16:17:47 -0400 Subject: [PATCH 055/104] add family --- R/edge_delay.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/edge_delay.R b/R/edge_delay.R index 3286200d..69c63663 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -45,6 +45,7 @@ #' * #' #' @family Edge-list generation +#' @family Direction functions #' #' @examples #' # Load data.table From 83ca625e98b0c3e01fb7eb11df280cfec971b869 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 16:22:39 -0400 Subject: [PATCH 056/104] clarify also accepts edge_nn --- R/edge_delay.R | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 69c63663..bcc462c1 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -2,23 +2,23 @@ #' #' \code{edge_delay} returns edge lists defined by the directional correlation #' delay between individuals. The function expects a distance based edge list -#' generated by edge_dist, a \code{data.table} with relocation data, individual -#' identifiers and a window argument. The window argument is used to specify the -#' temporal window within which to measure the directional correlation delay. -#' Relocation data should be in two columns representing the X and Y -#' coordinates. +#' generated by \code{edge_dist} or \code{edge_nn}, a \code{data.table} with +#' relocation data, individual identifiers and a window argument. The window +#' argument is used to specify the temporal window within which to measure the +#' directional correlation delay. Relocation data should be in two columns +#' representing the X and Y coordinates. #' #' The \code{edges} and \code{DT} must be \code{data.table}s. 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{edges} and \code{DT} are internally matched in this function using -#' the columns \code{timegroup} (from \code{group_times}) and \code{ID1} and -#' \code{ID2} (in \code{edges}, from \code{dyad_id}) with \code{id} (in -#' \code{DT}). This function expects a \code{fusionID} present, generated with -#' the \code{fusion_id} function. -#' The \code{id}, and \code{direction} arguments expect the names -#' of a column in \code{DT} which correspond to the id, and direction columns. +#' The rows in \code{edges} and \code{DT} are internally matched in this +#' function using the columns \code{timegroup} (from \code{group_times}) and +#' \code{ID1} and \code{ID2} (in \code{edges}, from \code{dyad_id}) with +#' \code{id} (in \code{DT}). This function expects a \code{fusionID} present, +#' generated with the \code{fusion_id} function. The \code{id}, and +#' \code{direction} arguments expect the names of a column in \code{DT} which +#' correspond to the id, and direction columns. #' #' @inheritParams centroid_fusion #' @inheritParams direction_group From 3d31672755833c893ece40783d815935de9fa325 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 16:23:07 -0400 Subject: [PATCH 057/104] use renamed internal diff_rad function --- R/edge_delay.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index bcc462c1..80da941d 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -188,7 +188,7 @@ edge_delay <- function( focal_direction <- DT[timegroup == .BY$tg & id == ID1, direction] DT[between(timegroup, min_tg, max_tg) & id == ID2, - timegroup[which.min(delta_rad(focal_direction, direction))], + timegroup[which.min(diff_rad(focal_direction, direction))], env = list(id = 'id')] }, by = c('tg', 'dyadID')] From 887797d6895e9e9532694ecb834f43f2a66370e4 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 17:10:08 -0400 Subject: [PATCH 058/104] fix test cols added to result --- tests/testthat/test-edge-delay.R | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 116631d9..8b912241 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -80,12 +80,16 @@ test_that('no rows are added to the result edges', { nrow(edge_delay(edges, DT, id = id, window = window))) }) -test_that('two columns added to the result DT', { +test_that('column added to the result DT', { copyEdges <- copy(edges) - expect_equal(length(c('ID1', 'ID2', 'timegroup', - 'dyadID', 'fusionID', 'dir_corr_delay')), - ncol(edge_delay(edges, DT, id = id, window = window))) + expected_cols <- c(colnames(copyEdges), 'dir_corr_delay') + + expect_setequal(expected_cols, + colnames(edge_delay(edges, DT, id = id, window = window))) + expect_equal(ncol(edge_delay(edges, DT, id = id, window = window)), + length(expected_cols)) + }) test_that('column added to the result DT is integer', { From 26382b3afd7216a9973a44f11e3611d126da5b1e Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 17:44:37 -0400 Subject: [PATCH 059/104] fix use first(.SD) to preserve any extra cols in edges --- R/edge_delay.R | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 80da941d..535c3a30 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -167,15 +167,13 @@ edge_delay <- function( data.table::setorderv(DT, 'timegroup') - id_tg <- edges[!is.na(fusionID), .( - tg = unique(timegroup), - dyadID = unique(dyadID), - ID1 = first(ID1), - ID2 = first(ID2) - ), by = c('fusionID')] + # "Forward": all edges ID1 -> ID2 id_tg[, min_tg := data.table::fifelse(tg - window < min(tg), min(tg), tg - window), + forward <- edges[!is.na(fusionID), + data.table::first(.SD), + by = .(fusionID, timegroup)] by = c('fusionID')] id_tg[, max_tg := From d68e47bc93b5196b38a9c3768e25a652a45da951 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 17:46:04 -0400 Subject: [PATCH 060/104] use "forward" obj name to represent ID1 -> ID2 --- R/edge_delay.R | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 535c3a30..561594a6 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -168,12 +168,14 @@ edge_delay <- function( data.table::setorderv(DT, 'timegroup') # "Forward": all edges ID1 -> ID2 - - id_tg[, min_tg := - data.table::fifelse(tg - window < min(tg), min(tg), tg - window), forward <- edges[!is.na(fusionID), data.table::first(.SD), by = .(fusionID, timegroup)] + + forward[, min_timegroup := + data.table::fifelse(timegroup - window < min(timegroup), + min(timegroup), + timegroup - window), by = c('fusionID')] id_tg[, max_tg := @@ -182,21 +184,19 @@ edge_delay <- function( # data.table::fifelse(tg + window > max(tg), max(tg), tg + window), by = c('fusionID')] - id_tg[, delay_tg := { - focal_direction <- DT[timegroup == .BY$tg & + forward[, delay_timegroup := { + focal_direction <- DT[timegroup == .BY$timegroup & id == ID1, direction] - DT[between(timegroup, min_tg, max_tg) & id == ID2, - timegroup[which.min(diff_rad(focal_direction, direction))], - env = list(id = 'id')] + DT[between(timegroup, min_timegroup, max_timegroup) & id == ID2, + timegroup[which.min(diff_rad(focal_direction, direction))]] }, - by = c('tg', 'dyadID')] + by = c('timegroup', 'dyadID'), - id_tg[, dir_corr_delay := tg - delay_tg] + forward[, dir_corr_delay := timegroup - delay_timegroup] - data.table::setnames(id_tg, 'tg', 'timegroup') - data.table::set(id_tg, j = c('min_tg', 'max_tg','delay_tg'), value = NULL) + data.table::set(forward, j = c('min_timegroup', 'max_timegroup','delay_timegroup'), value = NULL) - data.table::setorder(id_tg, timegroup, ID1, ID2, dir_corr_delay) + data.table::setorder(forward, timegroup, ID1, ID2, dir_corr_delay) out <- data.table::rbindlist(list( id_tg, From 108a9b88a650e2b2cb4b1317235a79aca8de0186 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 17:46:26 -0400 Subject: [PATCH 061/104] use "reverse" obj name to represent ID2 -> ID1 --- R/edge_delay.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 561594a6..bc5dd908 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -198,10 +198,14 @@ edge_delay <- function( data.table::setorder(forward, timegroup, ID1, ID2, dir_corr_delay) + # "Reverse": replicate forward but reverse direction ID1 <- ID2 + reverse <- copy(forward) + setnames(reverse, c('ID1', 'ID2'), c('ID2', 'ID1')) + reverse[, dir_corr_delay := - dir_corr_delay] + out <- data.table::rbindlist(list( - id_tg, - id_tg[, .(timegroup, dyadID, fusionID, - ID1 = ID2, ID2 = ID1, dir_corr_delay = - dir_corr_delay)] + forward, + reverse ), use.names = TRUE) if ('zzz_window' %in% colnames(DT)) { From b6a5cbc7e94dfdf9a2ffb3d87f6f5a210d23e3f9 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 17:46:37 -0400 Subject: [PATCH 062/104] fix max tg --- R/edge_delay.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index bc5dd908..1ef4ecf5 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -178,10 +178,10 @@ edge_delay <- function( timegroup - window), by = c('fusionID')] - id_tg[, max_tg := - data.table::fifelse(tg + window < min(tg), min(tg), tg + window), - # TODO: check max_tg - # data.table::fifelse(tg + window > max(tg), max(tg), tg + window), + forward[, max_timegroup := + data.table::fifelse(timegroup + window > max(timegroup), + max(timegroup), + timegroup + window), by = c('fusionID')] forward[, delay_timegroup := { From 2d9b1d48adcb0c65c476c73d810df59cd83a737e Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 17:46:47 -0400 Subject: [PATCH 063/104] fix use env arg --- R/edge_delay.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/edge_delay.R b/R/edge_delay.R index 1ef4ecf5..a9abae42 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -191,6 +191,7 @@ edge_delay <- function( timegroup[which.min(diff_rad(focal_direction, direction))]] }, by = c('timegroup', 'dyadID'), + env = list(id = id)] forward[, dir_corr_delay := timegroup - delay_timegroup] From b10428c1dd3f65c50c5ff6c1e71b8a5813b8dd47 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 17:47:30 -0400 Subject: [PATCH 064/104] use fusionID directly --- R/edge_delay.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index a9abae42..a3684ca5 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -176,13 +176,13 @@ edge_delay <- function( data.table::fifelse(timegroup - window < min(timegroup), min(timegroup), timegroup - window), - by = c('fusionID')] + by = fusionID] forward[, max_timegroup := data.table::fifelse(timegroup + window > max(timegroup), max(timegroup), timegroup + window), - by = c('fusionID')] + by = fusionID] forward[, delay_timegroup := { focal_direction <- DT[timegroup == .BY$timegroup & From 7ec2d86c3b9a08b91a3671e0e10700b860686ce0 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 17:47:35 -0400 Subject: [PATCH 065/104] fix long line --- R/edge_delay.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index a3684ca5..c8ba527f 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -195,7 +195,9 @@ edge_delay <- function( forward[, dir_corr_delay := timegroup - delay_timegroup] - data.table::set(forward, j = c('min_timegroup', 'max_timegroup','delay_timegroup'), value = NULL) + data.table::set(forward, + j = c('min_timegroup', 'max_timegroup','delay_timegroup'), + value = NULL) data.table::setorder(forward, timegroup, ID1, ID2, dir_corr_delay) From 51487f034a6f44888f4fa88aac8632239d36a132 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 17:49:23 -0400 Subject: [PATCH 066/104] test direction colname can differ from default --- tests/testthat/test-edge-delay.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 8b912241..e6cb2143 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -100,6 +100,14 @@ test_that('returns a data.table', { expect_s3_class(edge_delay(edges, DT, id = id, window = window), 'data.table') }) +test_that('direction colname can different than default', { + copyDT <- copy(clean_DT) + setnames(copyDT, 'direction', 'potato') + expect_s3_class(edge_delay(edges, copyDT, id = id, window = window, + direction = 'potato'), + 'data.table') +}) + N_id <- 5 DT_expect <- data.table( From e0bedb3156f641a4afaa3d79e5815fec94ed8f47 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 17:51:50 -0400 Subject: [PATCH 067/104] fix add direction to env --- R/edge_delay.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index c8ba527f..27925b2b 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -191,7 +191,7 @@ edge_delay <- function( timegroup[which.min(diff_rad(focal_direction, direction))]] }, by = c('timegroup', 'dyadID'), - env = list(id = id)] + env = list(id = id, direction = direction)] forward[, dir_corr_delay := timegroup - delay_timegroup] From a0f90bfca7c0bd5cc5448443bb5e780bcf1941e6 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 17:54:22 -0400 Subject: [PATCH 068/104] test window column in edge or DT has no impact --- tests/testthat/test-edge-delay.R | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index e6cb2143..7e7013b3 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -108,6 +108,32 @@ test_that('direction colname can different than default', { 'data.table') }) +test_that('window column in edge, DT does not influence results', { + copyDT <- copy(clean_DT) + copyDT[, window := 42] + + copyEdges <- copy(clean_edges) + copyEdges[, window := 42] + + expect_equal( + edge_delay(edges, copyDT, id = id, window = window), + edge_delay(edges, DT, id = id, window = window) + ) + + expect_equal( + edge_delay(copyEdges, DT, id = id, + window = window)[, .SD, .SDcols = -'window'], + edge_delay(edges, DT, id = id, window = window) + ) + + expect_equal( + edge_delay(copyEdges, copyDT, id = id, + window = window)[, .SD, .SDcols = -'window'], + edge_delay(edges, DT, id = id, window = window) + ) + +}) + N_id <- 5 DT_expect <- data.table( From 2be21f54936ce22267034fb01a79a7434e92d281 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 17:58:00 -0400 Subject: [PATCH 069/104] fix potential window colname mixup with env --- R/edge_delay.R | 46 ++++++++++++++++++++++++---------------------- 1 file changed, 24 insertions(+), 22 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 27925b2b..8c0aaab4 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -157,13 +157,13 @@ edge_delay <- function( } - if ('window' %in% colnames(DT)) { - setnames(DT, 'window', 'zzz_window') - } - - if ('window' %in% colnames(edges)) { - setnames(edges, 'window', 'zzz_window') - } + # if ('window' %in% colnames(DT)) { + # setnames(DT, 'window', 'zzz_window') + # } + # + # if ('window' %in% colnames(edges)) { + # setnames(edges, 'window', 'zzz_window') + # } data.table::setorderv(DT, 'timegroup') @@ -173,16 +173,18 @@ edge_delay <- function( by = .(fusionID, timegroup)] forward[, min_timegroup := - data.table::fifelse(timegroup - window < min(timegroup), - min(timegroup), - timegroup - window), - by = fusionID] + data.table::fifelse(timegroup - window < min(timegroup), + min(timegroup), + timegroup - window), + by = fusionID, + env = list(window = window)] forward[, max_timegroup := - data.table::fifelse(timegroup + window > max(timegroup), - max(timegroup), - timegroup + window), - by = fusionID] + data.table::fifelse(timegroup + window > max(timegroup), + max(timegroup), + timegroup + window), + by = fusionID, + env = list(window = window)] forward[, delay_timegroup := { focal_direction <- DT[timegroup == .BY$timegroup & @@ -211,13 +213,13 @@ edge_delay <- function( reverse ), use.names = TRUE) - if ('zzz_window' %in% colnames(DT)) { - setnames(DT, 'zzz_window', 'window') - } - - if ('zzz_window' %in% colnames(edges)) { - setnames(edges, 'zzz_window', 'window') - } + # if ('zzz_window' %in% colnames(DT)) { + # setnames(DT, 'zzz_window', 'window') + # } + # + # if ('zzz_window' %in% colnames(edges)) { + # setnames(edges, 'zzz_window', 'window') + # } return(out) } From 7ae21d347a91a0e8be9a495964afdf09d70a5c9c Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:01:35 -0400 Subject: [PATCH 070/104] tidy window --- R/edge_delay.R | 8 -------- 1 file changed, 8 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 8c0aaab4..8cda7ac7 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -213,14 +213,6 @@ edge_delay <- function( reverse ), use.names = TRUE) - # if ('zzz_window' %in% colnames(DT)) { - # setnames(DT, 'zzz_window', 'window') - # } - # - # if ('zzz_window' %in% colnames(edges)) { - # setnames(edges, 'zzz_window', 'window') - # } - return(out) } From 2e73b4e667573c69f2c9042b9b8e837d2f4ce1c4 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:04:26 -0400 Subject: [PATCH 071/104] fix setcolorder --- R/edge_delay.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 8cda7ac7..65b61325 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -201,8 +201,6 @@ edge_delay <- function( j = c('min_timegroup', 'max_timegroup','delay_timegroup'), value = NULL) - data.table::setorder(forward, timegroup, ID1, ID2, dir_corr_delay) - # "Reverse": replicate forward but reverse direction ID1 <- ID2 reverse <- copy(forward) setnames(reverse, c('ID1', 'ID2'), c('ID2', 'ID1')) @@ -213,6 +211,11 @@ edge_delay <- function( reverse ), use.names = TRUE) + data.table::setcolorder( + out, + c('timegroup', 'ID1', 'ID2', 'dyadID', 'fusionID', 'dir_corr_delay') + ) + return(out) } From db789eb63f63d8eacb44ba68f2910b091e5f0d0b Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:08:58 -0400 Subject: [PATCH 072/104] fix arg names --- R/internal.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/internal.R b/R/internal.R index bdf93f0f..df8f252c 100644 --- a/R/internal.R +++ b/R/internal.R @@ -2,8 +2,8 @@ #' #' Internal function #' -#' @param target angle in radians -#' @param source angle in radians +#' @param x angle in radians +#' @param y angle in radians #' @param signed boolean if signed difference should be returned, default FALSE #' #' @return From 6be20578aedff7a2a7f59f89b9a463fa66d93614 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:09:01 -0400 Subject: [PATCH 073/104] return --- R/internal.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/internal.R b/R/internal.R index df8f252c..035195a6 100644 --- a/R/internal.R +++ b/R/internal.R @@ -6,7 +6,7 @@ #' @param y angle in radians #' @param signed boolean if signed difference should be returned, default FALSE #' -#' @return +#' @return Difference between x and y in radians. If signed is TRUE, the signed difference is returned. If signed is FALSE, the absolute difference is returned. Note: The difference is the smallest difference, eg. #' @references adapted from https://stackoverflow.com/a/7869457 #' #' @examples From 00561b7912bdd07cb5a2c1c290cb5ab2949a015c Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:09:08 -0400 Subject: [PATCH 074/104] tidy window --- R/edge_delay.R | 8 -------- 1 file changed, 8 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 65b61325..c6555bd7 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -157,14 +157,6 @@ edge_delay <- function( } - # if ('window' %in% colnames(DT)) { - # setnames(DT, 'window', 'zzz_window') - # } - # - # if ('window' %in% colnames(edges)) { - # setnames(edges, 'window', 'zzz_window') - # } - data.table::setorderv(DT, 'timegroup') # "Forward": all edges ID1 -> ID2 From 1c7894785b5aca95669c2440e9a55505e835bb7e Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:09:30 -0400 Subject: [PATCH 075/104] fix orders --- R/edge_delay.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index c6555bd7..07bb4494 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -156,8 +156,7 @@ edge_delay <- function( stop('dyadID field not present in edges, did you run dyad_id?') } - - data.table::setorderv(DT, 'timegroup') + data.table::setorder(DT, timegroup) # "Forward": all edges ID1 -> ID2 forward <- edges[!is.na(fusionID), @@ -203,9 +202,10 @@ edge_delay <- function( reverse ), use.names = TRUE) + data.table::setorder(out, timegroup) data.table::setcolorder( out, - c('timegroup', 'ID1', 'ID2', 'dyadID', 'fusionID', 'dir_corr_delay') + c('timegroup', 'ID1', 'ID2', 'dyadID', 'fusionID') ) return(out) From f49117ff27069009f4159f7ae39bb9fe7c092b6c Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:13:02 -0400 Subject: [PATCH 076/104] fix drop units to improve efficiency half of edge_delay profile indicates time spent running Ops.unit --- R/internal.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/internal.R b/R/internal.R index 035195a6..01313c95 100644 --- a/R/internal.R +++ b/R/internal.R @@ -41,9 +41,8 @@ diff_rad <- function(x, y, signed = FALSE) { stop('units(y) is not radians') } - d <- y - x - pi_rad <- units::as_units(pi, 'rad') - d <- ((d + pi_rad) %% (2 * pi_rad)) - pi_rad + d <- units::drop_units(y) - units::drop_units(x) + d <- ((d + pi) %% (2 * pi)) - pi if (signed) { return(d) From bea4b33865242879837fa392460c1a4e5d484859 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:14:55 -0400 Subject: [PATCH 077/104] bump required data.table version needs env= argument --- DESCRIPTION | 2 +- codemeta.json | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 64d98ec2..53d188d4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,7 @@ Depends: R (>= 3.4) Imports: adehabitatHR (>= 0.4.21), - data.table (>= 1.10.5), + data.table (>= 1.15.0), igraph, sf, lwgeom, diff --git a/codemeta.json b/codemeta.json index d484277d..139051b0 100644 --- a/codemeta.json +++ b/codemeta.json @@ -138,7 +138,7 @@ "@type": "SoftwareApplication", "identifier": "data.table", "name": "data.table", - "version": ">= 1.10.5", + "version": ">= 1.15.0", "provider": { "@id": "https://cran.r-project.org", "@type": "Organization", @@ -214,7 +214,7 @@ }, "SystemRequirements": "GDAL (>= 2.0.1), GEOS (>= 3.4.0), PROJ (>= 4.8.0),\n sqlite3" }, - "fileSize": "2023.039KB", + "fileSize": "2044.39KB", "citation": [ { "@type": "ScholarlyArticle", From b7c9bf1b83eaf7b53eae9e4132b4cad8e78b40ac Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:17:55 -0400 Subject: [PATCH 078/104] test timegroup is integer --- tests/testthat/test-edge-delay.R | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 7e7013b3..c432b4a8 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -41,9 +41,18 @@ test_that('arguments required, otherwise error detected', { 'window is required') }) -test_that('window is numeric', { +test_that('window is numeric, timegroup is integer', { expect_error(edge_delay(edges, DT, id = id, window = 'potato'), 'numeric') + copy_edges <- copy(clean_edges) + copy_edges[, timegroup := as.character(integer)] + expect_error(edge_delay(copy_edges, DT, id = id, window = 2), + 'integer') + + copy_DT <- copy(copy_DT) + copy_DT[, timegroup := as.character(integer)] + expect_error(edge_delay(edges, copy_DT, id = id, window = 2), + 'integer') }) test_that('column names must exist in DT', { From 28c8f565d310dc378eb9c48e4d1a907ed059cd8b Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:18:00 -0400 Subject: [PATCH 079/104] check timegroup is integer --- R/edge_delay.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/edge_delay.R b/R/edge_delay.R index 07bb4494..6333bbb4 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -148,6 +148,10 @@ edge_delay <- function( stop('window should be a numeric, in the units of timegroup') } + if (!is.integer(DT$timegroup) || !is.integer(edges$timegroup)) { + stop('timegroup should be an integer, did you use group_times?') + } + if (!'fusionID' %in% colnames(edges)) { stop('fusionID field not present in edges, did you run fusion_id?') } From cba1cf93565006691393597ca5f506b232e4f40d Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:23:05 -0400 Subject: [PATCH 080/104] fix typo --- tests/testthat/test-edge-delay.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index c432b4a8..346227bc 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -45,7 +45,7 @@ test_that('window is numeric, timegroup is integer', { expect_error(edge_delay(edges, DT, id = id, window = 'potato'), 'numeric') copy_edges <- copy(clean_edges) - copy_edges[, timegroup := as.character(integer)] + copy_edges[, timegroup := as.character(timegroup)] expect_error(edge_delay(copy_edges, DT, id = id, window = 2), 'integer') From 9bf16a9200c768dd2137ba611dc00ce963729f4d Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:23:33 -0400 Subject: [PATCH 081/104] add return_units arg --- R/internal.R | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/R/internal.R b/R/internal.R index 01313c95..c264035b 100644 --- a/R/internal.R +++ b/R/internal.R @@ -5,6 +5,7 @@ #' @param x angle in radians #' @param y angle in radians #' @param signed boolean if signed difference should be returned, default FALSE +#' @param return_units return difference with units = 'rad' #' #' @return Difference between x and y in radians. If signed is TRUE, the signed difference is returned. If signed is FALSE, the absolute difference is returned. Note: The difference is the smallest difference, eg. #' @references adapted from https://stackoverflow.com/a/7869457 @@ -33,7 +34,7 @@ #' #' # Differences #' DT[, diff_rad(direction[1], direction[2])] -diff_rad <- function(x, y, signed = FALSE) { +diff_rad <- function(x, y, signed = FALSE, return_units = FALSE) { if (!inherits(x, 'units') || units(x)$numerator != 'rad') { stop('units(x) is not radians') } @@ -45,9 +46,15 @@ diff_rad <- function(x, y, signed = FALSE) { d <- ((d + pi) %% (2 * pi)) - pi if (signed) { - return(d) + out <- d } else { - return(abs(d)) + out <- abs(d) + } + + if (return_units) { + return(units::as_units(out, 'rad')) + } else { + return(out) } } From 113f6de1922bc4c6202520e3b39d3ddfa15079f0 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:23:42 -0400 Subject: [PATCH 082/104] use return_units arg --- tests/testthat/test-diff-rad.R | 40 +++++++++++++++++----------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/tests/testthat/test-diff-rad.R b/tests/testthat/test-diff-rad.R index ddcd4aa1..6ff12d62 100644 --- a/tests/testthat/test-diff-rad.R +++ b/tests/testthat/test-diff-rad.R @@ -8,25 +8,25 @@ pt_02 <- as_units(0.2, 'rad') pi_rad <- as_units(pi, 'rad') # Adapted from: https://gist.github.com/bradphelan/7fe21ad8ebfcb43696b8 -expect_equal(diff_rad(pt_01, pt_02, TRUE), pt_01) -expect_equal(diff_rad(pt_01, pt_02 + 2 * pi_rad, TRUE), pt_01) -expect_equal(diff_rad(pt_01, pt_02 - 2 * pi_rad, TRUE), pt_01) -expect_equal(diff_rad(pt_01 + 2 * pi_rad, pt_02, TRUE), pt_01) -expect_equal(diff_rad(pt_01 - 2 * pi_rad, pt_02, TRUE), pt_01) -expect_equal(diff_rad(pt_02, pt_01, TRUE), -pt_01) -expect_equal(diff_rad(pt_02 + 2 * pi_rad, pt_01, TRUE), -pt_01) -expect_equal(diff_rad(pt_02 - 2 * pi_rad, pt_01, TRUE), -pt_01) -expect_equal(diff_rad(pt_02, pt_01 + 2 * pi_rad, TRUE), -pt_01) -expect_equal(diff_rad(pt_02, pt_01 - 2 * pi_rad, TRUE), -pt_01) +expect_equal(diff_rad(pt_01, pt_02, TRUE, TRUE), pt_01) +expect_equal(diff_rad(pt_01, pt_02 + 2 * pi_rad, TRUE, TRUE), pt_01) +expect_equal(diff_rad(pt_01, pt_02 - 2 * pi_rad, TRUE, TRUE), pt_01) +expect_equal(diff_rad(pt_01 + 2 * pi_rad, pt_02, TRUE, TRUE), pt_01) +expect_equal(diff_rad(pt_01 - 2 * pi_rad, pt_02, TRUE, TRUE), pt_01) +expect_equal(diff_rad(pt_02, pt_01, TRUE, TRUE), -pt_01) +expect_equal(diff_rad(pt_02 + 2 * pi_rad, pt_01, TRUE, TRUE), -pt_01) +expect_equal(diff_rad(pt_02 - 2 * pi_rad, pt_01, TRUE, TRUE), -pt_01) +expect_equal(diff_rad(pt_02, pt_01 + 2 * pi_rad, TRUE, TRUE), -pt_01) +expect_equal(diff_rad(pt_02, pt_01 - 2 * pi_rad, TRUE, TRUE), -pt_01) -expect_equal(diff_rad(pt_01, pt_02, FALSE), pt_01) -expect_equal(diff_rad(pt_01, pt_02 + 2 * pi_rad, FALSE), pt_01) -expect_equal(diff_rad(pt_01, pt_02 - 2 * pi_rad, FALSE), pt_01) -expect_equal(diff_rad(pt_01 + 2 * pi_rad, pt_02, FALSE), pt_01) -expect_equal(diff_rad(pt_01 - 2 * pi_rad, pt_02, FALSE), pt_01) -expect_equal(diff_rad(pt_02, pt_01, FALSE), pt_01) -expect_equal(diff_rad(pt_02 + 2 * pi_rad, pt_01, FALSE), pt_01) -expect_equal(diff_rad(pt_02 - 2 * pi_rad, pt_01, FALSE), pt_01) -expect_equal(diff_rad(pt_02, pt_01 + 2 * pi_rad, FALSE), pt_01) -expect_equal(diff_rad(pt_02, pt_01 - 2 * pi_rad, FALSE), pt_01) +expect_equal(diff_rad(pt_01, pt_02, FALSE, TRUE), pt_01) +expect_equal(diff_rad(pt_01, pt_02 + 2 * pi_rad, FALSE, TRUE), pt_01) +expect_equal(diff_rad(pt_01, pt_02 - 2 * pi_rad, FALSE, TRUE), pt_01) +expect_equal(diff_rad(pt_01 + 2 * pi_rad, pt_02, FALSE, TRUE), pt_01) +expect_equal(diff_rad(pt_01 - 2 * pi_rad, pt_02, FALSE, TRUE), pt_01) +expect_equal(diff_rad(pt_02, pt_01, FALSE, TRUE), pt_01) +expect_equal(diff_rad(pt_02 + 2 * pi_rad, pt_01, FALSE, TRUE), pt_01) +expect_equal(diff_rad(pt_02 - 2 * pi_rad, pt_01, FALSE, TRUE), pt_01) +expect_equal(diff_rad(pt_02, pt_01 + 2 * pi_rad, FALSE, TRUE), pt_01) +expect_equal(diff_rad(pt_02, pt_01 - 2 * pi_rad, FALSE, TRUE), pt_01) From a3a0a9669fae62b0aaf5dcacfe59128b3f28df62 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:24:45 -0400 Subject: [PATCH 083/104] fix typo --- tests/testthat/test-edge-delay.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 346227bc..8b90b288 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -49,8 +49,8 @@ test_that('window is numeric, timegroup is integer', { expect_error(edge_delay(copy_edges, DT, id = id, window = 2), 'integer') - copy_DT <- copy(copy_DT) - copy_DT[, timegroup := as.character(integer)] + copy_DT <- copy(clean_DT) + copy_DT[, timegroup := as.character(timegroup)] expect_error(edge_delay(edges, copy_DT, id = id, window = 2), 'integer') }) From 2302498c28ef7cdf805e5645e8fcea62e73a58eb Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 18:31:22 -0400 Subject: [PATCH 084/104] todo test expected dataset --- tests/testthat/test-edge-delay.R | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 8b90b288..5846aab8 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -162,6 +162,17 @@ fusion_id(edges_expect) DT_expect[ID %in% c('A', 'B')] edges_expect[dyadID == 'A-B'] -edge_delay(edges_expect[dyadID == 'A-B'], - DT_expect[ID %in% c('A', 'B')], - window = 1, id = id) +delay <- edge_delay(edges_expect, DT_expect, window = window, id = id) + +test_that('expected results are returned', { + DT_expect + edges_expect + delay + + expect_lte(nrow(delay), nrow(edges_expect)) + expect_lte(nrow(DT_expect), nrow(delay)) + + # Test average with na.rm leader is X + # Test max dir corr delay is X + # Test min dir corr delay is X +}) From 0a8e0191180359cae4f64bab91db62bac139b288 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 19:32:37 -0400 Subject: [PATCH 085/104] test expected dataset --- tests/testthat/test-edge-delay.R | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 5846aab8..bc114260 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -165,14 +165,12 @@ edges_expect[dyadID == 'A-B'] delay <- edge_delay(edges_expect, DT_expect, window = window, id = id) test_that('expected results are returned', { - DT_expect - edges_expect - delay - expect_lte(nrow(delay), nrow(edges_expect)) expect_lte(nrow(DT_expect), nrow(delay)) - # Test average with na.rm leader is X - # Test max dir corr delay is X - # Test min dir corr delay is X + mean_delays <- delay[, mean(dir_corr_delay, na.rm = TRUE), by = ID1] + + expect_equal(mean_delays[V1 == min(V1), ID1], LETTERS[1]) + expect_equal(mean_delays[V1 == median(V1), ID1], LETTERS[ceiling(N_id / 2)]) + expect_equal(mean_delays[V1 == max(V1), ID1], LETTERS[N_id]) }) From 202e752e0e1606a112bcc9236e5342972287e49f Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Fri, 6 Dec 2024 19:47:54 -0400 Subject: [PATCH 086/104] fix nse notes --- R/edge_delay.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/edge_delay.R b/R/edge_delay.R index 6333bbb4..61998967 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -104,6 +104,9 @@ edge_delay <- function( window = NULL, id = NULL, direction = 'direction') { + # due to NSE notes in R CMD check + . <- timegroup <- fusionID <- min_timegroup <- max_timegroup <- + delay_timegroup <- ID1 <- ID2 <- dir_corr_delay <- NULL if (is.null(DT)) { stop('input DT required') From c03dc34258bab45442e95d653cf9c0459aaa99ca Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 11:59:09 -0400 Subject: [PATCH 087/104] describe positive edge is ID1 leading ID2 --- R/edge_delay.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 61998967..93bfed27 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -29,7 +29,12 @@ #' @return \code{edge_delay} returns the input \code{edges} appended with #' a 'dir_corr_delay' column indicating the temporal delay (in units of #' timegroups) at which ID1's direction of movement is most similar to -#' ID2's direction of movement, within the temporal window defined. +#' ID2's direction of movement, within the temporal window defined. For +#' example, if focal individual 'A' moves in a 45 degree direction at time 2 +#' and individual 'B' moves in a most similar direction within the window +#' at time 5, the directional correlation delay between A and B is 3. Positive +#' values of directional correlation delay indicate a directed leadership +#' edge from ID1 to ID2. #' #' @export #' From 31b18b9b57c121eee7bb73465eebf34ffcca0bc6 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 11:59:20 -0400 Subject: [PATCH 088/104] fix ref --- R/edge_delay.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 93bfed27..2de67c12 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -40,7 +40,7 @@ #' #' @references #' -#' The directional correlation delay is defined in Nagy et al 2010 +#' The directional correlation delay is defined in Nagy et al. 2010 #' (). #' #' See examples of measuring the directional correlation delay: From a58de401861b9d3224023820eb03518d5820f8cf Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 11:59:30 -0400 Subject: [PATCH 089/104] print positive edges --- R/edge_delay.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 2de67c12..d513e9a7 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -102,7 +102,7 @@ #' id = 'ID' #' ) #' -#' print(delay) +#' delay[, mean(dir_corr_delay, na.rm = TRUE), by = .(ID1, ID2)][V1 > 0] edge_delay <- function( edges, DT, From f4e34e5732d090256cd6e64f830f7398c761b5cc Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 11:59:34 -0400 Subject: [PATCH 090/104] rm --- R/edge_delay.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index d513e9a7..d9f2d116 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -168,8 +168,6 @@ edge_delay <- function( stop('dyadID field not present in edges, did you run dyad_id?') } - data.table::setorder(DT, timegroup) - # "Forward": all edges ID1 -> ID2 forward <- edges[!is.na(fusionID), data.table::first(.SD), From 7576827361e0c23765452e217be58f4383c281d1 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 11:59:42 -0400 Subject: [PATCH 091/104] fix positive = lead --- R/edge_delay.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index d9f2d116..de31cc96 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -196,7 +196,7 @@ edge_delay <- function( by = c('timegroup', 'dyadID'), env = list(id = id, direction = direction)] - forward[, dir_corr_delay := timegroup - delay_timegroup] + forward[, dir_corr_delay := delay_timegroup - timegroup] data.table::set(forward, j = c('min_timegroup', 'max_timegroup','delay_timegroup'), From e5e82a3ee9e91e2eb617abc48da977d13460b98a Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 11:59:47 -0400 Subject: [PATCH 092/104] fix missing data.table:: --- R/edge_delay.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index de31cc96..c7880549 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -203,7 +203,7 @@ edge_delay <- function( value = NULL) # "Reverse": replicate forward but reverse direction ID1 <- ID2 - reverse <- copy(forward) + reverse <- data.table::copy(forward) setnames(reverse, c('ID1', 'ID2'), c('ID2', 'ID1')) reverse[, dir_corr_delay := - dir_corr_delay] From 3d41ba3aad078a32af97daeabac9a4393a869d3f Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 11:59:55 -0400 Subject: [PATCH 093/104] fix example of internal f --- R/internal.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/internal.R b/R/internal.R index c264035b..5d3fc73b 100644 --- a/R/internal.R +++ b/R/internal.R @@ -33,7 +33,7 @@ #' ) #' #' # Differences -#' DT[, diff_rad(direction[1], direction[2])] +#' spatsoc:::diff_rad(DT[1, direction], DT[2, direction]) diff_rad <- function(x, y, signed = FALSE, return_units = FALSE) { if (!inherits(x, 'units') || units(x)$numerator != 'rad') { stop('units(x) is not radians') From 884a6bc0c04822a3e4cbefa346aa2dab73c4e07f Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 12:03:26 -0400 Subject: [PATCH 094/104] extend expected with more xy --- tests/testthat/test-edge-delay.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index bc114260..c0f88e03 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -145,9 +145,12 @@ test_that('window column in edge, DT does not influence results', { N_id <- 5 +N_seq <- 10 +seq_xy <- c(seq(0, 5, length.out = N_seq / 2), + seq(5.1, 0, length.out = N_seq / 2)) DT_expect <- data.table( - X = rep(c(0, 5, 5, 0, 0), each = N_id), - Y = rep(c(0, 0, 5, 5, 0), each = N_id), + X = rep(seq_xy, each = N_id), + Y = rep(seq_xy, each = N_id), ID = LETTERS[seq.int(N_id)] ) DT_expect[, timegroup := seq.int(.GRP)[.GRP] + seq.int(.N), by = ID] From 3bfd7a5e68fc9504cfa1b4bc2bc0a4e37d949e08 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 12:03:28 -0400 Subject: [PATCH 095/104] rm --- tests/testthat/test-edge-delay.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index c0f88e03..9e38d4e6 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -163,8 +163,6 @@ edges_expect <- edge_dist(DT_expect, threshold = 100, id, coords, timegroup, dyad_id(edges_expect, 'ID1', 'ID2') fusion_id(edges_expect) -DT_expect[ID %in% c('A', 'B')] -edges_expect[dyadID == 'A-B'] delay <- edge_delay(edges_expect, DT_expect, window = window, id = id) test_that('expected results are returned', { From 3b8b9f9759b212b923830f369795363565420e4a Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 12:04:10 -0400 Subject: [PATCH 096/104] increase window --- tests/testthat/test-edge-delay.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 9e38d4e6..7ab81a82 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -163,6 +163,7 @@ edges_expect <- edge_dist(DT_expect, threshold = 100, id, coords, timegroup, dyad_id(edges_expect, 'ID1', 'ID2') fusion_id(edges_expect) +window <- 5 delay <- edge_delay(edges_expect, DT_expect, window = window, id = id) test_that('expected results are returned', { From 84d8386f933dc2c8379c83889e8d283142b564cf Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 12:04:18 -0400 Subject: [PATCH 097/104] test for positive edges --- tests/testthat/test-edge-delay.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-edge-delay.R b/tests/testthat/test-edge-delay.R index 7ab81a82..0d68de7b 100644 --- a/tests/testthat/test-edge-delay.R +++ b/tests/testthat/test-edge-delay.R @@ -172,7 +172,11 @@ test_that('expected results are returned', { mean_delays <- delay[, mean(dir_corr_delay, na.rm = TRUE), by = ID1] - expect_equal(mean_delays[V1 == min(V1), ID1], LETTERS[1]) + expect_equal(mean_delays[V1 == min(V1), ID1], LETTERS[N_id]) expect_equal(mean_delays[V1 == median(V1), ID1], LETTERS[ceiling(N_id / 2)]) - expect_equal(mean_delays[V1 == max(V1), ID1], LETTERS[N_id]) + expect_equal(mean_delays[V1 == max(V1), ID1], LETTERS[1]) + + mean_delays_wrt_A <- delay[ID1 == 'A', mean(dir_corr_delay, na.rm = TRUE), + by = ID2] + expect_equal(mean_delays_wrt_A[V1 == max(V1), ID2], LETTERS[N_id]) }) From 69dbc6e72d43b9c7f728aff7bfbc36c54327b387 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 12:04:41 -0400 Subject: [PATCH 098/104] needs modulus fix in units --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 53d188d4..97bcf109 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -43,3 +43,4 @@ Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 SystemRequirements: GDAL (>= 2.0.1), GEOS (>= 3.4.0), PROJ (>= 4.8.0), sqlite3 +Remotes: r-quantities/units@889cf39ef447f7c8031282f70d1697d8b149e384 From a5735dae41e5e37ff299bc964ab2a859f999d460 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 14:17:21 -0400 Subject: [PATCH 099/104] try short commit sha Error Cannot parse package: units@889cf39ef447f7c8031282f70d1697d8b149e384. --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 97bcf109..72d28fa9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -43,4 +43,4 @@ Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 SystemRequirements: GDAL (>= 2.0.1), GEOS (>= 3.4.0), PROJ (>= 4.8.0), sqlite3 -Remotes: r-quantities/units@889cf39ef447f7c8031282f70d1697d8b149e384 +Remotes: r-quantities/units@889cf39 From 8af8fdb33c5dca9da7085618e2c39a5e73af253d Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 14:27:01 -0400 Subject: [PATCH 100/104] fix note dyadID --- R/edge_delay.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index c7880549..48628f66 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -16,7 +16,8 @@ #' function using the columns \code{timegroup} (from \code{group_times}) and #' \code{ID1} and \code{ID2} (in \code{edges}, from \code{dyad_id}) with #' \code{id} (in \code{DT}). This function expects a \code{fusionID} present, -#' generated with the \code{fusion_id} function. The \code{id}, and +#' generated with the \code{fusion_id} function, and a code{dyadID} present, +#' generated with the \code{dyad_id} function. The \code{id}, and #' \code{direction} arguments expect the names of a column in \code{DT} which #' correspond to the id, and direction columns. #' From 460949db38babc9c7372f91007d01aa715184145 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 14:33:18 -0400 Subject: [PATCH 101/104] more arg docs --- R/edge_delay.R | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 48628f66..353ed2e6 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -12,14 +12,18 @@ #' \code{data.frame}, you can convert it by reference using #' \code{\link[data.table:setDT]{data.table::setDT}}. #' -#' The rows in \code{edges} and \code{DT} are internally matched in this -#' function using the columns \code{timegroup} (from \code{group_times}) and -#' \code{ID1} and \code{ID2} (in \code{edges}, from \code{dyad_id}) with -#' \code{id} (in \code{DT}). This function expects a \code{fusionID} present, -#' generated with the \code{fusion_id} function, and a code{dyadID} present, -#' generated with the \code{dyad_id} function. The \code{id}, and -#' \code{direction} arguments expect the names of a column in \code{DT} which -#' correspond to the id, and direction columns. +#' The \code{edges} argument expects a distance based edge list generated with +#' \code{edge_nn} or \code{edge_dist}. The \code{DT} argument expects relocation +#' data with a timegroup column generated with \code{group_times}. +#' +#' The rows in \code{edges} and \code{DT} are internally matched in +#' \code{edge_delay} using the columns \code{timegroup} (from +#' \code{group_times}) and \code{ID1} and \code{ID2} (in \code{edges}, from +#' \code{dyad_id}) with \code{id} (in \code{DT}). This function expects a +#' \code{fusionID} present, generated with the \code{fusion_id} function, and a +#' code{dyadID} present, generated with the \code{dyad_id} function. The +#' \code{id}, and \code{direction} arguments expect the names of a column in +#' \code{DT} which correspond to the id, and direction columns. #' #' @inheritParams centroid_fusion #' @inheritParams direction_group From f2d80f4fa06f21c04332355b879107731a19b6c4 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 14:44:20 -0400 Subject: [PATCH 102/104] fix missing \ --- R/edge_delay.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/edge_delay.R b/R/edge_delay.R index 353ed2e6..a8f70ba3 100644 --- a/R/edge_delay.R +++ b/R/edge_delay.R @@ -21,7 +21,7 @@ #' \code{group_times}) and \code{ID1} and \code{ID2} (in \code{edges}, from #' \code{dyad_id}) with \code{id} (in \code{DT}). This function expects a #' \code{fusionID} present, generated with the \code{fusion_id} function, and a -#' code{dyadID} present, generated with the \code{dyad_id} function. The +#' \code{dyadID} present, generated with the \code{dyad_id} function. The #' \code{id}, and \code{direction} arguments expect the names of a column in #' \code{DT} which correspond to the id, and direction columns. #' From 1e4c5c0cd7a0e467fc9b45838fcda9af3725b66e Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 14:47:19 -0400 Subject: [PATCH 103/104] add test for types --- tests/testthat/test-diff-rad.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/testthat/test-diff-rad.R b/tests/testthat/test-diff-rad.R index 6ff12d62..633ac8d7 100644 --- a/tests/testthat/test-diff-rad.R +++ b/tests/testthat/test-diff-rad.R @@ -30,3 +30,5 @@ expect_equal(diff_rad(pt_02 - 2 * pi_rad, pt_01, FALSE, TRUE), pt_01) expect_equal(diff_rad(pt_02, pt_01 + 2 * pi_rad, FALSE, TRUE), pt_01) expect_equal(diff_rad(pt_02, pt_01 - 2 * pi_rad, FALSE, TRUE), pt_01) +expect_error(diff_rad(pt_01, 0.2), 'rad') +expect_error(diff_rad(0.1, pt_02), 'rad') From 3e96e6f2fe32478bc27871900e4b4d9efb9f8772 Mon Sep 17 00:00:00 2001 From: "Alec L. Robitaille" Date: Mon, 9 Dec 2024 14:47:42 -0400 Subject: [PATCH 104/104] man --- NAMESPACE | 1 + man/diff_rad.Rd | 51 +++++++++++++ man/direction_group.Rd | 3 +- man/direction_polarization.Rd | 3 +- man/direction_step.Rd | 3 +- man/direction_to_leader.Rd | 3 +- man/edge_delay.Rd | 140 ++++++++++++++++++++++++++++++++++ man/edge_dist.Rd | 1 + man/edge_nn.Rd | 1 + 9 files changed, 202 insertions(+), 4 deletions(-) create mode 100644 man/diff_rad.Rd create mode 100644 man/edge_delay.Rd diff --git a/NAMESPACE b/NAMESPACE index fad615cb..42873b26 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,6 +13,7 @@ export(direction_to_leader) export(distance_to_centroid) export(distance_to_leader) export(dyad_id) +export(edge_delay) export(edge_dist) export(edge_nn) export(fusion_id) diff --git a/man/diff_rad.Rd b/man/diff_rad.Rd new file mode 100644 index 00000000..a3b20235 --- /dev/null +++ b/man/diff_rad.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/internal.R +\name{diff_rad} +\alias{diff_rad} +\title{Difference of two angles measured in radians} +\usage{ +diff_rad(x, y, signed = FALSE, return_units = FALSE) +} +\arguments{ +\item{x}{angle in radians} + +\item{y}{angle in radians} + +\item{signed}{boolean if signed difference should be returned, default FALSE} + +\item{return_units}{return difference with units = 'rad'} +} +\value{ +Difference between x and y in radians. If signed is TRUE, the signed difference is returned. If signed is FALSE, the absolute difference is returned. Note: The difference is the smallest difference, eg. +} +\description{ +Internal function +} +\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')] + +# Set order using data.table::setorder +setorder(DT, datetime) + +# Calculate direction +direction_step( + DT = DT, + id = 'ID', + coords = c('X', 'Y'), + projection = 32736 +) + +# Differences +spatsoc:::diff_rad(DT[1, direction], DT[2, direction]) +} +\references{ +adapted from https://stackoverflow.com/a/7869457 +} diff --git a/man/direction_group.Rd b/man/direction_group.Rd index 560d441b..c70ff450 100644 --- a/man/direction_group.Rd +++ b/man/direction_group.Rd @@ -88,6 +88,7 @@ See examples of using mean group direction: Other Direction functions: \code{\link{direction_polarization}()}, \code{\link{direction_step}()}, -\code{\link{direction_to_leader}()} +\code{\link{direction_to_leader}()}, +\code{\link{edge_delay}()} } \concept{Direction functions} diff --git a/man/direction_polarization.Rd b/man/direction_polarization.Rd index 4db6d66e..8c0b66ca 100644 --- a/man/direction_polarization.Rd +++ b/man/direction_polarization.Rd @@ -88,6 +88,7 @@ See examples of using polarization: Other Direction functions: \code{\link{direction_group}()}, \code{\link{direction_step}()}, -\code{\link{direction_to_leader}()} +\code{\link{direction_to_leader}()}, +\code{\link{edge_delay}()} } \concept{Direction functions} diff --git a/man/direction_step.Rd b/man/direction_step.Rd index bfb5d1b4..20dcc3e5 100644 --- a/man/direction_step.Rd +++ b/man/direction_step.Rd @@ -112,6 +112,7 @@ example[, .(direction, units::set_units(direction, 'degree'))] Other Direction functions: \code{\link{direction_group}()}, \code{\link{direction_polarization}()}, -\code{\link{direction_to_leader}()} +\code{\link{direction_to_leader}()}, +\code{\link{edge_delay}()} } \concept{Direction functions} diff --git a/man/direction_to_leader.Rd b/man/direction_to_leader.Rd index b200361f..65a02d58 100644 --- a/man/direction_to_leader.Rd +++ b/man/direction_to_leader.Rd @@ -105,6 +105,7 @@ See examples of using direction to leader and position within group: Other Direction functions: \code{\link{direction_group}()}, \code{\link{direction_polarization}()}, -\code{\link{direction_step}()} +\code{\link{direction_step}()}, +\code{\link{edge_delay}()} } \concept{Direction functions} diff --git a/man/edge_delay.Rd b/man/edge_delay.Rd new file mode 100644 index 00000000..373a58cb --- /dev/null +++ b/man/edge_delay.Rd @@ -0,0 +1,140 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/edge_delay.R +\name{edge_delay} +\alias{edge_delay} +\title{Directional correlation delay based edge lists} +\usage{ +edge_delay(edges, DT, window = NULL, id = NULL, direction = "direction") +} +\arguments{ +\item{edges}{edge list generated generated by \code{edge_dist} or +\code{edge_nn}, with fusionID column generated by \code{fusion_id}} + +\item{DT}{input data.table with timegroup column generated with +\code{group_times} matching the input data.table used to generate the edge +list with \code{edge_nn} or \code{edge_dist}} + +\item{window}{temporal window in unit of timegroup column generated with +\code{group_times}, eg. \code{window = 4} corresponds to the 4 timegroups +before and after the focal observation} + +\item{id}{character string of ID column name} + +\item{direction}{character string of direction column name, default +"direction"} +} +\value{ +\code{edge_delay} returns the input \code{edges} appended with +a 'dir_corr_delay' column indicating the temporal delay (in units of +timegroups) at which ID1's direction of movement is most similar to +ID2's direction of movement, within the temporal window defined. For +example, if focal individual 'A' moves in a 45 degree direction at time 2 +and individual 'B' moves in a most similar direction within the window +at time 5, the directional correlation delay between A and B is 3. Positive +values of directional correlation delay indicate a directed leadership +edge from ID1 to ID2. +} +\description{ +\code{edge_delay} returns edge lists defined by the directional correlation +delay between individuals. The function expects a distance based edge list +generated by \code{edge_dist} or \code{edge_nn}, a \code{data.table} with +relocation data, individual identifiers and a window argument. The window +argument is used to specify the temporal window within which to measure the +directional correlation delay. Relocation data should be in two columns +representing the X and Y coordinates. +} +\details{ +The \code{edges} and \code{DT} must be \code{data.table}s. 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{edges} argument expects a distance based edge list generated with +\code{edge_nn} or \code{edge_dist}. The \code{DT} argument expects relocation +data with a timegroup column generated with \code{group_times}. + +The rows in \code{edges} and \code{DT} are internally matched in +\code{edge_delay} using the columns \code{timegroup} (from +\code{group_times}) and \code{ID1} and \code{ID2} (in \code{edges}, from +\code{dyad_id}) with \code{id} (in \code{DT}). This function expects a +\code{fusionID} present, generated with the \code{fusion_id} function, and a +\code{dyadID} present, generated with the \code{dyad_id} function. The +\code{id}, and \code{direction} arguments expect the names of a column in +\code{DT} which correspond to the id, and direction columns. +} +\examples{ +# Load data.table +library(data.table) +\dontshow{data.table::setDTthreads(1)} + +# Read example data +DT <- fread(system.file("extdata", "DT.csv", package = "spatsoc")) + +# Select only individuals A, B, C for this example +DT <- DT[ID \%in\% c('A', 'B', 'C')] + +# Cast the character column to POSIXct +DT[, datetime := as.POSIXct(datetime, tz = 'UTC')] + +# Temporal grouping +group_times(DT, datetime = 'datetime', threshold = '20 minutes') + +# Calculate direction +direction_step( + DT = DT, + id = 'ID', + coords = c('X', 'Y'), + projection = 32736 +) + +# Distance based edge list generation +edges <- edge_dist( + DT, + threshold = 100, + id = 'ID', + coords = c('X', 'Y'), + timegroup = 'timegroup', + returnDist = TRUE, + fillNA = FALSE +) + +# Generate dyad id +dyad_id(edges, id1 = 'ID1', id2 = 'ID2') + +# Generate fusion id +fusion_id(edges, threshold = 100) + +# Directional correlation delay +delay <- edge_delay( + edges = edges, + DT = DT, + window = 3, + id = 'ID' +) + +delay[, mean(dir_corr_delay, na.rm = TRUE), by = .(ID1, ID2)][V1 > 0] +} +\references{ +The directional correlation delay is defined in Nagy et al. 2010 +(\url{https://doi.org/10.1038/nature08891}). + +See examples of measuring the directional correlation delay: +\itemize{ +\item \url{https://doi.org/10.1016/j.anbehav.2013.07.005} +\item \url{https://doi.org/10.1073/pnas.1305552110} +\item \url{https://doi.org/10.1111/jfb.15315} +\item \url{https://doi.org/10.1371/journal.pcbi.1003446} +} +} +\seealso{ +Other Edge-list generation: +\code{\link{edge_dist}()}, +\code{\link{edge_nn}()} + +Other Direction functions: +\code{\link{direction_group}()}, +\code{\link{direction_polarization}()}, +\code{\link{direction_step}()}, +\code{\link{direction_to_leader}()} +} +\concept{Direction functions} +\concept{Edge-list generation} diff --git a/man/edge_dist.Rd b/man/edge_dist.Rd index c0f78a64..34c48bb0 100644 --- a/man/edge_dist.Rd +++ b/man/edge_dist.Rd @@ -117,6 +117,7 @@ edges <- edge_dist( } \seealso{ Other Edge-list generation: +\code{\link{edge_delay}()}, \code{\link{edge_nn}()} } \concept{Edge-list generation} diff --git a/man/edge_nn.Rd b/man/edge_nn.Rd index d19c71a3..c17ce380 100644 --- a/man/edge_nn.Rd +++ b/man/edge_nn.Rd @@ -120,6 +120,7 @@ edge_nn(DT, id = 'ID', coords = c('X', 'Y'), } \seealso{ Other Edge-list generation: +\code{\link{edge_delay}()}, \code{\link{edge_dist}()} } \concept{Edge-list generation}