test-rwa.R
In rwa: Perform a Relative Weights Analysis

# ============================================================================
# Tests for rwa() function
# ============================================================================

# --- Test fixtures and helpers ----------------------------------------------

# Helper to create test data with specific characteristics
create_test_data <- function() {
  test_data <- mtcars
  test_data$gear_factor <- as.factor(test_data$gear)
  test_data$car_name <- rownames(mtcars)
  test_data$constant <- 5
  test_data$cyl_doubled <- test_data$cyl * 2
  test_data$mpg_factor <- as.factor(ifelse(test_data$mpg > 20, "high", "low"))
  test_data
}

# --- Basic functionality ----------------------------------------------------

test_that("rwa() returns correct structure", {
  result <- rwa(mtcars, outcome = "mpg", predictors = c("cyl", "hp"))
  
  expect_type(result, "list")
  expect_named(result, c("predictors", "rsquare", "result", "n", "lambda", "RXX", "RXY"))
  expect_s3_class(result$result, "data.frame")
  expect_named(result$result, c("Variables", "Raw.RelWeight", "Rescaled.RelWeight", "Sign"))
})

test_that("rwa() computes correct weights", {
  result <- rwa(mtcars, outcome = "mpg", predictors = c("cyl", "hp"))
  
  # Rescaled weights sum to 100
  expect_equal(sum(result$result$Rescaled.RelWeight), 100, tolerance = 1e-10)
  
  # Raw weights sum to R-squared
  expect_equal(sum(result$result$Raw.RelWeight), result$rsquare, tolerance = 1e-10)
  
  # R-squared is valid
  expect_gte(result$rsquare, 0)
  expect_lte(result$rsquare, 1)
})

test_that("rwa() returns correct predictors and sample size", {
  result <- rwa(mtcars, outcome = "mpg", predictors = c("cyl", "hp"))
  
  expect_equal(result$predictors, c("cyl", "hp"))
  expect_equal(nrow(result$result), 2)
  expect_type(result$n, "integer")
  expect_equal(result$n, nrow(mtcars))
})

test_that("rwa() produces reproducible results", {
  result1 <- rwa(mtcars, outcome = "mpg", predictors = c("cyl", "hp"))
  result2 <- rwa(mtcars, outcome = "mpg", predictors = c("cyl", "hp"))
  
  expect_equal(result1$result, result2$result)
  expect_equal(result1$rsquare, result2$rsquare)
})

test_that("rwa() handles single predictor", {
  result <- rwa(mtcars, outcome = "mpg", predictors = "cyl")
  
  expect_equal(nrow(result$result), 1)
  expect_equal(result$result$Rescaled.RelWeight, 100, tolerance = 1e-10)
})

test_that("rwa() handles missing data by listwise deletion", {
  mtcars_na <- mtcars
  mtcars_na$mpg[1:3] <- NA
  
  result <- rwa(mtcars_na, outcome = "mpg", predictors = c("cyl", "hp"))
  
  expect_equal(result$n, nrow(mtcars) - 3)
})

# --- Sorting behavior -------------------------------------------------------

test_that("rwa() sorts results by default", {
  result <- rwa(mtcars, outcome = "mpg", predictors = c("cyl", "hp", "wt"))
  weights <- result$result$Rescaled.RelWeight
  
  # Should be in descending order
  expect_true(all(diff(weights) <= 0))
})

test_that("rwa() preserves predictor order when sort = FALSE", {
  result <- rwa(mtcars, outcome = "mpg", predictors = c("cyl", "hp", "wt"), sort = FALSE)
  
  expect_equal(result$result$Variables, c("cyl", "hp", "wt"))
})

test_that("rwa() returns same values regardless of predictor order when sorted", {
  result1 <- rwa(mtcars, outcome = "mpg", predictors = c("cyl", "hp"), sort = TRUE)
  result2 <- rwa(mtcars, outcome = "mpg", predictors = c("hp", "cyl"), sort = TRUE)
  
  expect_equal(result1$result, result2$result)
})

# --- Sign application -------------------------------------------------------

test_that("rwa() does not include signed weights by default", {
  result <- rwa(mtcars, outcome = "mpg", predictors = c("cyl", "hp"))
  
  expect_false("Sign.Rescaled.RelWeight" %in% names(result$result))
})

test_that("rwa() applies signs correctly when applysigns = TRUE", {
  result <- rwa(mtcars, outcome = "mpg", predictors = c("cyl", "hp"), applysigns = TRUE)
  
  expect_true("Sign.Rescaled.RelWeight" %in% names(result$result))
  expect_type(result$result$Sign.Rescaled.RelWeight, "double")
  
  # Positive relationships keep positive values
  positive_vars <- result$result$Sign == "+"
  if (any(positive_vars)) {
    expect_equal(
      result$result$Rescaled.RelWeight[positive_vars],
      result$result$Sign.Rescaled.RelWeight[positive_vars]
    )
  }
  
  # Negative relationships get negative values
  negative_vars <- result$result$Sign == "-"
  if (any(negative_vars)) {
    expect_equal(
      -result$result$Rescaled.RelWeight[negative_vars],
      result$result$Sign.Rescaled.RelWeight[negative_vars]
    )
  }
})

