tests/testthat/test-vctrs.R

In panelr: Regression Models and Utilities for Repeated Measures and Panel Data

context("vctrs integration")

library(panelr)
library(dplyr)

data("WageData")
w <- panel_data(WageData, id = id, wave = t)

# --- vec_restore tests ---
test_that("vec_restore preserves panel_data after vctrs::vec_slice", {
  sliced <- vctrs::vec_slice(w, 1:100)
  expect_s3_class(sliced, "panel_data")
  expect_equal(get_id(sliced), get_id(w))
  expect_equal(get_wave(sliced), get_wave(w))
})

test_that("vec_restore falls back to tibble when id column removed", {
  # Create a data frame without the id column
  no_id <- unpanel(w)[, names(w) != "id"]
  restored <- vctrs::vec_restore(no_id, w)
  expect_s3_class(restored, "tbl_df")
  expect_false(inherits(restored, "panel_data"))
})

test_that("vec_restore falls back to tibble when wave column removed", {
  # Create a data frame without the wave column  
  no_wave <- unpanel(w)[, names(w) != "t"]
  restored <- vctrs::vec_restore(no_wave, w)
  expect_s3_class(restored, "tbl_df")
  expect_false(inherits(restored, "panel_data"))
})

# --- vec_rbind tests ---
test_that("vec_rbind combines panel_data objects", {
  w1 <- filter(w, id %in% levels(id)[1:5])
  w2 <- filter(w, id %in% levels(id)[6:10])
  combined <- vctrs::vec_rbind(w1, w2)
  expect_s3_class(combined, "panel_data")
  expect_equal(get_id(combined), get_id(w))
  expect_equal(get_wave(combined), get_wave(w))
})

test_that("vec_rbind with panel_data and tibble returns panel_data", {
  w_small <- filter(w, id %in% levels(id)[1:3])
  tbl_small <- tibble::as_tibble(filter(w, id %in% levels(id)[4:5]))
  combined <- vctrs::vec_rbind(w_small, tbl_small)
  expect_s3_class(combined, "panel_data")
})

# --- vec_c tests ---
test_that("vec_c combines panel_data objects", {
  tiny <- tibble::tibble(
    id = rep(c("1", "2"), each = 2),
    t = rep(1:2, times = 2),
    x = 1:4
  )
  w_small <- panel_data(tiny, id = id, wave = t)
  w1 <- filter(w_small, id == "1")
  w2 <- filter(w_small, id == "2")
  combined <- vctrs::vec_c(w1, w2)
  expect_s3_class(combined, "panel_data")
})

# --- build_panel_data tests ---
test_that("build_panel_data creates panel_data with correct attributes", {
  df <- tibble::as_tibble(w)
  built <- panelr:::build_panel_data(df, id = "id", wave = "t", 
                                      periods = 1:7)
  expect_s3_class(built, "panel_data")
  expect_equal(get_id(built), "id")
  expect_equal(get_wave(built), "t")
  expect_equal(get_periods(built), 1:7)
})

test_that("build_panel_data preserves optional attributes", {
  df <- tibble::as_tibble(w)
  built <- panelr:::build_panel_data(df, id = "id", wave = "t",
                                      periods = 1:7, reshaped = TRUE,
                                      varying = c("lwage", "wks"),
                                      constants = c("fem", "blk"))
  expect_true(attr(built, "reshaped"))
  expect_equal(attr(built, "varying"), c("lwage", "wks"))
  expect_equal(attr(built, "constants"), c("fem", "blk"))
})

# --- Attribute preservation tests ---
test_that("attributes preserved through mutate", {
  w_with_attrs <- w
  attr(w_with_attrs, "reshaped") <- TRUE
  attr(w_with_attrs, "varying") <- c("lwage")
  
  mutated <- mutate(w_with_attrs, new_var = lwage * 2)
  expect_true(attr(mutated, "reshaped"))
  expect_equal(attr(mutated, "varying"), c("lwage"))
})

test_that("attributes preserved through filter", {
  w_with_attrs <- w
  attr(w_with_attrs, "reshaped") <- TRUE
  
  filtered <- filter(w_with_attrs, fem == 1)
  expect_true(attr(filtered, "reshaped"))
})

test_that("attributes preserved through select", {
  w_with_attrs <- w
  attr(w_with_attrs, "varying") <- c("lwage", "wks")
  
  selected <- select(w_with_attrs, id, t, lwage)
  expect_equal(attr(selected, "varying"), c("lwage", "wks"))
})

# --- Performance sanity check ---
test_that("vec_restore is faster than full panel_data construction", {
  # This is a sanity check, not a strict benchmark
  df <- tibble::as_tibble(w)
  
  # Time vec_restore
  t1 <- system.time({
    for (i in 1:100) {
      vctrs::vec_restore(df, w)
    }
  })
  
  # Time full panel_data
  t2 <- system.time({
    for (i in 1:100) {
      panel_data(df, id = id, wave = t)
    }
  })
  
  # vec_restore should be faster (we allow some margin for noise)
  # This test documents the expected behavior but won't fail on timing
  expect_true(TRUE)  # Just document that we tested this
})