tests/testthat/test-collapse_timeframes.R

In netdiffuseR: Analysis of Diffusion and Contagion Processes on Networks

context("collapse_timeframes: collapsing longitudinal edgelists")

# Base edgelist used across most tests:
# - 2 directed pairs: (1->2) and (2->3)
# - 4 time points: 1, 2, 3, 4
# - Each pair appears twice per time point
el <- data.frame(
  sender   = c(1, 1, 1, 1, 2, 2, 2, 2),
  receiver = c(2, 2, 2, 2, 3, 3, 3, 3),
  time     = c(1, 2, 3, 4, 1, 2, 3, 4),
  weight   = c(1, 1, 1, 1, 1, 1, 1, 1)
)

# Block 1: Output structure -----------------------------------------------

test_that("collapse_timeframes returns a data.frame", {
  result <- collapse_timeframes(el, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 1)
  expect_s3_class(result, "data.frame")
})

test_that("collapse_timeframes returns exactly 4 columns", {
  result <- collapse_timeframes(el, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 1)
  expect_equal(ncol(result), 4L)
})

test_that("output column names match inputs", {
  result <- collapse_timeframes(el, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 1)
  expect_named(result, c("sender", "receiver", "time", "weight"))
})

test_that("output has fewer or equal rows than input after collapsing", {
  result <- collapse_timeframes(el, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 2)
  expect_lte(nrow(result), nrow(el))
})

# Block 2: Binning logic (window_size) ------------------------------------

test_that("window_size=1 does not merge periods", {
  result <- collapse_timeframes(el, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 1)
  expect_equal(length(unique(result$time)), 4L)
})

test_that("window_size=2 merges 4 periods into 2 bins", {
  result <- collapse_timeframes(el, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 2)
  expect_equal(length(unique(result$time)), 2L)
})

test_that("window_size=4 merges all periods into 1 bin", {
  result <- collapse_timeframes(el, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 4)
  expect_equal(length(unique(result$time)), 1L)
})

test_that("aggregated weight is sum of constituent weights", {
  # Two rows with weight=0.5 in bin 1 should aggregate to 1.0
  el2 <- data.frame(
    sender   = c(1, 1),
    receiver = c(2, 2),
    time     = c(1, 2),
    weight   = c(0.5, 0.5)
  )
  result <- collapse_timeframes(el2, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 2)
  expect_equal(result$weight, 1.0)
})

# Block 3: relative_time TRUE / FALSE -------------------------------------

# Edgelist with a gap: time points 1, 2, 5, 6 (no 3 or 4)
el_gap <- data.frame(
  sender   = c(1, 1, 1, 1),
  receiver = c(2, 2, 2, 2),
  time     = c(1, 2, 5, 6),
  weight   = c(1, 1, 1, 1)
)

test_that("relative_time=TRUE produces a strict 1,2,... sequence", {
  result <- collapse_timeframes(el_gap, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 1, relative_time = TRUE)
  expect_equal(sort(unique(result$time)), 1:4)
})

test_that("relative_time=FALSE preserves original bin values (may have gaps)", {
  result <- collapse_timeframes(el_gap, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 1, relative_time = FALSE)
  expect_false(identical(sort(unique(result$time)), 1:4))
})

# Block 4: Time column parsing (integer, POSIXct, character string) -------

test_that("integer time column is handled", {
  el_int <- el
  el_int$time <- as.integer(el_int$time)
  result <- collapse_timeframes(el_int, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 2)
  expect_equal(length(unique(result$time)), 2L)
})

test_that("POSIXct time column is handled", {
  origin <- as.POSIXct("2024-01-01 00:00:00", tz = "UTC")
  el_posix <- el
  el_posix$time <- origin + (el$time - 1) * 3600  # 1 hour apart
  result <- collapse_timeframes(el_posix, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 7200)  # 2-hour windows (in seconds)
  expect_equal(length(unique(result$time)), 2L)
})