# --- Bootstrap functionality ------------------------------------------------

test_that("rwa() runs bootstrap analysis when requested", {
  skip_on_cran()
  
  result <- rwa(mtcars, outcome = "mpg", predictors = c("cyl", "hp"),
                bootstrap = TRUE, n_bootstrap = 100)
  
  expect_true("bootstrap" %in% names(result))
  expect_type(result$bootstrap, "list")
  
  # CI columns added to results
  expect_true(all(c("Raw.RelWeight.CI.Lower", "Raw.RelWeight.CI.Upper", "Raw.Significant") 
                  %in% names(result$result)))
  
  # CI bounds are logical
  expect_true(all(result$result$Raw.RelWeight.CI.Lower <= result$result$Raw.RelWeight.CI.Upper))
  expect_type(result$result$Raw.Significant, "logical")
})

# --- Input validation: Parameter types --------------------------------------

test_that("rwa() validates conf_level parameter", {
  expect_error(rwa(mtcars, "mpg", "cyl", conf_level = 0), "conf_level")
  expect_error(rwa(mtcars, "mpg", "cyl", conf_level = 1), "conf_level")
  expect_error(rwa(mtcars, "mpg", "cyl", conf_level = -0.5), "conf_level")
  expect_error(rwa(mtcars, "mpg", "cyl", conf_level = 1.5), "conf_level")
  expect_error(rwa(mtcars, "mpg", "cyl", conf_level = "high"), "conf_level")
})

test_that("rwa() validates n_bootstrap parameter", {
  expect_error(rwa(mtcars, "mpg", "cyl", n_bootstrap = 0), "n_bootstrap")
  expect_error(rwa(mtcars, "mpg", "cyl", n_bootstrap = -10), "n_bootstrap")
  expect_error(rwa(mtcars, "mpg", "cyl", n_bootstrap = 10.5), "n_bootstrap")
  expect_error(rwa(mtcars, "mpg", "cyl", n_bootstrap = "many"), "n_bootstrap")
})

# --- Input validation: Variable existence -----------------------------------

test_that("rwa() errors for non-existent outcome variable", {
  expect_error(
    rwa(mtcars, outcome = "nonexistent", predictors = c("cyl", "hp")),
    "Outcome variable.*not found"
  )
})

test_that("rwa() errors for non-existent predictor variables", {
  expect_error(
    rwa(mtcars, outcome = "mpg", predictors = c("cyl", "nonexistent")),
    "Predictor variable.*not found.*nonexistent"
  )
  
  expect_error(
    rwa(mtcars, outcome = "mpg", predictors = c("fake1", "fake2")),
    "Predictor variable.*not found.*fake1.*fake2"
  )
})

# --- Input validation: Variable types ---------------------------------------

test_that("rwa() errors for non-numeric outcome", {
  test_data <- create_test_data()
  
  expect_error(
    rwa(test_data, outcome = "mpg_factor", predictors = c("cyl", "hp")),
    "Outcome variable.*must be numeric"
  )
})

test_that("rwa() errors for non-numeric predictors", {
  test_data <- create_test_data()
  
  expect_error(
    rwa(test_data, outcome = "mpg", predictors = c("cyl", "gear_factor")),
    "must be numeric.*gear_factor"
  )
  
  expect_error(
    rwa(test_data, outcome = "mpg", predictors = c("cyl", "car_name")),
    "must be numeric.*car_name"
  )
})

# --- Input validation: Data quality -----------------------------------------

test_that("rwa() errors for zero-variance outcome", {
  test_data <- create_test_data()
  
  expect_error(
    rwa(test_data, outcome = "constant", predictors = c("cyl", "hp")),
    "zero variance"
  )
})

test_that("rwa() errors for zero-variance predictor", {
  test_data <- create_test_data()
  
  expect_error(
    rwa(test_data, outcome = "mpg", predictors = c("cyl", "constant")),
    "zero variance.*constant"
  )
})

test_that("rwa() errors for perfectly collinear predictors", {
  test_data <- create_test_data()
  
  expect_error(
    rwa(test_data, outcome = "mpg", predictors = c("cyl", "cyl_doubled")),
    "singular|collinearity"
  )
})

test_that("rwa() handles small but valid samples", {
  small_data <- mtcars[1:10, ]
  
  expect_no_error(
    rwa(small_data, outcome = "mpg", predictors = c("cyl", "hp"))
  )
})

test_that("rwa() errors for samples too small to compute correlations", {
  very_small_data <- mtcars[1:3, ]
  
  expect_error(
    rwa(very_small_data, outcome = "mpg", predictors = c("cyl", "hp")),
    "singular|collinearity|zero variance"
  )
})