checkDefaultMethod.R

#  checkDefaultMethod.R
#  FBA and friends with R.
#
#  Copyright (C) 2010-2014 Gabriel Gelius-Dietrich, Dpt. for Bioinformatics,
#  Institute for Informatics, Heinrich-Heine-University, Duesseldorf, Germany.
#  All right reserved.
#  Email: geliudie@uni-duesseldorf.de
#
#  This file is part of sybil.
#
#  Sybil is free software: you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation, either version 3 of the License, or
#  (at your option) any later version.
#
#  Sybil is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with sybil.  If not, see <http://www.gnu.org/licenses/>.


checkDefaultMethod <- function(solver, method, probType, loadPackage = TRUE) {

    stopifnot(is(solver, "character"),
              is(method, "character"),
              is(probType, "character"))

#    # -------------------------------------------------------------- #
#    # load solver package
#
#    if (isTRUE(loadPackage)) {
#        checkPackage <- require(solver, character.only = TRUE)
#    
#        if(!isTRUE(checkPackage)) {
#            stop("package ", sQuote(solver), " not found")
#        }
#    }

    # -------------------------------------------------------------- #
    # validate solver

    val_solver_ind <- match(solver, .SYBILenv$solvers)

    if (is.na(val_solver_ind)) {
        cmd <- paste(solver, ".onAttach()", sep = ":::")
        slv <- tryCatch(eval(parse(text = cmd)), error = function(e) e)
        if (isTRUE(slv)) {
            val_solver_ind <- match(solver, .SYBILenv$solvers)
        }

        if (is.na(val_solver_ind)) {
            val_solver_ind <- 1L
            warning("solver ", sQuote(solver),
                    " not found, using default: ",
                    sQuote(.SYBILenv$solvers[val_solver_ind]))
        }
    }

    val_solver <- .SYBILenv$solvers[val_solver_ind]


    # -------------------------------------------------------------- #
    # validate method

    val_method_ind <- match(method, .SYBILenv$solverMethods[[val_solver]])

    if (is.na(val_method_ind)) {
        val_method <- .SYBILenv$solverMethods[[val_solver]][1]
    }
    else {
        val_method <- .SYBILenv$solverMethods[[val_solver]][val_method_ind]
    }


    # -------------------------------------------------------------- #
    # validate method with problem type

    if (probType %in% names(.SYBILenv$ptype)) {
        if (val_solver %in% names(.SYBILenv$ptype[[probType]])) {
            meth_tmp <- match(val_method, .SYBILenv$ptype[[probType]][[val_solver]])
            if (is.na(meth_tmp)) {
                val_method <- .SYBILenv$ptype[[probType]][[val_solver]][1]
            }
        }
        else {
            stop("solver ", sQuote(val_solver),
                 " can not handle problems of type ", sQuote(probType))
        }
    }


    # -------------------------------------------------------------- #
    # solver parameters

    ctrl_parm <- .SYBILenv$solverCtrlParm[[val_solver]][[val_method]]

    if (is.null(ctrl_parm)) {
        ctrl_parm <- as.data.frame(NA)
    }


    # -------------------------------------------------------------- #
    # load solver package

    if (isTRUE(loadPackage)) {
        checkPackage <- require(val_solver, character.only = TRUE)
    
        if(!isTRUE(checkPackage)) {
            stop("package ", sQuote(val_solver), " not found")
        }
    }

    # -------------------------------------------------------------- #
    # done

    return(list(sol  = as.character(val_solver),
                met  = as.character(val_method),
                parm = ctrl_parm
           )
    )

}