# 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' utm <- 32736 window <- 3 DT[, datetime := as.POSIXct(datetime, tz = 'UTC')] group_times(DT, datetime = datetime, threshold = timethreshold) direction_step(DT, id, coords, utm) edges <- edge_dist(DT, threshold = threshold, id = id, coords = coords, 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(edges = edges, DT = DT, 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 must be provided') expect_error(edge_delay(edges, DT, id = id, window = NULL), 'window must be provided') }) 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(timegroup)] expect_error(edge_delay(copy_edges, DT, id = id, window = 2), 'integer') copy_DT <- copy(clean_DT) copy_DT[, timegroup := as.character(timegroup)] expect_error(edge_delay(edges, copy_DT, id = id, window = 2), 'integer') }) 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(copy_edges, DT, id = id, window = window), 'timegroup field') copy_edges <- copy(clean_edges) copy_edges[, fusionID := NULL] 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(copy_edges, DT, id = id, window = window), 'dyadID field') expect_error(edge_delay(edges, DT, id = id, window = window, direction = 'potato'), 'potato field') copy_DT <- copy(clean_DT) copy_DT[, timegroup := NULL] expect_error(edge_delay(edges, copy_DT, id = id, window = window), '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('column added to the result DT', { copyEdges <- copy(edges) expected_cols <- c(colnames(copyEdges), 'direction_delay', 'direction_diff') expect_setequal(expected_cols, colnames(edge_delay(edges, DT, id = id, window = window))) expect_length(expected_cols, ncol(edge_delay(edges, DT, id = id, window = window))) }) test_that('column added to the result DT is integer', { expect_type(edge_delay(edges, DT, id = id, window = window)$direction_delay, 'integer') }) test_that('returns a data.table', { expect_s3_class(edge_delay(edges, DT, id = id, window = window), 'data.table') }) test_that('direction colname can be 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') }) 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) ) }) test_that('rows with NAs in ID1, ID2, dyadID, fusionID are dropped', { n_dropped <- 42 na_edges <- copy(clean_edges) na_edges[seq.int(n_dropped), ID1 := NA] expect_equal( edge_delay(edges = na_edges, DT = DT, window, id)[, .N + n_dropped], edge_delay(edges = edges, DT = DT, window, id)[, .N] ) na_edges <- copy(clean_edges) na_edges[seq.int(n_dropped), ID2 := NA] expect_equal( edge_delay(edges = na_edges, DT = DT, window, id)[, .N + n_dropped], edge_delay(edges = edges, DT = DT, window, id)[, .N] ) na_edges <- copy(clean_edges) na_edges[seq.int(n_dropped), dyadID := NA] expect_equal( edge_delay(edges = na_edges, DT = DT, window, id)[, .N + n_dropped], edge_delay(edges = edges, DT = DT, window, id)[, .N] ) na_edges <- copy(clean_edges) na_edges[seq.int(n_dropped), fusionID := NA] expect_equal( edge_delay(edges = na_edges, DT = DT, window, id)[, .N + n_dropped], edge_delay(edges = edges, DT = DT, window, id)[, .N] ) }) test_that('setorder doesnt impact results', { reorder_edges <- copy(edges) setorder(reorder_edges, ID1) expect_equal( edge_delay(edges = edges, DT, window, id)[, sort(direction_delay)], edge_delay(edges = reorder_edges, DT, window, id)[, sort(direction_delay)] ) reorder_DT <- copy(DT) setorder(reorder_DT, ID) expect_equal( edge_delay(edges = edges, DT, window, id)[, sort(direction_delay)], edge_delay(edges = edges, reorder_DT, window, id)[, sort(direction_delay)] ) }) test_that('forward/reverse are equal', { swap_edges <- edge_dist(DT, threshold = threshold, id = id, coords = coords, timegroup = timegroup, returnDist = TRUE, fillNA = FALSE ) setnames(swap_edges, c('ID1', 'ID2'), c('ID2', 'ID1')) dyad_id(swap_edges, id1 = 'ID1', id2 = 'ID2') fusion_id(swap_edges, threshold = threshold) swap_delay <- edge_delay(swap_edges, DT, window, id) delay <- edge_delay(edges, DT, window, id) swap_leader <- leader_edge_delay(swap_delay) leader <- leader_edge_delay(delay) expect_equal( swap_leader[order(dyadID, ID1)], leader[order(dyadID, ID1)] ) }) 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(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] setorder(DT_expect, timegroup) direction_step(DT_expect, id, coords, crs = 4326) edge_expect <- edge_dist(DT_expect, threshold = 100, id, coords, timegroup, returnDist = TRUE) dyad_id(edge_expect, 'ID1', 'ID2') fusion_id(edge_expect, threshold = 100) window <- 5 delay_expect <- edge_delay(edge_expect, DT_expect, window = window, id = id) leader_expect <- leader_edge_delay(delay_expect) test_that('expected results are returned', { expect_lte(nrow(delay_expect), nrow(edge_expect)) expect_lte(nrow(DT_expect), nrow(delay_expect)) mean_delays <- delay_expect[, mean(direction_delay, na.rm = TRUE), by = ID1] 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[1]) mean_delays_wrt_A <- delay_expect[ ID1 == 'A', mean(direction_delay, na.rm = TRUE), by = ID2] expect_equal(mean_delays_wrt_A[V1 == max(V1), ID2], LETTERS[N_id]) }) test_that('exaggerated window size returns the same', { expect_equal( edge_delay(edge_expect, DT_expect, window = window, id = id), edge_delay(edge_expect, DT_expect, window = window + 10, id = id) ) expect_equal( edge_delay(edge_expect, DT_expect, window = window, id = id), edge_delay(edge_expect, DT_expect, window = window + 1000, id = id) ) })