tests/testthat/test.R

In cornet: Elastic Net with Dichotomised Outcomes

# data simulation
set.seed(1)
list <- cornet:::.simulate(n=100,p=200)
y <- list$y; X <- list$X

# penalised regression
cutoff <- 1
foldid <- palasso:::.folds(y=y>cutoff,nfolds=10)
fit <- cornet::cornet(y=y,cutoff=cutoff,X=X,foldid=foldid)
net <- list()
net$gaussian <- glmnet::cv.glmnet(y=y,x=X,family="gaussian",foldid=foldid)
net$binomial <- glmnet::cv.glmnet(y=y>cutoff,x=X,family="binomial",foldid=foldid)

#--- cornet equals glmnet ---

for(dist in c("gaussian","binomial")){
  
  testthat::test_that("cross-validated loss",{
    a <- fit[[dist]]$cvm
    b <- net[[dist]]$cvm
    diff <- abs(a[seq_along(b)]-b)
    testthat::expect_true(all(diff<1e-06))
  })
  
  testthat::test_that("optimal lambda",{
    a <- fit[[dist]]$lambda.min
    b <- net[[dist]]$lambda.min
    testthat::expect_true(a==b)
  })
  
  testthat::test_that("lambda sequence",{
    a <- fit[[dist]]$lambda
    b <- net[[dist]]$lambda
    testthat::expect_true(all(a[seq_along(b)]==b))
  })
  
  testthat::test_that("predicted values",{
    a <- stats::predict(object=fit[[dist]],newx=X)
    b <- stats::predict(object=net[[dist]]$glmnet.fit,newx=X)
    testthat::expect_true(all(a==b))
  })
  
  testthat::test_that("coefficients",{
    a <- fit[[dist]]$beta
    b <- net[[dist]]$glmnet.fit$beta
    testthat::expect_true(all(a==b))
  })
  
}

#--- other checks ---

testthat::test_that("predicted probabilities",{ # important!
  a <- cornet:::predict.cornet(object=fit,newx=X)$binomial
  b <- as.numeric(stats::predict(object=net$binomial,newx=X,s="lambda.min",type="response"))
  testthat::expect_true(all(a==b))
})

testthat::test_that("estimated coefficients",{ # important!
  a <- cornet:::coef.cornet(fit)
  b <- as.numeric(stats::coef(object=net$gaussian,s="lambda.min"))
  c <- as.numeric(stats::coef(object=net$binomial,s="lambda.min"))
  cond <- all(a[,"beta"]==b) & all(a[,"gamma"]==c)
  testthat::expect_true(cond)
})

testthat::test_that("tuning parameters",{
  a <- (0 <= fit$sigma.min) & is.finite(fit$sigma.min)
  b <- (0 <= fit$pi.min) & (fit$pi.min <= 1)
  c <- min(fit$cvm) == fit$cvm[names(fit$sigma.min),names(fit$pi.min)]
  testthat::expect_true(all(a,b,c))
})

testthat::test_that("print function",{
  a <- cornet:::print.cornet(fit)
  testthat::expect_true(is.null(a))
})

testthat::test_that("plot function",{
  a <- cornet:::plot.cornet(fit)
  testthat::expect_true(is.null(a))
})

testthat::test_that("hidden compare function",{
  res <- cornet::cv.cornet(y=y,cutoff=cutoff,X=X,nfolds.ext=2)
  min <- min(unlist(res))
  testthat::expect_gte(object=min,expected=0)
  max <- max(unlist(res[c("class","mse","mae","auc")]))
  testthat::expect_lte(object=max,expected=1)
})

testthat::test_that("hidden test function",{
  p <- cornet:::.test(y=y,cutoff=cutoff,X=X)
  testthat::expect_gte(object=p$log,expected=0)
  testthat::expect_gte(object=p$lin,expected=0)
  testthat::expect_lte(object=p$log,expected=1)
  testthat::expect_lte(object=p$lin,expected=1)
})