tests/testthat/test-robust-solve.R

In did2s: Two-Stage Difference-in-Differences Following Gardner (2021)

test_that("robust_solve_XtX works with well-conditioned matrices", {
  # Create a well-conditioned design matrix
  set.seed(123)
  n <- 100
  k <- 5
  X <- Matrix::Matrix(rnorm(n * k), n, k)
  Y <- rnorm(n)

  # Test against direct solve (should be identical for well-conditioned case)
  # Convert to base R matrices to avoid Matrix package solve issues in tests
  X_base <- as.matrix(X)
  XtX <- crossprod(X_base)
  XtY <- crossprod(X_base, Y)
  beta_direct <- as.numeric(solve(XtX, XtY))
  beta_robust <- as.numeric(did2s:::robust_solve_XtX(X, Y))

  expect_equal(beta_robust, beta_direct, tolerance = 1e-10)

  # Test fitted values match
  fitted_direct <- as.numeric(X %*% beta_direct)
  fitted_robust <- as.numeric(X %*% beta_robust)

  expect_equal(fitted_robust, fitted_direct, tolerance = 1e-10)
})

test_that("robust_solve_XtX handles rank-deficient matrices", {
  # Create a rank-deficient matrix (column 3 = column 1 + column 2)
  set.seed(123)
  n <- 50
  X1 <- rnorm(n)
  X2 <- rnorm(n)
  X3 <- X1 + X2 # Perfect collinearity
  X <- Matrix::Matrix(cbind(X1, X2, X3))
  Y <- 1 * X1 + 2 * X2 + rnorm(n)

  # Direct solve should fail or give unreliable results
  expect_error(
    solve(Matrix::crossprod(X), Matrix::crossprod(X, Y)),
    class = "simpleError"
  )

  # Robust solve should work (may have 0s for rank-deficient columns)
  beta_robust <- did2s:::robust_solve_XtX(X, Y)
  expect_true(all(is.finite(beta_robust))) # Should all be finite after NA replacement

  # Fitted values should be reasonable
  fitted_robust <- X %*% beta_robust
  expect_true(all(is.finite(fitted_robust)))
  expect_equal(length(fitted_robust), n)

  # The fitted values should be the same whether we use the rank-deficient or full-rank matrix
  # because the redundant column should have coefficient 0
  X_reduced <- X[, 1:2] # Remove rank-deficient column
  beta_reduced <- did2s:::robust_solve_XtX(X_reduced, Y)
  fitted_reduced <- X_reduced %*% beta_reduced

  expect_equal(
    as.numeric(fitted_robust),
    as.numeric(fitted_reduced),
    tolerance = 1e-10
  )
})

test_that("robust_solve_XtX matches fixest::feols fitted values", {
  # Create test data similar to did2s usage
  set.seed(123)
  n <- 200
  data <- data.frame(
    unit = rep(1:50, each = 4),
    time = rep(1:4, 50),
    x1 = rnorm(n),
    x2 = rnorm(n),
    y = rnorm(n)
  )

  # Add perfect collinearity to test rank deficiency
  data$x3 <- data$x1 + 2 * data$x2

  # Create design matrix using fixest::sparse_model_matrix
  # This mimics how the matrix is created in did2s
  feols_fit <- fixest::feols(
    y ~ x1 + x2 + x3 | unit + time,
    data = data,
    warn = FALSE
  )
  X <- fixest::sparse_model_matrix(feols_fit, type = c("rhs", "fixef"))
  Y <- data$y

  # Test our robust solver
  beta_robust <- did2s:::robust_solve_XtX(X, Y)
  fitted_robust <- X %*% beta_robust

  # Compare against fixest fitted values
  fitted_feols <- fitted(feols_fit)

  # Fitted values should be very close (allowing for numerical differences)
  expect_equal(
    as.numeric(fitted_robust),
    as.numeric(fitted_feols),
    tolerance = 1e-8
  )
})

test_that("robust_solve_XtX works with sparse matrices", {
  # Create a sparse design matrix
  set.seed(123)
  n <- 100
  k <- 20

  # Create sparse matrix with many zeros
  X_dense <- matrix(rnorm(n * k), n, k)
  X_dense[abs(X_dense) < 1.5] <- 0 # Make many elements zero
  X <- Matrix::Matrix(X_dense, sparse = TRUE)
  Y <- rnorm(n)

  # Should work with sparse matrices
  beta_robust <- did2s:::robust_solve_XtX(X, Y)
  expect_true(all(is.finite(beta_robust)))

  # Test fitted values
  fitted_robust <- X %*% beta_robust
  expect_equal(length(fitted_robust), n)
  expect_true(all(is.finite(fitted_robust)))
})

test_that("robust_solve_XtX handles edge cases", {
  # Test with single column
  set.seed(123)
  n <- 50
  X <- Matrix::Matrix(rnorm(n), n, 1)
  Y <- rnorm(n)

  beta_robust <- did2s:::robust_solve_XtX(X, Y)
  expect_equal(length(beta_robust), 1)
  expect_true(all(is.finite(beta_robust)))

  # Test with wide matrix (more columns than rows)
  n <- 20
  k <- 25
  X <- Matrix::Matrix(rnorm(n * k), n, k)
  Y <- rnorm(n)

  beta_robust <- did2s:::robust_solve_XtX(X, Y)
  expect_equal(length(beta_robust), k)
  expect_true(all(is.finite(beta_robust)))

  # Fitted values should still work
  fitted <- X %*% beta_robust
  expect_equal(length(fitted), n)
})

test_that("robust_solve_XtX preserves mathematical properties", {
  # Test that the solution satisfies normal equations when possible
  set.seed(123)
  n <- 100
  k <- 5
  X <- Matrix::Matrix(rnorm(n * k), n, k)
  Y <- rnorm(n)

  beta_robust <- did2s:::robust_solve_XtX(X, Y)

  # Check normal equations: X'X beta = X'Y
  # For well-conditioned case, this should hold precisely
  lhs <- Matrix::crossprod(X) %*% beta_robust
  rhs <- Matrix::crossprod(X, Y)

  expect_equal(as.numeric(lhs), as.numeric(rhs), tolerance = 1e-10)
})