tests/testthat/test-add_temporal_lag_columns.R

In dyadMLM: Tools for Dyadic Multilevel Models

test_that("lag predictors are matched at exactly time minus one", {
  data <- data.frame(
    row_id = 1:10,
    dyad_id = c(2, 1, 2, 1, 2, 1, 2, 1, 2, 2),
    person_id = c("C", "A", "D", "B", "C", "A", "D", "B", "C", "D"),
    time = c(2, 1, 1, 3, 1, 3, 2, 1, 3, 3),
    x = c(22, 11, 31, 13, 21, 12, 32, 14, 23, 33),
    z = 101:110
  )

  result <- prepare_dyad_data(
    data,
    dyad = dyad_id,
    member = person_id,
    time = time,
    predictors = c(x, z),
    lag1_predictors = x,
    model_types = "apim",
    seed = 123
  )

  expect_equal(result$row_id, data$row_id)
  expect_equal(result$.x_lag1, c(21, NA, NA, NA, NA, NA, 31, NA, 22, 32))

  prior_cwp <- result$.x_cwp[match(
    paste(result$dyad_id, result$person_id, result$time - 1),
    paste(result$dyad_id, result$person_id, result$time)
  )]
  expect_equal(result$.x_cwp_lag1, prior_cwp)
  expect_equal(result$.x_actor_lag1, result$.x_lag1)

  partner_id <- c(A = "B", B = "A", C = "D", D = "C")[result$person_id]
  expected_partner_lag <- result$.x_lag1[match(
    paste(result$dyad_id, result$time, partner_id),
    paste(result$dyad_id, result$time, result$person_id)
  )]
  expect_equal(result$.x_partner_lag1, expected_partner_lag)

  expect_false(any(grepl(".z.*lag1", names(result))))
  expect_false(any(grepl("cbp.*lag1", names(result))))
  expect_equal(attr(result, "dyadMLM")$lag1_predictors, "x")
  expect_equal(
    attr(result, "dyadMLM")$temporal_decompositions$lag,
    c(rep(0L, 6), 1L, 1L)
  )

  generated_lags <- dyad_generated_columns(attr(result, "dyadMLM")) |>
    dplyr::filter(.data$lag == 1L)
  expect_equal(
    generated_lags$column,
    c(
      ".x_lag1",
      ".x_cwp_lag1",
      ".x_actor_lag1",
      ".x_cwp_actor_lag1",
      ".x_partner_lag1",
      ".x_cwp_partner_lag1"
    )
  )

  printed <- capture.output(print(result, n = 1))
  expect_true(any(grepl(".{pred}_actor_lag1", printed, fixed = TRUE)))
  expect_true(any(grepl("lag-1 APIM actor predictor", printed, fixed = TRUE)))
})

test_that("lag predictors handle a missing row for one member", {
  data <- data.frame(
    dyad_id = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2),
    person_id = c("A", "B", "B", "A", "B", "C", "D", "C", "D", "C", "D"),
    time = c(1, 1, 2, 3, 3, 1, 1, 2, 2, 3, 3),
    x = c(10, 20, 21, 12, 22, 30, 40, 31, 41, 32, 42)
  )

  result <- prepare_dyad_data(
    data,
    dyad = dyad_id,
    member = person_id,
    time = time,
    predictors = x,
    lag1_predictors = x,
    model_types = "apim",
    seed = 123
  )

  member_a_time_3 <- result$dyad_id == 1 &
    result$person_id == "A" &
    result$time == 3

  expect_true(is.na(result$.x_actor_lag1[member_a_time_3]))
  expect_equal(result$.x_partner_lag1[member_a_time_3], 21)
})

