Rsymphony/0000755000175100001440000000000013052645403012302 5ustar hornikusersRsymphony/src/0000755000175100001440000000000013052635726013100 5ustar hornikusersRsymphony/src/R_symphony.cc0000644000175100001440000000603013052635726015555 0ustar hornikusers/*-------------------------------------------------------------------------*/ /* This is an example of using SYMPHONY to construct and solve a simple MILP. Therefore 2 functions are defined which are prepared to be compiled as an shared object and then called by R with all the parameters that set up the linear problem. */ /*-------------------------------------------------------------------------*/ #include #include extern "C" { void R_symphony_solve(int *n_cols, int *n_rows, int *start, int *index, double *value, double *col_lb, double *col_ub, int* is_int, double *objective, double *obj2, char **row_sense, double *row_rhs, double *row_range, double *obj_final, double *sol_final, int *solve_status, int *verbosity, int *time_limit, int *node_limit, double *gap_limit, int *first_feasible, int *write_lp, int *write_mps ) { int i; /* Create a SYMPHONY environment */ sym_environment *env = sym_open_environment(); /* Set verbosity to desired level */ sym_set_int_param(env, "verbosity", *verbosity); /* Set if integer */ char * int_vars = (char *) malloc (sizeof(char) * (*n_cols)); for(i=0; i < (*n_cols); i++) if(is_int[i] == 1) int_vars[i] = TRUE; else int_vars[i] = FALSE; /* Load the problem in the symphony environment after all variables are set. */ sym_explicit_load_problem(env, *n_cols, *n_rows, start, index, value, col_lb, col_ub, int_vars, objective, NULL, *row_sense, row_rhs, row_range, TRUE); /* Set optimization parameters. */ if( *time_limit>0 ) sym_set_dbl_param(env, "time_limit", *time_limit); if( *node_limit>0 ) sym_set_int_param(env, "node_limit", *node_limit); if( *gap_limit>0 ) sym_set_dbl_param(env, "gap_limit", *gap_limit); sym_set_int_param(env, "find_first_feasible", *first_feasible); sym_set_int_param(env, "write_lp", *write_lp); sym_set_int_param(env, "write_mps", *write_mps); /* If SYMPHONY was compiled with OpenMP support, sym_solve() uses * omp_get_num_procs() to set max_active_nodes if unset (still -1), * resulting in segfaults if env var OMP_THREAD_LIMIT is set to * something smaller than the number of processors/cores. * Unfortunately, it seems there is no way to determine whether * SYMPHONY was compiled with OpenMP support (and hence re-set * max_active_nodes as necessary), so the best we can do is always * set max_active_nodes to 1 (turning off OpenMP parallelization). */ sym_set_int_param(env, "max_active_nodes", 1); /* Solve the integer program. */ sym_solve(env); /* Get the solution. */ double * solution = (double *) malloc (sizeof(double) * (*n_cols)); double objective_value = 0.0; sym_get_col_solution(env, solution); sym_get_obj_val(env, &objective_value); *obj_final = objective_value; for(i=0; i < (*n_cols); i++) sol_final[i] = solution[i]; *solve_status = sym_get_status(env); sym_close_environment(env); } } Rsymphony/src/Makevars.in0000644000175100001440000000014313052635726015177 0ustar hornikusersPKG_CPPFLAGS = @SYMPHONY_CPPFLAGS@ PKG_LIBS = @SYMPHONY_LIBS@ $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) Rsymphony/src/Makevars.win0000644000175100001440000000024713052635726015373 0ustar hornikusersSYMPHONY_LIBS = -lSym -lCgl -lOsiClp -lClp -lOsi -lCoinUtils -lz -fopenmp PKG_CPPFLAGS = -I$(SYMPHONY_HOME)/include PKG_LIBS = -L$(SYMPHONY_HOME)/lib $(SYMPHONY_LIBS) Rsymphony/src/init.c0000644000175100001440000000153413052635726014212 0ustar hornikusers#include #include #include void R_symphony_solve(int *n_cols, int *n_rows, int *start, int *index, double *value, double *col_lb, double *col_ub, int* is_int, double *objective, double *obj2, char **row_sense, double *row_rhs, double *row_range, double *obj_final, double *sol_final, int *solve_status, int *verbosity, int *time_limit, int *node_limit, double *gap_limit, int *first_feasible, int *write_lp, int *write_mps); static const R_CMethodDef CEntries[] = { {"R_symphony_solve", (DL_FUNC) &R_symphony_solve, 23}, {NULL, NULL, 0} }; void R_init_Rsymphony(DllInfo *dll) { R_registerRoutines(dll, CEntries, NULL, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } Rsymphony/NAMESPACE0000644000175100001440000000024713037364415013530 0ustar hornikusersuseDynLib("Rsymphony", .registration = TRUE) export("Rsymphony_solve_LP") S3method("make_csc_matrix", "matrix") S3method("make_csc_matrix", "simple_triplet_matrix") Rsymphony/R/0000755000175100001440000000000012761235555012514 5ustar hornikusersRsymphony/R/sparse.R0000644000175100001440000000262412761222714014131 0ustar hornikusers## Simple functions for converting "matrix" type objects into the ## sparse "column major order" (CSC, modulo offsets) format used by ## SYMPHONY. ## matind: vector of the row indices corresponding to each entry of ## value ## values: vector of the values of nonzero entries of the constraint ## matrix in column order. make_csc_matrix <- function(x) UseMethod("make_csc_matrix") make_csc_matrix.matrix <- function(x) { if(!is.matrix(x)) stop("Argument 'x' must be a matrix.") ind <- which(x != 0, arr.ind = TRUE) if(!length(ind)) { ## As of 2016-08-29, the above gives integer(0) instead of a ## matrix in case x has zero rows or cols, because x != 0 drops ## dimensions ... ind <- matrix(ind, 0L, 2L) } list(matbeg = c(0L, cumsum(tabulate(ind[, 2L], ncol(x)))), matind = ind[, 1] - 1L, values = x[ind]) } make_csc_matrix.simple_triplet_matrix <- function(x) { if(!inherits(x, "simple_triplet_matrix")) stop("Argument 'x' must be of class 'simple_triplet_matrix'.") ## The matrix method assumes that indices for non-zero entries are ## in row-major order, but the simple_triplet_matrix() constructor ## currently does not canonicalize accordingly ... ind <- order(x$j, x$i) list(matbeg = c(0L, cumsum(tabulate(x$j[ind], x$ncol))), matind = x$i[ind] - 1L, values = x$v[ind]) } Rsymphony/R/symphony.R0000644000175100001440000001175713037364440014531 0ustar hornikusersRsymphony_solve_LP <- function(obj, mat, dir, rhs, bounds = NULL, types = NULL, max = FALSE, verbosity = -2, time_limit = -1, node_limit = -1, gap_limit = -1, first_feasible = FALSE, write_lp = FALSE, write_mps = FALSE) { ## Direction of optimization. if(!identical(max, TRUE) && !identical(max, FALSE)) stop("'Argument 'max' must be either TRUE or FALSE.") ## Be nice. if(missing(mat) || is.null(mat)) mat <- matrix(0, 0L, length(obj)) if(missing(dir) || is.null(dir)) dir <- character() if(missing(rhs) || is.null(rhs)) rhs <- numeric() nr <- nrow(mat) nc <- ncol(mat) ## Sanity checking. if(length(obj) != nc) stop("Arguments 'obj' and 'mat' are not conformable.") if(length(dir) != nr) stop("Arguments 'mat' and 'dir' are not conformable.") if(length(rhs) != nr) stop("Arguments 'mat' and 'rhs' are not conformable.") ## Handle directions of constraints. TABLE <- c("L", "L", "E", "G", "G") names(TABLE) <- c('<', '<=', "==", ">", ">=") row_sense <- TABLE[dir] if(any(is.na(row_sense))) stop("Argument 'dir' must be one of '<', '<=', '>', '>=', or '=='.") ## Bounding support with using Rglpk bounds for the time being. bounds <- glp_bounds(as.list(bounds), nc) ## Use machine's max double values for infinities for the time being ## (as SYMPHONY does not know about IEEE 754 or C99 infinities). col_lb <- replace(bounds[, 2L], bounds[, 2L] == -Inf, -.Machine$double.xmax) col_ub <- replace(bounds[, 3L], bounds[, 3L] == Inf, .Machine$double.xmax) ## Note that the integer spec passed on is a vector of integer ## indicators, and that SYMPHONY has no native support for *binary* ## variables, so we pass treat these as integers <= 1. int <- if(is.null(types)) logical(nc) else { if(!is.character(types) || !all(types %in% c("C", "I", "B"))) stop("Invalid 'types' argument.") types <- rep(types, length.out = nc) col_ub[types == "B" & (col_ub > 1)] <- 1 types != "C" } ## If there are no non-zero elements in mat, the C code called ## segfaults in sym_close_environment(). Prevent this by adding a ## dummy variable. Argh. need_dummy <- all(mat == 0) if(need_dummy) { obj <- c(obj, 0) mat <- rbind(c(double(nc), 1)) row_sense <- "E" rhs <- 0 types <- c(types, "C") col_lb <- c(col_lb, 0) col_ub <- c(col_ub, 0) nr <- 1L nc <- length(obj) } mat <- make_csc_matrix(mat) ## Call the C interface. out <- .C(R_symphony_solve, as.integer(nc), as.integer(nr), as.integer(mat$matbeg), as.integer(mat$matind), as.double(mat$values), as.double(col_lb), as.double(col_ub), as.integer(int), if(max) as.double(-obj) else as.double(obj), obj2 = double(nc), as.character(paste(row_sense, collapse = "")), as.double(rhs), double(), objval = double(1L), solution = double(nc), status = integer(1L), verbosity = as.integer(verbosity), time_limit = as.integer(time_limit), node_limit = as.integer(node_limit), gap_limit = as.double(gap_limit), first_feasible = as.integer(first_feasible), write_lp = as.integer(write_lp), write_mps = as.integer(write_mps)) ## Ensure that integer variables are really integer: solution <- out$solution solution[int] <- round(solution[int]) if(need_dummy) { solution <- solution[-nc] obj <- obj[-nc] } status_db <- c("TM_NO_PROBLEM" = 225L, "TM_NO_SOLUTION" = 226L, "TM_OPTIMAL_SOLUTION_FOUND" = 227L, "TM_TIME_LIMIT_EXCEEDED" = 228L, "TM_NODE_LIMIT_EXCEEDED" = 229L, "TM_ITERATION_LIMIT_EXCEEDED" = 230L, "TM_TARGET_GAP_ACHIEVED" = 231L, "TM_FOUND_FIRST_FEASIBLE" = 232L, "TM_FINISHED" = 233L, "TM_UNFINISHED" = 234L, "TM_FEASIBLE_SOLUTION_FOUND" = 235L, "TM_SIGNAL_CAUGHT" = 236L, "TM_UNBOUNDED" = 237L, "PREP_OPTIMAL_SOLUTION_FOUND" = 238L, "PREP_NO_SOLUTION" = 239L, "TM_ERROR__NO_BRANCHING_CANDIDATE" = -250L, "TM_ERROR__ILLEGAL_RETURN_CODE" = -251L, "TM_ERROR__NUMERICAL_INSTABILITY" = -252L, "TM_ERROR__COMM_ERROR" = -253L, "TM_ERROR__USER" = -275L, "PREP_ERROR" = -276L) status <- if(out$status == 227L) c("TM_OPTIMAL_SOLUTION_FOUND" = 0L) else status_db[match(out$status, status_db)] list(solution = solution, objval = sum(obj * solution), ## Equivalently, ## if(max) - out$objval else out$objval status = status) } Rsymphony/R/bounds.R0000644000175100001440000000423613023463626014130 0ustar hornikusers## bounds of objective coefficients ## Rglpk bounding types for the time being ... glp_fix_bound_type <- function(x){ if(!inherits(x,"bound_table")) stop("'x' is not of class 'bound_table'") x$type <- ifelse(is.finite(x$lower), ifelse(is.finite(x$upper), 4L, 3L), ifelse(is.finite(x$upper), 2L, 1L)) x$type[x$upper==x$lower] <- 5L x } ## TODO: should be a generic function providing methods for ## different representations (e.g., a matrix, list of vectors, ...) ## glp_bounds <- function(x, n){ ## General input validation ##if(!is.list(x)) ## stop("Bounds have to be of type list") ## Initialize default matrix bound_table <- expand.grid(type=rep.int(2L,n), upper=0.0, lower=Inf) class(bound_table) <- c("bound_table", class(bound_table)) ## Lower bounds lower <- x$lower if(!is.null(lower)){ ## input validation glp_bounds_check_sanity(lower, n) if(any(lower[[1]]==Inf)) stop("Lower bound cannot be 'Inf'") ## if everything is OK set new lower bounds bound_table[lower[[1]],2] <- lower[[2]] } ## Upper bounds upper <- x$upper if(!is.null(upper)){ ## input validation glp_bounds_check_sanity(upper, n) if(any(upper[[1]]==-Inf)) stop("Upper bound cannot be '-Inf'") ## so far, the same as with lower bounds but in addition we have to be ## sure that upper bounds are greater than or equal to lower bounds if(any(bound_table[upper[[1]],2] > upper[[2]])) stop("Upper bounds have to be greater than or equal to lower bounds") bound_table[upper[[1]],3] <- upper[[2]] } ## Fix bound types out <- glp_fix_bound_type(bound_table) out } glp_bounds_check_sanity <- function(x, n){ if(!is.numeric(x[[1L]])) warning("Bound indices not numeric. Coercing to integers ...") x[[1L]] <- as.integer(x[[1L]]) if(length(x[[1]]) != length(x[[2]])) stop("Length of bound indices must be equal to the length of the corresponding bound values!") if(any(duplicated(x[[1]]))) stop("Duplicated entries in bound indices found!") if((any(x[[1]]) > n)) stop("Bound indices must not exceed number of objective coefficients!") } Rsymphony/MD50000644000175100001440000000115013052645403012607 0ustar hornikusersd29b703f39050319793313fa06df5c1d *DESCRIPTION 98bbbe4de0840eb5be78ed7000f6f98d *NAMESPACE b20fefaaf31f938721b136eb2fd39aaf *R/bounds.R c284500b54b5c13e083e999057c70b64 *R/sparse.R 02dc4a8cb3df78d884330c4ec236e970 *R/symphony.R 3d56c394530c4f14eb5213871ba5b1ac *cleanup b816ea6d4682f3789da3bff775aa922a *configure d41d8cd98f00b204e9800998ecf8427e *configure.win a93140f5020e7b59d1894f944100989e *man/Rsymphony_solve.Rd 764292063a596ca26fdcd99fd5de16c1 *src/Makevars.in 67cc5037504d878e1f2a0cb34ba6dea3 *src/Makevars.win 0587c3b991916e36647c5a97f49c878f *src/R_symphony.cc b885f312e212f1deab21d06a53b0689c *src/init.c Rsymphony/DESCRIPTION0000644000175100001440000000177313052645403014020 0ustar hornikusersPackage: Rsymphony Version: 0.1-26 Title: SYMPHONY in R Description: An R interface to the SYMPHONY solver for mixed-integer linear programs. Authors@R: c(person("Reinhard", "Harter", role = "aut"), person("Kurt", "Hornik", role = c("aut", "cre"), email = "Kurt.Hornik@R-project.org"), person("Stefan", "Theussl", role = "aut"), person("Cyrille", "Szymanski", role = "ctb", email = "cnszym@gmail.com")) License: EPL Depends: R (>= 2.6.0) Enhances: slam SystemRequirements: SYMPHONY libraries and headers URL: http://R-Forge.R-project.org/projects/rsymphony, https://projects.coin-or.org/SYMPHONY, http://www.coin-or.org/download/source/SYMPHONY/ NeedsCompilation: yes Packaged: 2017-02-20 18:56:22 UTC; hornik Author: Reinhard Harter [aut], Kurt Hornik [aut, cre], Stefan Theussl [aut], Cyrille Szymanski [ctb] Maintainer: Kurt Hornik Repository: CRAN Date/Publication: 2017-02-20 21:01:07 Rsymphony/configure0000755000175100001440000000313412532341265014213 0ustar hornikusers#! /bin/sh ## For the time being, this is a simple shell script ... ## Test whether a complete SYMPHONY library environment is available, ## e.g. https://projects.coin-or.org/CoinBinary. ## Find the R home directory. : ${R_HOME=`R RHOME`} if test -z "${R_HOME}"; then echo "Could not determine R_HOME." exit 1 fi R="${R_HOME}/bin/R" : ${PKG_CONFIG="pkg-config"} version=`${PKG_CONFIG} --version 2>/dev/null` if test -n "${version}"; then if `${PKG_CONFIG} --exists SYMPHONY`; then SYMPHONY_CPPFLAGS=`${PKG_CONFIG} --cflags SYMPHONY` SYMPHONY_LIBS=`${PKG_CONFIG} --libs SYMPHONY` elif `${PKG_CONFIG} --exists symphony`; then ## As of 2014-09-20, Debian testing/unstable has symphony.pc. SYMPHONY_CPPFLAGS=`${PKG_CONFIG} --cflags symphony` SYMPHONY_LIBS=`${PKG_CONFIG} --libs symphony` fi fi test -z "${SYMPHONY_LIBS}" && \ SYMPHONY_LIBS="-lSym -lCgl -lOsiClp -lClp -lOsi -lCoinUtils" ## Test whether we can compile and link a minimal program. rm -f conftest.* cat > conftest.cc < extern "C" int main () { sym_environment *env = sym_open_environment(); sym_close_environment(env); return 0; } EOF _R_SHLIB_BUILD_OBJECTS_SYMBOL_TABLES_=false ${R} CMD SHLIB conftest.cc ${SYMPHONY_CPPFLAGS} ${SYMPHONY_LIBS} >/dev/null 2>&1 status=${?} rm -f conftest.* if test ${status} -ne 0; then echo "Cannot find SYMPHONY libraries and headers." echo "See ." exit 1 fi sed -e "s|@SYMPHONY_CPPFLAGS@|${SYMPHONY_CPPFLAGS}|" \ -e "s|@SYMPHONY_LIBS@|${SYMPHONY_LIBS}|" \ src/Makevars.in > src/Makevars exit 0 Rsymphony/man/0000755000175100001440000000000012213264216013052 5ustar hornikusersRsymphony/man/Rsymphony_solve.Rd0000644000175100001440000001212712276501241016565 0ustar hornikusers\name{Rsymphony_solve_LP} \alias{Rsymphony_solve_LP} \title{COIN-OR SYMPHONY Linear and Mixed Integer Programming Solver} \description{ High level R interface to the COIN-OR SYMPHONY solver for linear as well as mixed integer linear programming problems (MILPs). } \usage{ Rsymphony_solve_LP(obj, mat, dir, rhs, bounds = NULL, types = NULL, max = FALSE, verbosity = -2, time_limit = -1, node_limit = -1, gap_limit = -1, first_feasible = FALSE, write_lp = FALSE, write_mps = FALSE) } \arguments{ \item{obj}{a vector with the objective coefficients} \item{mat}{a vector or a matrix of the constraint coefficients} \item{dir}{a character vector with the directions of the constraints. Each element must be one of \code{"<"}, \code{"<="}, \code{">"}, \code{">="}, \code{"=="} or \code{"!="}.} \item{rhs}{the right hand side of the constraints} \item{bounds}{\code{NULL} (default) or a list with elements \code{upper} and \code{lower} containing the indices and corresponding bounds of the objective variables. The default for each variable is a bound between 0 and \code{Inf}.} \item{types}{a character vector giving the types of the objective variables, with \code{"C"}, \code{"I"}, and \code{"B"} corresponding to continuous, integer, and binary, respectively, or \code{NULL} (default), taken as all-continuous. Recycled as needed.} \item{max}{a logical giving the direction of the optimization. \code{TRUE} means that the objective is to maximize the objective function, \code{FALSE} (default) means to minimize it.} \item{verbosity}{an integer defining the level of verbosity, \code{-2} (default) means no output.} \item{time_limit}{an integer defining the time limit in seconds, \code{-1} (default) means no time limit.} \item{node_limit}{an integer defining the limit in number of iterations, \code{-1} (default) means no node limit.} \item{gap_limit}{when the gap between the lower and the upper bound reaches this point, the solution process will stop and the best solution found to that point will be returned, \code{-1} (default) means no gap limit.} \item{first_feasible}{a logical defining if the solution process should stop after the first feasible solution has been found, \code{FALSE} (default) means that the solution process does not stop after the first feasible solution has been found.} \item{write_lp}{a logical value indicating if an LP representation of the problem should be written for debugging purposes, \code{FALSE} (default) means no LP file is written.} \item{write_mps}{a logical value indicating if an MPS representation of the problem should be written for debugging purposes, \code{FALSE} (default) means no MPS file is written.} } \details{ SYMPHONY is an open source solver for solving mixed integer linear programs (MILPs). The current version can be found at \url{https://projects.coin-or.org/SYMPHONY}. Package \pkg{Rsymphony} uses the C interface of the callable library provided by SYMPHONY, and supplies a high level solver function in R using the low level C interface. } \value{ A list containing the optimal solution, with the following components. \item{solution}{the vector of optimal coefficients} \item{objval}{the value of the objective function at the optimum} \item{status}{an integer with status information about the solution returned: 0 if the optimal solution was found, a non-zero value otherwise.} } \references{ SYMPHONY development home page (\url{https://projects.coin-or.org/SYMPHONY/wiki}). } \author{ Reinhard Harter, Kurt Hornik and Stefan Theussl } \seealso{ \code{\link[lpSolve]{lp}} in package \pkg{lpSolve}; \code{\link[Rglpk]{Rglpk_solve_LP}} in package \pkg{Rglpk}. } \examples{ ## Simple linear program. ## maximize: 2 x_1 + 4 x_2 + 3 x_3 ## subject to: 3 x_1 + 4 x_2 + 2 x_3 <= 60 ## 2 x_1 + x_2 + x_3 <= 40 ## x_1 + 3 x_2 + 2 x_3 <= 80 ## x_1, x_2, x_3 are non-negative real numbers obj <- c(2, 4, 3) mat <- matrix(c(3, 2, 1, 4, 1, 3, 2, 1, 2), nrow = 3) dir <- c("<=", "<=", "<=") rhs <- c(60, 40, 80) max <- TRUE Rsymphony_solve_LP(obj, mat, dir, rhs, max = max) ## Simple mixed integer linear program. ## maximize: 3 x_1 + 1 x_2 + 3 x_3 ## subject to: -1 x_1 + 2 x_2 + x_3 <= 4 ## 4 x_2 - 3 x_3 <= 2 ## x_1 - 3 x_2 + 2 x_3 <= 3 ## x_1, x_3 are non-negative integers ## x_2 is a non-negative real number obj <- c(3, 1, 3) mat <- matrix(c(-1, 0, 1, 2, 4, -3, 1, -3, 2), nrow = 3) dir <- c("<=", "<=", "<=") rhs <- c(4, 2, 3) max <- TRUE types <- c("I", "C", "I") Rsymphony_solve_LP(obj, mat, dir, rhs, types = types, max = max) ## Same as before but with bounds replaced by ## -Inf < x_1 <= 4 ## 0 <= x_2 <= 100 ## 2 <= x_3 < Inf bounds <- list(lower = list(ind = c(1L, 3L), val = c(-Inf, 2)), upper = list(ind = c(1L, 2L), val = c(4, 100))) Rsymphony_solve_LP(obj, mat, dir, rhs, types = types, max = max, bounds = bounds) } \keyword{optimize} Rsymphony/configure.win0000644000175100001440000000000012205716253014771 0ustar hornikusersRsymphony/cleanup0000755000175100001440000000007512454167002013660 0ustar hornikusers#! /bin/sh rm -f config.* autom4te.cache src/Makevars exit 0