tests/testthat/test-plot_functions.R

In savvyPR: Savvy Parity Regression Model Estimation with 'savvyPR'

library(testthat)
library(savvyPR)
library(ggplot2)

set.seed(123)
n <- 50
p <- 5
base_var <- rnorm(n)
x <- matrix(rnorm(n * p, sd = 0.1), n, p) + base_var
beta <- matrix(rnorm(p + 1), p + 1, 1)
y <- cbind(1, x) %*% beta + rnorm(n, sd = 0.5)

expect_ggplot <- function(object) {
  expect_true(inherits(object, "ggplot"))
}

expect_gtable <- function(object) {
  expect_true(inherits(object, "gtable"))
}

test_that("plot for parity_model works with estimated coefficients with intercept", {
  result <- savvyPR(x, y, val = 0.05, intercept = TRUE)
  plot_output <- plot(result, plot_type = "estimated_coefficients", label = FALSE)
  expect_ggplot(plot_output)
})

test_that("plot for parity_model works with estimated coefficients without intercept", {
  result <- savvyPR(x, y, val = 0.05, intercept = FALSE)
  plot_output <- plot(result, plot_type = "estimated_coefficients", label = TRUE)
  expect_ggplot(plot_output)
})

test_that("plot_coefficients cannot work without coefficients", {
  result <- savvyPR(x, y, val = 0.05, intercept = TRUE)
  result$coefficients <- NULL
  expect_warning(plot_output <- plot(result, plot_type = "estimated_coefficients", label = TRUE),
                 "Coefficients are missing in the result.")
})

test_that("plot for parity_model works with risk contributions", {
  result <- savvyPR(x, y, val = 0.05, intercept = TRUE)
  plot_output <- plot(result, plot_type = "risk_contributions", label = TRUE)
  expect_gtable(plot_output)
})

test_that("plot for parity_model gives warning when risk contributions are unavailable", {
  result <- savvyPR(x, y, val = 0, intercept = TRUE)

  expect_warning(
    plot(result, plot_type = "risk_contributions", label = TRUE),
    "No 'orp_fit' found in the model. This usually occurs when the tuning parameter is 0. Cannot plot risk contributions.",
    fixed = TRUE
  )
})

test_that("plot for parity_model gives warning when optimization variables or 'relativeRiskContrib' are unavailable", {
  result <- savvyPR(x, y, val = 0.05, intercept = TRUE)
  result$orp_fit$weights <- rep(NA, length(result$orp_fit$weights))
  expect_warning(plot(result, plot_type = "risk_contributions", label = TRUE),
                 "Cannot generate risk contributions plot: optimization variables or 'relativeRiskContrib' contains NA values.")
})

test_that("plot for parity_cv_model works with estimated coefficients", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1", measure_type = "mse", intercept = TRUE)
  plot_output <- plot(result, plot_type = "estimated_coefficients", label = TRUE)
  expect_ggplot(plot_output)
})

test_that("plot for parity_model gives warning when risk contributions are unavailable", {
  result <- savvyPR(x, y, val = 0, intercept = TRUE)

  expect_warning(
    plot(result, plot_type = "risk_contributions", label = TRUE),
    "No 'orp_fit' found in the model. This usually occurs when the tuning parameter is 0. Cannot plot risk contributions.",
    fixed = TRUE
  )
})

test_that("plot for parity_cv_model works with risk contributions", {
  result <- cv.savvyPR(x, as.numeric(y),
                       method = "budget",
                       vals = seq(0.01, 0.1, length.out = 10),
                       folds = 5,
                       model_type = "PR1",
                       intercept = TRUE)
  expect_warning(
    plot_output <- plot(result, plot_type = "risk_contributions", label = TRUE),
    NA
  )
  expect_gtable(plot_output)
})

test_that("cv_errors handles missing mean_error_cv", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1")
  result$mean_error_cv <- NULL
  expect_error(plot(result, plot_type = "cv_errors", label = FALSE),
               "The input cv_results must contain mean cross-validation errors and optimal indices.")
})