test_that("lag predictors create DIM and DSM model-ready columns", {
  exchangeable <- data.frame(
    dyad_id = rep(1:2, each = 6),
    person_id = rep(c("A", "B"), 6),
    time = rep(rep(1:3, each = 2), 2),
    x = 1:12
  )

  dim_result <- prepare_dyad_data(
    exchangeable,
    dyad = dyad_id,
    member = person_id,
    time = time,
    predictors = x,
    lag1_predictors = x,
    model_types = "dim",
    seed = 123
  )

  expect_true(all(c(
    ".x_dyad_mean_gmc_lag1",
    ".x_within_dyad_dev_lag1",
    ".x_cwp_dyad_mean_lag1",
    ".x_cwp_within_dyad_dev_lag1"
  ) %in% names(dim_result)))
  expect_true(all(is.na(dim_result$.x_dyad_mean_gmc_lag1[dim_result$time == 1])))
  expect_equal(
    dim_result$.x_within_dyad_dev_lag1[dim_result$time > 1],
    rep(c(-0.5, 0.5), 4)
  )

  dim_generated_lags <- dyad_generated_columns(attr(dim_result, "dyadMLM")) |>
    dplyr::filter(.data$model_family == "dim", .data$lag == 1L) |>
    dplyr::select("component", "column_role", "column", "source_column") |>
    dplyr::arrange(.data$column)
  expect_equal(
    dim_generated_lags,
    tibble::tibble(
      component = c("cwp", "cwp", "raw", "raw"),
      column_role = c(
        "dyad_mean", "within_dyad_deviation",
        "dyad_mean", "within_dyad_deviation"
      ),
      column = c(
        ".x_cwp_dyad_mean_lag1",
        ".x_cwp_within_dyad_dev_lag1",
        ".x_dyad_mean_gmc_lag1",
        ".x_within_dyad_dev_lag1"
      ),
      source_column = c(
        ".x_cwp_lag1", ".x_cwp_lag1",
        ".x_lag1", ".x_lag1"
      )
    )
  )

  distinguishable <- dplyr::mutate(
    exchangeable,
    role = ifelse(.data$person_id == "A", "first", "second")
  )
  dsm_result <- prepare_dyad_data(
    distinguishable,
    dyad = dyad_id,
    member = person_id,
    role = role,
    time = time,
    predictors = x,
    lag1_predictors = x,
    model_types = "dsm",
    dsm_role_order = c("first", "second"),
    seed = 123
  )

  expect_true(all(c(
    ".x_dyad_mean_gmc_lag1",
    ".x_within_dyad_diff_lag1",
    ".x_cwp_dyad_mean_lag1",
    ".x_cwp_within_dyad_diff_lag1"
  ) %in% names(dsm_result)))
  expect_equal(
    dsm_result$.x_within_dyad_diff_lag1[dsm_result$time > 1],
    rep(-1, 8)
  )

  dsm_generated_lags <- dyad_generated_columns(attr(dsm_result, "dyadMLM")) |>
    dplyr::filter(.data$model_family == "dsm", .data$lag == 1L) |>
    dplyr::select("component", "column_role", "column", "source_column") |>
    dplyr::arrange(.data$column)
  expect_equal(
    dsm_generated_lags,
    tibble::tibble(
      component = c("cwp", "cwp", "raw", "raw"),
      column_role = c(
        "dyad_mean", "dyad_difference",
        "dyad_mean", "dyad_difference"
      ),
      column = c(
        ".x_cwp_dyad_mean_lag1",
        ".x_cwp_within_dyad_diff_lag1",
        ".x_dyad_mean_gmc_lag1",
        ".x_within_dyad_diff_lag1"
      ),
      source_column = c(
        ".x_cwp_lag1", ".x_cwp_lag1",
        ".x_lag1", ".x_lag1"
      )
    )
  )
})

test_that("lag predictors work without temporal centering", {
  data <- data.frame(
    dyad_id = rep(1:2, each = 4),
    person_id = rep(c("A", "B"), 4),
    time = rep(rep(1:2, each = 2), 2),
    x = letters[1:8]
  )

  result <- prepare_dyad_data(
    data,
    dyad = dyad_id,
    member = person_id,
    time = time,
    predictors = x,
    lag1_predictors = x,
    temporal_decomposition = "none",
    model_types = "apim",
    seed = 123
  )

  expect_equal(result$.x_lag1, c(NA, NA, "a", "b", NA, NA, "e", "f"))
  expect_equal(result$.x_actor_lag1, result$.x_lag1)
  expect_false(any(grepl("cwp.*lag1", names(result))))
})

test_that("a warning is given when all lag values are missing", {
  prepare_lagged <- function(data, ...) {
    prepare_dyad_data(
      data, dyad = dyad_id, member = person_id, time = time,
      predictors = x, lag1_predictors = x, seed = 123, ...
    )
  }

  # Waves two years apart: no observation at exactly `time - 1`.
  data <- data.frame(
    dyad_id = rep(1:2, each = 6),
    person_id = rep(c("A", "B", "C", "D"), each = 3),
    time = rep(c(2008, 2010, 2012), 4),
    x = 1:12
  )
  expect_warning(prepare_lagged(data), "All values of `.x_lag1`", fixed = TRUE)

  # Alternating members: lag values exist only on temporary rows for missed
  # occasions, which are removed before returning.
  alternating <- data.frame(
    dyad_id = rep(1:2, each = 4),
    person_id = c("A", "B", "A", "B", "C", "D", "C", "D"),
    time = rep(1:4, 2),
    x = 1:8
  )
  expect_warning(
    prepare_lagged(alternating, model_types = "none"),
    "All values of `.x_lag1`",
    fixed = TRUE
  )
})