tests/testthat/test-predict-plot.R

In qcluster: Clustering via Quadratic Scoring

test_that("predict fails early on non Gaussian-ready parameters", {
  dat <- matrix(
    c(
      0, 0,
      1, 1,
      2, 2
    ),
    ncol = 2,
    byrow = TRUE
  )
  params <- clust2params(dat, c(1, 1, 2))
  obj <- structure(
    list(
      info = list(code = 1),
      P = 2L,
      params = params
    ),
    class = "mbcfit"
  )

  expect_error(
    predict(obj, dat),
    "invalid mixture parameters|Gaussian-ready parameters"
  )
})

test_that("plot_clustering drops invalid Gaussian layers but still plots clustering", {
  dat <- matrix(
    c(
      0, 0,
      1, 1,
      2, 2
    ),
    ncol = 2,
    byrow = TRUE
  )
  cluster <- c(1, 1, 2)
  params <- clust2params(dat, cluster)
  path <- tempfile(fileext = ".pdf")

  grDevices::pdf(path)
  on.exit({
    grDevices::dev.off()
    unlink(path)
  }, add = TRUE)

  warning_msg <- NULL
  expect_no_error(
    withCallingHandlers(
      plot_clustering(dat,
        cluster = cluster,
        params = params,
        what = c("clustering", "contour", "boundary")
      ),
      warning = function(w) {
        warning_msg <<- conditionMessage(w)
        invokeRestart("muffleWarning")
      }
    )
  )
  expect_false(is.null(warning_msg))
})

test_that("plot_clustering errors when only invalid Gaussian layers are requested", {
  dat <- matrix(
    c(
      0, 0,
      1, 1,
      2, 2
    ),
    ncol = 2,
    byrow = TRUE
  )
  params <- clust2params(dat, c(1, 1, 2))
  path <- tempfile(fileext = ".pdf")

  grDevices::pdf(path)
  on.exit({
    grDevices::dev.off()
    unlink(path)
  }, add = TRUE)

  warning_seen <- FALSE
  expect_error(
    withCallingHandlers(
      plot_clustering(dat, params = params, what = c("contour", "boundary")),
      warning = function(w) {
        warning_seen <<- TRUE
        invokeRestart("muffleWarning")
      }
    ),
    "None of the requested plot features can be computed"
  )
  expect_true(warning_seen)
})