test_that("character time with time_format is parsed correctly", {
  el_chr <- el
  el_chr$time <- format(
    as.POSIXct("2024-01-01", tz = "UTC") + (el$time - 1) * 86400,
    "%Y-%m-%d"
  )
  result <- collapse_timeframes(el_chr, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 2 * 86400,  # 2-day windows
                                time_format = "%Y-%m-%d")
  expect_equal(length(unique(result$time)), 2L)
})

# Block 5: weightvar = NULL (count mode) vs explicit weight column --------

test_that("weightvar=NULL counts interactions as weight", {
  el_now <- data.frame(
    sender   = c(1, 1, 1),
    receiver = c(2, 2, 2),
    time     = c(1, 1, 1)
  )
  result <- collapse_timeframes(el_now, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = NULL,
                                window_size = 1)
  # 3 interactions in 1 bin -> weight should be 3
  expect_equal(result$weight, 3)
})

test_that("weightvar=NULL output column is named 'weight'", {
  result <- collapse_timeframes(el[, c("sender","receiver","time")],
                                ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = NULL,
                                window_size = 1)
  expect_true("weight" %in% names(result))
})

test_that("explicit weight column is summed correctly", {
  el_w <- data.frame(
    sender   = c(1, 1),
    receiver = c(2, 2),
    time     = c(1, 1),
    w        = c(3, 7)
  )
  result <- collapse_timeframes(el_w, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "w",
                                window_size = 1)
  expect_equal(result$w, 10)
})

# Block 6: Edge cases and error handling ----------------------------------

test_that("NAs in time column produce a warning", {
  el_na <- el
  el_na$time[1] <- NA
  expect_warning(
    collapse_timeframes(el_na, ego = "sender", alter = "receiver",
                        timevar = "time", weightvar = "weight",
                        window_size = 1),
    "NA"
  )
})

test_that("minimal input (1 pair, 1 period) works", {
  el_min <- data.frame(sender = 1, receiver = 2, time = 1, weight = 1)
  result <- collapse_timeframes(el_min, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 1)
  expect_equal(nrow(result), 1L)
  expect_equal(result$time, 1L)
})

test_that("custom ego/alter column names are respected in output", {
  el_custom <- el
  names(el_custom) <- c("from", "to", "period", "weight")
  result <- collapse_timeframes(el_custom, ego = "from", alter = "to",
                                timevar = "period", weightvar = "weight",
                                window_size = 2)
  expect_named(result, c("from", "to", "period", "weight"))
})

test_that("output time starts at 1", {
  result <- collapse_timeframes(el, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 1)
  expect_equal(min(result$time), 1L)
})

# Block 7: Post-aggregation processing (binarize, cumulative, symmetric) --

test_that("binarize=TRUE sets all weights to 1", {
  result <- collapse_timeframes(el, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 2, binarize = TRUE)
  expect_true(all(result$weight == 1))
})

test_that("symmetric=TRUE adds reverse edges", {
  # Asymmetric input: 1->2 only
  el_asym <- data.frame(sender = 1, receiver = 2, time = 1, weight = 1)
  result <- collapse_timeframes(el_asym, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 1, symmetric = TRUE)
  expect_equal(nrow(result), 2L)
  # Check if reverse is present
  expect_true(any(result$sender == 2 & result$receiver == 1))
})

test_that("cumulative=TRUE carries edges forward", {
  el_cum <- data.frame(
    sender   = c(1, 2),
    receiver = c(2, 3),
    time     = c(1, 2),
    weight   = c(1, 1)
  )
  result <- collapse_timeframes(el_cum, ego = "sender", alter = "receiver",
                                timevar = "time", weightvar = "weight",
                                window_size = 1, cumulative = TRUE)
  # time=1 has 1->2, time=2 should have both 1->2 and 2->3
  expect_equal(nrow(result[result$time == 1, ]), 1L)
  expect_equal(nrow(result[result$time == 2, ]), 2L)
})