inst/tinytest/test-solveQPXT.R

In quadprogXT: Quadratic Programming with Absolute Value Constraints

library(quadprogXT)

N <- 10
set.seed(2)
cr <- matrix(runif(N * N, 0, .05), N, N)
diag(cr) <- 1
cr <- (cr + t(cr)) / 2
set.seed(3)
sigs <- runif(N, min = .02, max = .25)
set.seed(5)

dvec <- runif(N, -.1, .1)
Dmat <- sigs %o% sigs * cr
Amat <- cbind(diag(N), diag(N) * -1)
bvec <- c(rep(-1, N), rep(-1, N))

#solveQPXT(Dmat, dvec, Amat, bvec)

resBase <- solveQPXT(Dmat, dvec, Amat, bvec)

res <- solveQPXT(Dmat, dvec, Amat, bvec, AmatPosNeg = matrix(rep(-1, 2 * N)), bvecPosNeg = -1)
expect_true(
    sum(abs(res$solution[1:N])) <= 1 + 1e-10,
    info = "QPXT returns expected results for sum of absolute values <= 1 example"
)

resL1Penalty <- solveQPXT(Dmat, dvec, Amat, bvec, dvecPosNeg = -.005 * rep(1, 2 * N))
expect_true(
    sum(abs(resL1Penalty$solution[1:N]))  < sum(abs(resBase$solution)),
    info = "QPXT still handles case where dvecPosNeg is not null (L1 norm penalty)"
)

b0 <- rep(.15, N)
thresh <- .25
res <- solveQPXT(Dmat, dvec, Amat, bvec, b0 = b0,
                 AmatPosNegDelta = matrix(rep(-1, 2 * N)), bvecPosNegDelta = -thresh)
expect_true(
    sum(abs(res$solution[1:N] - b0)) <= thresh + 1e-10,
    info = "QPXT handles absolute changes in decision variable"
)

res <- solveQPXT(Dmat, dvec, Amat = NULL, bvec = NULL, AmatPosNeg = matrix(rep(-1, 2 * N)), bvecPosNeg = -1)
expect_true(
    sum(abs(res$solution[1:N])) <= 1 + 1e-10,
    info = "QPXT allows a null Amat IF other constraints are passed"
)

res <- try(solveQPXT(
    Dmat,
    dvec,
    Amat = Amat,
    bvec = bvec,
    AmatPosNeg = matrix(rep(-1, 2 * N)),
    bvecPosNeg = -1,
    AmatPosNegDelta = matrix(rep(-1, 2 * N)),
    bvecPosNegDelta = -.25,
    b0 = rep(.08, N)
))
expect_false(
    inherits(res, "try-error"),
    info = "QPXT works with full problem size"
)

args <- list(
    Dmat = Dmat,
    dvec = dvec,
    Amat = Amat,
    bvec = bvec,
    AmatPosNeg = matrix(rep(-1, 2 * N)),
    bvecPosNeg = -1,
    AmatPosNegDelta = matrix(rep(-1, 2 * N)),
    bvecPosNegDelta = -.25,
    dvecPosNeg = rep(-.005, 2 * N),
    dvecPosNegDelta = rep(-.0005, 2 * N),
    b0 = rep(.08, N)
)

expect_false(
    inherits(do.call(solveQPXT, args), "try-error"),
    info = "QPXT works with full problem size & specified dvecs"
)


res <- do.call(solveQPXT, args)
args2 <- args
args2$factorized <- TRUE
args2$Dmat <- solve(chol(args2$Dmat))
res2 <- do.call(solveQPXT, args2)
expect_equal(
    res, res2,
    info = "QPXT works with a factorized Dmat"
)