tests/ROI.R

In ROI: R Optimization Infrastructure

Sys.setenv(ROI_LOAD_PLUGINS = FALSE)

library(slam)
library(ROI)

## ---------------------------
## Objective
## ---------------------------
test.L_objective <- function() {
    v <- 1:3
    m <- matrix(v, 1)
    slam <- as.simple_triplet_matrix(m)
    nam <- LETTERS[v]
    L_objective(v)
    L_objective(v, nam)
    L_objective(m)
    L_objective(m, nam)
    L_objective(slam)
    L_objective(slam, nam)
}

test.Q_objective <- function() {
    Lv <- 1:3
    Lm <- matrix(Lv, 1)
    Lslam <- as.simple_triplet_matrix(Lm)
    Qm <- diag(length(Lv))
    Qslam <- as.simple_triplet_matrix(Qm)
    nam <- LETTERS[Lv]
    Q_objective(Qm, Lv)
    Q_objective(Qm, Lm)
    Q_objective(Qm, Lslam)
    Q_objective(Qslam, Lv)
    Q_objective(Qslam, Lm)
    Q_objective(Qslam, Lslam)
    Q_objective(Qm, Lv, nam)
    Q_objective(Qm, Lm, nam)
    Q_objective(Qm, Lslam, nam)
    Q_objective(Qslam, Lv, nam)
    Q_objective(Qslam, Lm, nam)
    Q_objective(Qslam, Lslam, nam)
}

test.F_objective <- function() {
    F <- F_objective(sum, 3)
}

## ---------------------------
## Constraints
## ---------------------------
test.NO_constraint <- function() {
    NO_constraint(3)
}

test.L_constraint <- function() {
    L_constraint(matrix(1:3, 1), "==", 2, names=LETTERS[1:3])
}

test.Q_constraint <- function() {
    ## Q_constraint()   
}

test.C_constraint <- function() {
    ## C_constraint
}


## ---------------------------
## Types
## ---------------------------


## ---------------------------
## Bounds
## ---------------------------

## ---------------------------
## R-Methods
## ---------------------------
## rbind

## c
test.combine_L_constraints <- function() {
    dim_1 <- sample(1:10, 2)
    dim_2 <- c(sample(1:10, 1), dim_1[2])

    mat_1 <- matrix(sample(1:100, prod(dim_1)), ncol=dim_1[2])
    dir_1 <- sample(c("==", "<=", ">="), dim_1[1], replace=TRUE)
    rhs_1 <- sample(1:100, dim_1[1])

    mat_2 <- matrix(sample(1:100, prod(dim_2)), ncol=dim_2[2])
    dir_2 <- sample(c("==", "<=", ">="), dim_2[1], replace=TRUE)
    rhs_2 <- sample(1:100, dim_2[1])
    
    lc_1 <- L_constraint(L = mat_1, dir = dir_1, rhs = rhs_1)
    lc_2 <- L_constraint(L = mat_2, dir = dir_2, rhs = rhs_2)

    lc_3 <- rbind(lc_1, lc_2)
    stopifnot( ((nrow(lc_1) + nrow(lc_2)) == nrow(lc_3)) )
}

test.combine_F_constraints <- function() {
    fc1 <- F_constraint(F=function(x) x[1] + x[2]^2, ">=", 0,
                        J=function(x) c(1, 2*x[2]))
    fc2 <- F_constraint(F=function(x) x[1]^2 + x[2], ">=", 0,
                        J=function(x) c(2*x[1], x[2]))
    c(fc1, fc2)    
}

## as

## is

## G

## J

## variable.names


## ---------------------------
## test 
## ---------------------------
file = Sys.getenv("ROI_TEST_LOG_FILE")
ROI_TEST_ERRORS <- 0L
rt <- function(expr, silent = FALSE) {
    err <- try(expr, silent = silent)
    if ( inherits(err, "try-error") ) 
        ROI_TEST_ERRORS <<- ROI_TEST_ERRORS + 1L
    err
}

cat("# Constructors\n", file=file)
cat("## Objective\n", file=file)
cat("### L_objective\n", file=file)
rt( test.L_objective() )

cat("### Q_objective\n", file=file)
rt( test.Q_objective() )

cat("### F_objective\n", file=file)
rt( test.F_objective() )

cat("## Constraints\n", file=file)

cat("## Types\n", file=file)

cat("## Bounds\n", file=file)

cat("# R-Methods\n", file=file)

cat("## Combine\n", file=file)
cat("## Combine L_constraints\n", file=file)
rt( test.combine_L_constraints() )

if ( ROI_TEST_ERRORS ) {
    stop(ROI_TEST_ERRORS, " errors occured")
}