tests/testthat/test-multinomial.R

In SLOPE: Sorted L1 Penalized Estimation

test_that("glmnet and SLOPE return same unpenalized model", {
  # Fixed predictors
  x1 <- c(
    1.2, -0.5, 0.8, -1.1, 0.3, 1.5, -0.2, 0.7, -0.9, 0.4,
    0.1, -1.3, 0.6, -0.7, 1.1, -0.4, 0.9, -1.0, 0.5, -0.8
  )
  x2 <- c(
    -0.3, 0.7, -1.2, 0.4, -0.8, 0.2, -0.5, 1.1, -0.9, 0.6,
    -1.0, 0.3, -0.7, 0.8, -0.4, 1.3, -0.6, 0.5, -1.1, 0.9
  )

  # Fixed response (deliberately creating a pattern)
  y <- c(
    1, 2, 3, 1, 2, 3, 1, 2, 3, 1,
    2, 3, 1, 2, 3, 1, 2, 3, 1, 2
  )

  x <- scale(cbind(x1, x2))
  y <- factor(y)

  g_coef <- structure(c(
    0.201106343886854, 0.286875567305304, 0.395516767951309,
    0.175083912785424, 0.200156047570187, 0.631090659835371
  ), dim = 3:2, dimnames = list(
    c("", "x1", "x2"), c("1", "2")
  ))

  ofit <- SLOPE(x, y, family = "multinomial", alpha = 1e-9)
  coefs <- as.matrix(do.call(cbind, coef(ofit)))

  expect_equivalent(g_coef, coefs, tol = 1e-4)
})

test_that("score works for multinomial data subsets with missing classes", {
  fit <- SLOPE(wine$x, wine$y, family = "multinomial", path_length = 5)

  s1 <- score(fit, x = wine$x[1:100, ], y = wine$y[1:100])
  s2 <- score(fit, x = wine$x[1:178, ], y = wine$y[1:178])
  s3 <- score(fit, x = wine$x[131:178, ], y = wine$y[131:178])

  expect_length(s1, 5)
  expect_length(s2, 5)
  expect_length(s3, 5)

  expect_true(all(is.finite(s1)))
  expect_true(all(is.finite(s2)))
  expect_true(all(is.finite(s3)))
})