tests/testthat/test_prox_fused_lasso.R

In DataSlingers/MoMA: MoMA - Modern Multivariate Analysis in R

context("Ordered Fused lasso tests")

test_that("A numeric example: Ordered fused lasso should return correct values under different lambdas", {
    set.seed(34)
    x <- 10 * runif(10)
    # result generated by flsa
    # These lambdas are the knots where merges happen.

    # library(flsa)
    # flsa::flsaTopDown(x)
    goal <- matrix(c(
        4.447685, 5.447685, 6.447685, 6.760676, 6.427343, 6.094010, 5.760676, 5.612593, 5.612593, 5.612593, 5.612593,
        9.985404, 8.417172, 7.417172, 6.760676, 6.427343, 6.094010, 5.760676, 5.612593, 5.612593, 5.612593, 5.612593,
        8.848940, 8.417172, 7.417172, 6.760676, 6.427343, 6.094010, 5.760676, 5.612593, 5.612593, 5.612593, 5.612593,
        2.384260, 3.328699, 4.328699, 5.120557, 5.263415, 5.406272, 5.549129, 5.612593, 5.612593, 5.612593, 5.612593,
        2.273138, 3.328699, 4.328699, 5.120557, 5.263415, 5.406272, 5.549129, 5.612593, 5.612593, 5.612593, 5.612593,
        8.477694, 6.477694, 5.237301, 5.120557, 5.263415, 5.406272, 5.549129, 5.612593, 5.612593, 5.612593, 5.612593,
        2.825617, 4.825617, 5.237301, 5.120557, 5.263415, 5.406272, 5.549129, 5.612593, 5.612593, 5.612593, 5.612593,
        7.176086, 5.294398, 5.237301, 5.120557, 5.263415, 5.406272, 5.549129, 5.612593, 5.612593, 5.612593, 5.612593,
        3.960512, 5.294398, 5.237301, 5.120557, 5.263415, 5.406272, 5.549129, 5.612593, 5.612593, 5.612593, 5.612593,
        5.746595, 5.294398, 5.237301, 5.120557, 5.263415, 5.406272, 5.549129, 5.612593, 5.612593, 5.612593, 5.612593
    ),
    nrow = 10,
    byrow = T
    )
    lambdas <- seq(0, 10, 1)
    for (l in 1:10) {
        expect_lte(norm(test_prox_fusedlassopath(x, lambdas[l]) - matrix(goal[, l], nrow = 10)), 1e-5)
    }
})

test_that("Equals to mean when lambda is large enough", {
    l <- 1e+100
    set.seed(34)
    for (i in 1000) {
        x <- 10 * runif(10)
        proxed.x <- test_prox_fusedlassopath(x, l)
        for (i in 1:9) {
            expect_equal(proxed.x[i], proxed.x[i + 1])
        }
        expect_equal(mean(x), proxed.x[1])
    }
})

test_that("Same results as the `flsa` package", {
    set.seed(43)
    if (requireNamespace("flsa")) {
        library(flsa)

        # Problem size ranging from 2 to 200
        for (p in seq(2, 200, 10)) {
            # Repeat 10 times
            for (i in 1:10) {
                x <- 10 * runif(p)
                # Penalty levels
                for (lambda in seq(0, 5, 0.5)) {
                    expect_equal(
                        test_prox_fusedlassopath(x, lambda),
                        t(flsa::flsaGetSolution(flsa::flsa(x), lambda2 = lambda))
                    )
                }
            }
        }
    }
})

test_that("DP approach should give the same results as the `flsa` package", {
    set.seed(43)
    if (requireNamespace("flsa")) {
        library(flsa)

        # Problem size ranging from 2 to 200
        for (p in seq(2, 200, 10)) {
            # Repeat 10 times
            for (i in 1:10) {
                x <- 10 * runif(p)
                # Penalty levels
                for (lambda in seq(0, 5, 0.5)) {
                    expect_equal(
                        test_prox_fusedlassodp(x, lambda),
                        t(flsa::flsaGetSolution(flsa::flsa(x), lambda2 = lambda))
                    )
                    if (lambda == 5) {
                        # make sure we test the entire path
                        expect(sum(abs(test_prox_fusedlassodp(x, lambda))), 0)
                    }
                }
            }
        }
    }
})

test_that("Test DP approach buffer size", {
    set.seed(43)
    if (requireNamespace("flsa")) {
        library(flsa)
        lambda <- 1
        # Problem size
        for (p in c(10000000)) {
            # Repeat 10 times
            for (i in 1:10) {
                x <- 10 * runif(p)
                # Path algorithm takes 10 seconds to solve each.
                # DP takes 0.5 seconds.
                expect_equal(
                    test_prox_fusedlassodp(x, lambda),
                    test_prox_fusedlassopath(x, lambda)
                )
            }
        }
    }
})