tests/testthat/test-plot-functions.R

In cvCovEst: Cross-Validated Covariance Matrix Estimation

library(future.apply)
library(MASS)
set.seed(123)

# generate a 50x50 covariance matrix with unit variances and off-diagonal
# elements equal to 0.5
Sigma <- matrix(0.5, nrow = 50, ncol = 50) + diag(0.5, nrow = 50)

# sample 200 observations from multivariate normal with mean = 0, var = Sigma
dat <- mvrnorm(n = 200, mu = rep(0, 50), Sigma = Sigma)

estimator_params <- list(
  poetEst = list( # 3 x 3 different indexed hyperparameters
    lambda = c(0.01, 0.05, 0.1),
    k = c(1L, 3L, 5L)
  ),
  adaptiveLassoEst = list( # 2 x 1 indexed hyperparameters
    lambda = c(0.01, 0.1),
    n = c(2L, 3L)
  ),
  linearShrinkEst = list( # 2 different indexed hyperparameters
    alpha = c(0.1, 0.9)
  ),
  bandingEst = list( # 1 indexed hyperparameter
    k = 2L
  )
)

# All with hypers
cvTestH <- cvCovEst(
  dat = dat,
  estimators = c(
    poetEst,
    adaptiveLassoEst,
    linearShrinkEst,
    bandingEst
  ),
  estimator_params = estimator_params,
  cv_scheme = "v_fold",
  cv_loss = cvMatrixFrobeniusLoss,
  v_folds = 5,
  parallel = FALSE,
  center = TRUE,
  scale = TRUE
)

# With one no hyper
cvTestNH <- cvCovEst(
  dat = dat,
  estimators = c(
    nlShrinkLWEst,
    bandingEst
  ),
  estimator_params = estimator_params,
  cv_scheme = "v_fold",
  cv_loss = cvMatrixFrobeniusLoss,
  v_folds = 5,
  parallel = FALSE,
  center = TRUE,
  scale = TRUE
)

has_hypers <- c(
  "linearShrinkEst", "thresholdingEst", "bandingEst", "taperingEst",
  "scadEst", "poetEst", "robustPoetEst", "adaptiveLassoEst"
)

# Class Test
test_that("Objects of other known classes throw an error", {
  # cvCovEst class
  expect_s3_class(cvTestH, "cvCovEst")
  expect_silent(
    summary(cvTestH, dat)
  )
  expect_silent(
    cvTestH %>% summary(dat_orig = dat)
  )
  # different class
  class(cvTestH) <- "lm"
  expect_error(
    summary(cvTestH, dat)
  )
  expect_error(
    cvTestH %>% summary(dat_orig = dat)
  )
  # other object disguised as cvCovEst object
  disguise <- c("disguise")
  class(disguise) <- "cvCovEst"
  expect_error(
    summary(disguise, dat_orig = dat)
  )
})

test_that("Only current implemented summary functions are allowed", {
  expect_silent(
    summary(cvTestH, dat, summ_fun = "bestInClass")
  )
  expect_error(
    summary(cvTestH, dat, summ_fun = "other")
  )
})

test_that("Only supported summary statistics are allowed for plotting", {
  expect_silent(
    cvMultiMelt(
      dat = cvTestH,
      estimator = c("poetEst"),
      stat = c("min"),
      dat_orig = dat,
      cv_details = "",
      has_hypers = has_hypers
    )
  )
  expect_error(
    suppressWarnings(
      cvMultiMelt(
        dat = cvTestH,
        estimator = c("poetEst"),
        stat = c("mean"),
        dat_orig = dat,
        cv_details = "",
        has_hypers = has_hypers
      )
    )
  )
})

test_that("Valid estimator arguments are passed to plotting functions", {
  # Non-cvCovEst estimator
  expect_error(
    cvMultiMelt(
      dat = cvTestH,
      estimator = c("linearShrinkEst", "other"),
      stat = c("min"),
      dat_orig = dat,
      cv_details = "",
      has_hypers = has_hypers
    )
  )
  # Estimator not originally called to cvCovEst()
  expect_error(
    cvMultiMelt(
      dat = cvTestH,
      estimator = c("poetEst", "scadEst"),
      stat = c("min"),
      dat_orig = dat,
      cv_details = "",
      has_hypers = has_hypers
    )
  )
  # Multiple plots of the same estimator
  expect_error(
    cvMultiMelt(
      dat = cvTestH,
      estimator = c("nlShrinkLWEst"),
      stat = c("min", "max"),
      dat_orig = dat,
      cv_details = "",
      has_hypers = has_hypers
    )
  )
})

test_that("Indexing by only 1 hyperparameter throws an error in risk plot", {
  expect_error(
    plot.cvCovEst(
      x = cvTestH,
      dat_orig = dat,
      estimator = "bandingEst",
      plot_type = "risk"
    )
  )
})

test_that("Calling risk plot for non-hyper estimator throws an error", {
  expect_error(
    plot.cvCovEst(
      x = cvTestNH,
      dat_orig = dat,
      estimator = "nlShrinkLWEst",
      plot_type = "risk"
    )
  )
})

test_that("Calling for multiple stats for non-hyper estimator gets a message", {
  expect_message(
    plot.cvCovEst(
      x = cvTestNH,
      dat_orig = dat,
      estimator = "nlShrinkLWEst",
      plot_type = "eigen",
      k = 50,
      stat = c("min", "max")
    )
  )
})

test_that("Plotting only works if estimator was passed to cvCovEst", {
  expect_error(
    plot.cvCovEst(
      x = cvTestH,
      dat_orig = dat,
      estimator = "nlShrinkLWEst",
      plot_type = "eigen",
      k = 50,
      stat = c("min")
    )
  )
})

test_that("Asking for more k than exist throws an error", {
  expect_error(
    plot.cvCovEst(
      x = cvTestH,
      dat_orig = dat,
      estimator = "linearShrinkEst",
      plot_type = "eigen",
      k = 51,
      stat = c("min")
    )
  )
})

test_that("Plot method throws other errors where appropriate", {
  expect_message(
    plot.cvCovEst(
      x = cvTestH,
      dat_orig = dat,
      estimator = c("linearShrinkEst"),
      plot_type = ("summary")
    )
  )
})