test_that("cv_errors handles missing optimal_index", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1")
  result$optimal_index <- NULL
  expect_error(plot(result, plot_type = "cv_errors", label = TRUE),
               "The input cv_results must contain mean cross-validation errors and optimal indices.")
})

test_that("cv_errors handles missing vals for PR1 and PR2", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1")
  result$vals <- NULL
  expect_error(plot(result, plot_type = "cv_errors", label = FALSE),
               "vals must be provided in cv_results for model_type 'PR1' or 'PR2'.")
})

test_that("cv_errors handles missing lambda_vals for PR3", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR3")
  result$lambda_vals <- NULL
  expect_error(plot(result, plot_type = "cv_errors", label = TRUE),
               "lambda_vals must be provided in cv_results for model_type 'PR3'.")
})

measure_types <- c("mse", "mae", "rmse", "mape")

for (measure_type in measure_types) {
  test_that(paste("plot_cv_errors works for PR1 or PR2 when measure_type =", measure_type), {
    result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1", measure_type = measure_type)
    plot <- plot(result, plot_type = "cv_errors", label = TRUE)
    expect_ggplot(plot)
  })
}

for (measure_type in measure_types) {
  test_that(paste("plot_cv_errors works for PR3 when measure_type =", measure_type), {
    result <- cv.savvyPR(x, y, nlambda = 50,  folds = 5, model_type = "PR3", measure_type = measure_type)
    plot <- plot(result, plot_type = "cv_errors", label = TRUE)
    expect_ggplot(plot)
  })
}

test_that("plot for parity_cv_model works with cv_coefficients and PR1 with val", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1", measure_type = "mse", intercept = TRUE)
  plot_output <- plot(result, plot_type = "cv_coefficients", xvar = "val", max_vars_per_plot = 5, label = TRUE)

  expect_no_error(plot_output)
})

test_that("plot for parity_cv_model works with cv_coefficients and PR1 with norm", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1", measure_type = "mse", intercept = FALSE)
  plot_output <- plot(result, plot_type = "cv_coefficients", xvar = "norm", max_vars_per_plot = 5, label = TRUE)

  expect_no_error(plot_output)
})

test_that("plot for parity_cv_model works with cv_coefficients and PR1 with dev", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1", measure_type = "mse", intercept = TRUE)
  plot_output <- plot(result, plot_type = "cv_coefficients", xvar = "dev", max_vars_per_plot = 5, label = FALSE)

  expect_no_error(plot_output)
})

test_that("plot for parity_cv_model works with cv_coefficients and PR2 with val", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR2", measure_type = "mse", intercept = TRUE)
  plot_output <- plot(result, plot_type = "cv_coefficients", xvar = "val", max_vars_per_plot = 5, label = FALSE)

  expect_no_error(plot_output)
})

test_that("plot for parity_cv_model works with cv_coefficients and PR2 with norm", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR2", measure_type = "mse", intercept = FALSE)
  plot_output <- plot(result, plot_type = "cv_coefficients", xvar = "norm", max_vars_per_plot = 5, label = TRUE)

  expect_no_error(plot_output)
})

test_that("plot for parity_cv_model works with cv_coefficients and PR2 with dev", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR2", measure_type = "mse", intercept = TRUE)
  plot_output <- plot(result, plot_type = "cv_coefficients", xvar = "dev", max_vars_per_plot = 5, label = FALSE)

  expect_no_error(plot_output)
})

test_that("plot for parity_cv_model works with cv_coefficients and PR3 with lambda", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR3", measure_type = "mse", intercept = TRUE)
  plot_output <- plot(result, plot_type = "cv_coefficients", xvar = "lambda", max_vars_per_plot = 5, label = TRUE)

  expect_no_error(plot_output)
})

test_that("plot for parity_cv_model works with cv_coefficients and PR3 with norm", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR3", measure_type = "mse", intercept = FALSE)
  plot_output <- plot(result, plot_type = "cv_coefficients", xvar = "norm", max_vars_per_plot = 5, label = TRUE)

  expect_no_error(plot_output)
})

