tests/testthat/test-cp_thrs_LLS.R

In gspcr: Generalized Supervised Principal Component Regression

# Project:   gspcr
# Objective: Test cp_thrh_LLS
# Author:    Edoardo Costantini
# Created:   2023-04-17
# Modified:  2023-05-23
# Notes: 

# Define tolerance
tol <- 1e-5

# Test: function works on continuous outcomes ----------------------------------

# Use the function
thrs_LLS <- cp_thrs_LLS(
    dv = mtcars[, 1],
    ivs = mtcars[, -1],
    fam = "gaussian"
)

# Returns a numeric vector
testthat::expect_true(is.numeric(thrs_LLS))

# Negative values
testthat::expect_true(all(thrs_LLS < 0))

# The vector has the names of the predictors
testthat::expect_true(all.equal(names(thrs_LLS), colnames(mtcars[, -1])))

# Test: function works on binary factor outcomes -------------------------------

# Use the function
thrs_bin_LLS <- cp_thrs_LLS(
    dv = as.factor(mtcars[, 9]),
    ivs = mtcars[, -9],
    fam = "binomial"
)

# Returns a numeric vector
testthat::expect_true(is.numeric(thrs_bin_LLS))

# Negative values
testthat::expect_true(all(thrs_bin_LLS < 0))

# The vector has the names of the predictors
testthat::expect_true(all.equal(names(thrs_bin_LLS), colnames(mtcars[, -9])))

# Test: results independent of input scaling -----------------------------------

# Unscaled inputs
thrs_LLS <- cp_thrs_LLS(
    dv = GSPCRexdata$y$cont * 10 + 10,
    ivs = GSPCRexdata$X$cont,
    fam = "gaussian"
)

# Scaled X
thrs_LLS_scaled_X <- cp_thrs_LLS(
    dv = GSPCRexdata$y$cont * 10 + 10,
    ivs = scale(GSPCRexdata$X$cont),
    fam = "gaussian"
)

# Scaled y
thrs_LLS_sacled_y <- cp_thrs_LLS(
    dv = scale(GSPCRexdata$y$cont),
    ivs = GSPCRexdata$X$cont,
    fam = "gaussian"
)

# Scaled y and X
thrs_LLS_scaled_X_sacled_y <- cp_thrs_LLS(
    dv = scale(GSPCRexdata$y$cont),
    ivs = scale(GSPCRexdata$X$cont),
    fam = "gaussian"
)

# Perform tests
testthat::expect_true(all((thrs_LLS - thrs_LLS_scaled_X) < tol))
testthat::expect_true(all((thrs_LLS - thrs_LLS_sacled_y) < tol))
testthat::expect_true(all((thrs_LLS - thrs_LLS_scaled_X_sacled_y) < tol))