test_that("plot for parity_cv_model works with cv_coefficients and PR3 with dev", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR3", measure_type = "mse", intercept = TRUE)
  plot_output <- plot(result, plot_type = "cv_coefficients", xvar = "dev", max_vars_per_plot = 5, label = TRUE)

  expect_no_error(plot_output)
})

test_that("cv_coefficients fails for invalid model_type", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1")
  result$model_type <- "invalid"
  expect_error(plot(result, plot_type = "cv_coefficients", xvar = "norm"),
               "Invalid model_type or xvar combination.")
})

test_that("cv_coefficients fails for missing coefficient paths", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1")
  result$coefficients_cv <- NULL
  expect_error(plot(result, plot_type = "cv_coefficients", xvar = "norm"),
               "The input result_list must contain coefficient paths.")
})

test_that("cv_coefficients cannot exceed 10 variables per plot", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1")
  expect_warning(plot(result, plot_type = "cv_coefficients", xvar = "norm", max_vars_per_plot = 11),
                 "max_vars_per_plot cannot exceed 10. Setting max_vars_per_plot to 10.")
})

test_that("plot_cv_coefficients handles invalid combination PR1 with lambda", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1")
  expect_error(plot(result, plot_type = "cv_coefficients", xvar = "lambda", max_vars_per_plot = 10),
               "Invalid combination: PR1 and PR2 models cannot use 'lambda' as xvar.")
})

test_that("plot_cv_coefficients handles invalid combination PR3 with val", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR3")
  expect_error(plot(result, plot_type = "cv_coefficients", xvar = "val", max_vars_per_plot = 10),
               "Invalid combination: PR3 model cannot use 'val' as xvar.")
})

test_that("plot for parity_cv_model works with cv_errors", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1", measure_type = "mse", intercept = TRUE)
  plot_output <- plot(result, plot_type = "cv_errors", label = TRUE)
  expect_ggplot(plot_output)
})

test_that("plot for parity_model handles invalid plot_type", {
  result <- savvyPR(x, y, val = 0.05, intercept = TRUE)

  expect_error(
    plot(result, plot_type = "invalid_type"),
    "'arg' should be one of \"estimated_coefficients\", \"risk_contributions\""
  )
})

test_that("plot for parity_cv_model handles invalid plot_type", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1", measure_type = "mse", intercept = TRUE)

  # Expect an error when an invalid plot type is provided
  expect_error(
    plot(result, plot_type = "invalid_type"),
    "'arg' should be one of \"estimated_coefficients\", \"risk_contributions\", \"cv_coefficients\", \"cv_errors\""
  )
})

test_that("plot for parity_model handles missing coefficients", {
  result <- savvyPR(x, y, val = 0.05, intercept = TRUE)
  result$coefficients <- NULL
  expect_warning(plot(result, plot_type = "estimated_coefficients", label = TRUE),
                 "Coefficients are missing in the result.")
})

test_that("plot for parity_model handles missing risk parity fit", {
  result <- savvyPR(x, y, val = 0.05, intercept = TRUE)
  result$orp_fit <- NULL

  expect_warning(
    plot(result, plot_type = "risk_contributions", label = TRUE),
    "No 'orp_fit' found in the model. This usually occurs when the tuning parameter is 0. Cannot plot risk contributions.",
    fixed = TRUE
  )
})

test_that("plot for parity_cv_model handles missing mean_error_cv", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1")
  result$mean_error_cv <- NULL
  expect_error(plot(result, plot_type = "cv_errors"),
               "The input cv_results must contain mean cross-validation errors and optimal indices.")
})

test_that("plot for parity_cv_model handles missing coefficient paths", {
  result <- cv.savvyPR(x, y, folds = 5, model_type = "PR1")
  result$coefficients_cv <- NULL
  expect_error(plot(result, plot_type = "cv_coefficients"),
               "The input result_list must contain coefficient paths.")
})