Commit d1fce4bc authored by Dirk Eddelbuettel's avatar Dirk Eddelbuettel

New upstream version 0.6-4

parent c8fc62ec
Package: Rglpk
Version: 0.6-3
Version: 0.6-4
Title: R/GNU Linear Programming Kit Interface
Description: R interface to the GNU Linear Programming Kit.
'GLPK' is open source software for solving large-scale linear programming (LP),
......@@ -12,7 +12,7 @@ License: GPL-2 | GPL-3
URL: http://R-Forge.R-project.org/projects/rglp/,
http://www.gnu.org/software/glpk/
NeedsCompilation: yes
Packaged: 2017-05-17 15:18:10 UTC; theussl
Packaged: 2019-02-08 18:08:20 UTC; theussl
Author: Stefan Theussl [aut, cre],
Kurt Hornik [aut],
Christian Buchta [ctb],
......@@ -20,4 +20,4 @@ Author: Stefan Theussl [aut, cre],
Heinrich Schuchardt [ctb]
Maintainer: Stefan Theussl <Stefan.Theussl@R-project.org>
Repository: CRAN
Date/Publication: 2017-05-18 08:38:23 UTC
Date/Publication: 2019-02-09 15:33:16 UTC
3490dabdc75f47ddd04a8d441af3be0f *DESCRIPTION
94364d8a598862015d942f46e9239923 *DESCRIPTION
c189bd36df502d339b7e65f37af00e68 *NAMESPACE
89802f16b53ebb2fb07679fb89ac7b33 *R/Misc.R
def7f7e44c84e689f6ff76b0b716088f *R/Rglpk_solve.R
82dffa9e471498d1f75ab7f1ab642094 *R/Rglpk_solve.R
8d3fb2da5d74e556691bae64d3cb2956 *R/Rglpk_write_file.R
b00f4925068f332a7e0800c41af35e67 *R/bounds.R
1697e847ac1d653ac49b23e7393d758c *R/control.R
......@@ -11,7 +11,7 @@ f8672da398fee3461bded8d8de6cec02 *R/milp.R
5299c161b149974ccae263af06494afc *cleanup
1262f7a12fddb89ebbe29f58c04a1c00 *configure
68b329da9893e34099c7d8ad5cb9c940 *configure.win
bdc6fa8965d45c6c5a220c7875a5c075 *inst/CHANGELOG
859d229a12a713e478109c16fcb563b0 *inst/CHANGELOG
bdee58c3965c7b68c5923ee60183e736 *inst/examples/assign.mod
72aa9eab3996ee9aa7abeaeb4c05ff12 *inst/examples/plan.lp
45e60857cbfdfb15805eb12cc2e17d94 *inst/examples/plan.mod
......@@ -19,10 +19,11 @@ bdee58c3965c7b68c5923ee60183e736 *inst/examples/assign.mod
9e22c38d5268676761f77a2c82020cf8 *man/Rglpk_read_file.Rd
93bffd67a6bfff9018c00eb9391f8655 *man/Rglpk_solve.Rd
16928375c376f342565f9f81b85aff65 *src/Makevars.in
82b5dfd7323f3bba9c092029c5ee25d7 *src/Makevars.win
d50d4b23dbc4186a94e9f35690f432d8 *src/Makevars.win
00cf4d6bd6d46443d99cb7ebe5b53403 *src/Rglpk.h
52bc8e948dd2a9d1d5a5105c3780aa3e *src/Rglpk_error.c
5622e753d3d13b4bf264756073cbc667 *src/Rglpk_initialize.c
a15e81302d0243a630ab6b57fc8af160 *src/Rglpk_read_file.c
8c36cc4c822ec150aab37adcf0f8adce *src/Rglpk_solve.c
b16d6b2bd9db79e3bbe30a670a57d96b *src/init.c
d0cfe01c4b3c56bb1aa49fcf610083cd *src/Rglpk_solve.c
495714bd2c2150de16cc53d0ff2ef8da *src/init.c
eef9d8be634a20d7a8b6a6abe1825d7c *tests/test.R
......@@ -12,11 +12,16 @@ Rglpk_solve_LP <- function(obj, mat, dir, rhs, bounds = NULL, types = NULL, max
presolve <- control$presolve
time_limit <- control$tm_limit
verb <- control$verbose
sensitivity_report <- isTRUE(control$sensitivity_report)
Rglpk_call( obj = obj, mat = mat, dir = dir, rhs = rhs, bounds = bounds, types = types, max = max, canonicalize_status = canonicalize_status, presolve = presolve, time_limit = time_limit, verb = verb )
Rglpk_call( obj = obj, mat = mat, dir = dir, rhs = rhs, bounds = bounds,
types = types, max = max, canonicalize_status = canonicalize_status,
presolve = presolve, time_limit = time_limit, verb = verb,
sensitivity_report = sensitivity_report)
}
Rglpk_call <- function(obj, mat, dir, rhs, bounds, types, max, canonicalize_status, presolve, time_limit, verb, file = "", file_type = 0L ){
Rglpk_call <- function(obj, mat, dir, rhs, bounds, types, max, canonicalize_status,
presolve, time_limit, verb, file = "", file_type = 0L, sensitivity_report = FALSE) {
## validate direction of optimization
if(!identical( max, TRUE ) && !identical( max, FALSE ))
stop("'Argument 'max' must be either TRUE or FALSE.")
......@@ -55,6 +60,10 @@ Rglpk_call <- function(obj, mat, dir, rhs, bounds, types, max, canonicalize_stat
## do we have a mixed integer linear program?
is_integer <- any( binaries | integers )
if ( sensitivity_report & is_integer ) {
stop("GLPK does not support sensitivity analysis report for mixed integer problems")
}
## bounds of objective coefficients
bounds <- as.glp_bounds( as.list( bounds ), n_of_objective_vars )
......@@ -84,6 +93,14 @@ Rglpk_call <- function(obj, mat, dir, rhs, bounds, types, max, canonicalize_stat
direction_of_optimization <- 0L
}
if (sensitivity_report) {
write_sensitivity_report <- 1L
fname_sensitivity_report <- tempfile()
} else {
write_sensitivity_report <- 0L
fname_sensitivity_report <- ""
}
## call the C interface - this actually runs the solver
x <- glp_call_interface(obj, n_of_objective_vars, constraint_matrix$i,
constraint_matrix$j, constraint_matrix$v,
......@@ -93,28 +110,30 @@ Rglpk_call <- function(obj, mat, dir, rhs, bounds, types, max, canonicalize_stat
integers, binaries,
direction_of_optimization, bounds[, 1L],
bounds[, 2L], bounds[, 3L], verb, presolve, time_limit,
file_type, file)
file_type, file, write_sensitivity_report, fname_sensitivity_report)
solution <- x$lp_objective_vars_values
## are integer variables really integers? better round values
solution[integers | binaries] <-
round( solution[integers | binaries])
solution[integers | binaries] <- round( solution[integers | binaries])
## match status of solution
status <- as.integer(x$lp_status)
if(canonicalize_status){
## 0 -> optimal solution (5 in GLPK) else 1
status <- as.integer(status != 5L)
if(canonicalize_status) {
## 0 -> optimal solution (5 in GLPK) else 1
status <- as.integer(status != 5L)
}
list(optimum = sum(solution * obj), solution = solution, status = status,
solution_dual = if( is_integer )
NA
else
x$lp_objective_dual_values,
auxiliary = list( primal = x$lp_row_prim_aux,
dual = if( is_integer)
NA
else
x$lp_row_dual_aux))
if (sensitivity_report) {
sensitivity_report <- readLines(fname_sensitivity_report)
file.remove(fname_sensitivity_report)
} else {
sensitivity_report <- NA_character_
}
list(optimum = sum(solution * obj), solution = solution, status = status,
solution_dual = if( is_integer ) NA else x$lp_objective_dual_values,
auxiliary = list(primal = x$lp_row_prim_aux,
dual = if( is_integer) NA else x$lp_row_dual_aux),
sensitivity_report = sensitivity_report)
}
## this function calls the C interface
......@@ -126,7 +145,8 @@ function(lp_objective_coefficients, lp_n_of_objective_vars,
lp_objective_var_is_integer, lp_objective_var_is_binary,
lp_direction_of_optimization,
lp_bounds_type, lp_bounds_lower, lp_bounds_upper,
verbose, presolve, time_limit, write_fmt, fname)
verbose, presolve, time_limit, write_fmt, fname, write_sensitivity_report,
fname_sensitivity_report)
{
out <- .C(R_glp_solve,
lp_direction_of_optimization= as.integer(lp_direction_of_optimization),
......@@ -160,6 +180,8 @@ function(lp_objective_coefficients, lp_n_of_objective_vars,
lp_status = integer(1),
write_fmt = as.integer(write_fmt),
fname = as.character(fname),
write_sensitivity_report = write_sensitivity_report,
fname_sensitivity_report = fname_sensitivity_report,
NAOK = TRUE, PACKAGE = "Rglpk")
out
}
......
2019-02-07 Stefan Theussl <stefan.theussl@R-project.org>
* UPDATED: removed compiler flags from preprocessor in MAKEVARS.win
* ADDED: sensitivity report feature
* RELEASE: Rglpk 0.6-4 on CRAN
2016-06-13 Stefan Theussl <stefan.theussl@R-project.org>
* UPPDATED: useDynLib registriation of C routines
* FIXED: binary variables using a zero coefficient in objective function
......
#-*- Makefile -*-
#
PKG_CPPFLAGS=-g -D_R_=1 -DUSE_R=1 -I${GLPK_HOME}/include -DCHECK_GLPK_ARGS
PKG_CPPFLAGS=-D_R_=1 -DUSE_R=1 -I${GLPK_HOME}/include -DCHECK_GLPK_ARGS
PKG_LIBS=-L${GLPK_HOME}/lib -lglpk -lgmp
......@@ -7,30 +7,32 @@
// this is the solve function called from R
void R_glp_solve (int *lp_direction, int *lp_number_of_constraints,
int *lp_direction_of_constraints, double *lp_right_hand_side,
int *lp_number_of_objective_vars,
double *lp_objective_coefficients,
int *lp_objective_var_is_integer,
int *lp_objective_var_is_binary,
int *lp_is_integer, //should be boolean
int *lp_number_of_values_in_constraint_matrix,
int *lp_constraint_matrix_i, int *lp_constraint_matrix_j,
double *lp_constraint_matrix_values,
int *lp_bounds_type, double *lp_bounds_lower,
double *lp_bounds_upper,
double *lp_optimum,
int *lp_col_stat,
double *lp_objective_vars_values,
double *lp_objective_dual_values,
int *lp_row_stat,
double *lp_row_prim_aux,
double *lp_row_dual_aux,
int *lp_verbosity,
int *lp_presolve,
int *lp_time_limit,
int *lp_status,
int *write_fmt,
char **fname) {
int *lp_direction_of_constraints, double *lp_right_hand_side,
int *lp_number_of_objective_vars,
double *lp_objective_coefficients,
int *lp_objective_var_is_integer,
int *lp_objective_var_is_binary,
int *lp_is_integer, //should be boolean
int *lp_number_of_values_in_constraint_matrix,
int *lp_constraint_matrix_i, int *lp_constraint_matrix_j,
double *lp_constraint_matrix_values,
int *lp_bounds_type, double *lp_bounds_lower,
double *lp_bounds_upper,
double *lp_optimum,
int *lp_col_stat,
double *lp_objective_vars_values,
double *lp_objective_dual_values,
int *lp_row_stat,
double *lp_row_prim_aux,
double *lp_row_dual_aux,
int *lp_verbosity,
int *lp_presolve,
int *lp_time_limit,
int *lp_status,
int *write_fmt,
char **fname,
int *write_sensitivity_report,
char **fname_sensitivity_report) {
// GLPK problem object
glp_prob *lp;
......@@ -70,24 +72,24 @@ void R_glp_solve (int *lp_direction, int *lp_number_of_constraints,
if( *lp_number_of_constraints > 0 ){
glp_add_rows(lp, *lp_number_of_constraints);
for(i = 0; i < *lp_number_of_constraints; i++)
switch(lp_direction_of_constraints[i]){
case 1:
glp_set_row_bnds(lp, i+1, GLP_UP, 0.0, lp_right_hand_side[i]);
break;
case 2:
glp_set_row_bnds(lp, i+1, GLP_UP, 0.0, lp_right_hand_side[i]);
break;
case 3:
glp_set_row_bnds(lp, i+1, GLP_LO, lp_right_hand_side[i], 0.0);
break;
case 4:
glp_set_row_bnds(lp, i+1, GLP_LO, lp_right_hand_side[i], 0.0);
break;
case 5:
glp_set_row_bnds(lp, i+1, GLP_FX, lp_right_hand_side[i],
lp_right_hand_side[i]);
break;
}
switch(lp_direction_of_constraints[i]){
case 1:
glp_set_row_bnds(lp, i+1, GLP_UP, 0.0, lp_right_hand_side[i]);
break;
case 2:
glp_set_row_bnds(lp, i+1, GLP_UP, 0.0, lp_right_hand_side[i]);
break;
case 3:
glp_set_row_bnds(lp, i+1, GLP_LO, lp_right_hand_side[i], 0.0);
break;
case 4:
glp_set_row_bnds(lp, i+1, GLP_LO, lp_right_hand_side[i], 0.0);
break;
case 5:
glp_set_row_bnds(lp, i+1, GLP_FX, lp_right_hand_side[i],
lp_right_hand_side[i]);
break;
}
}
// add columns to the problem object
......@@ -98,9 +100,9 @@ void R_glp_solve (int *lp_direction, int *lp_number_of_constraints,
// set objective coefficients and integer if necessary
glp_set_obj_coef(lp, i+1, lp_objective_coefficients[i]);
if (lp_objective_var_is_integer[i])
glp_set_col_kind(lp, i+1, GLP_IV);
glp_set_col_kind(lp, i+1, GLP_IV);
if (lp_objective_var_is_binary[i])
glp_set_col_kind(lp, i+1, GLP_BV);
glp_set_col_kind(lp, i+1, GLP_BV);
}
// load the matrix
// IMPORTANT: as glp_load_matrix requires triplets as vectors of the
......@@ -108,8 +110,8 @@ void R_glp_solve (int *lp_direction, int *lp_number_of_constraints,
// [-1] of the corresponding vector
if( *lp_number_of_constraints > 0 ){
glp_load_matrix(lp, *lp_number_of_values_in_constraint_matrix,
&lp_constraint_matrix_i[-1],
&lp_constraint_matrix_j[-1], &lp_constraint_matrix_values[-1]);
&lp_constraint_matrix_i[-1],
&lp_constraint_matrix_j[-1], &lp_constraint_matrix_values[-1]);
}
// write lp to file
......@@ -160,10 +162,10 @@ void R_glp_solve (int *lp_direction, int *lp_number_of_constraints,
// set optimizer control parameters
glp_init_iocp(&control_io);
if (*lp_time_limit > 0) {
control_io.tm_lim = *lp_time_limit;
control_io.tm_lim = *lp_time_limit;
}
if (*lp_presolve == 1) {
control_io.presolve = GLP_ON;
control_io.presolve = GLP_ON;
}
// optimize
glp_intopt(lp, &control_io);
......@@ -174,13 +176,20 @@ void R_glp_solve (int *lp_direction, int *lp_number_of_constraints,
*lp_optimum = glp_mip_obj_val(lp);
// retrieve MIP values of objective vars
for(i = 0; i < *lp_number_of_objective_vars; i++){
lp_objective_vars_values[i] = glp_mip_col_val(lp, i+1);
lp_objective_vars_values[i] = glp_mip_col_val(lp, i+1);
}
// retrieve MIP auxiliary variable values
for(i = 0; i < *lp_number_of_constraints; i++) {
lp_row_prim_aux[i] = glp_mip_row_val(lp, i+1);
lp_row_prim_aux[i] = glp_mip_row_val(lp, i+1);
}
}
// write sensitivity analysis report
if (*write_sensitivity_report == 1) {
const char *out_name = fname_sensitivity_report[0];
glp_print_ranges(lp, 0, NULL, 0, out_name);
}
// delete problem object
glp_delete_prob(lp);
}
......
......@@ -3,64 +3,66 @@
#include <R_ext/Rdynload.h>
void R_glp_solve (int *lp_direction, int *lp_number_of_constraints,
int *lp_direction_of_constraints, double *lp_right_hand_side,
int *lp_number_of_objective_vars,
double *lp_objective_coefficients,
int *lp_objective_var_is_integer,
int *lp_objective_var_is_binary,
int *lp_is_integer, //should be boolean
int *lp_number_of_values_in_constraint_matrix,
int *lp_constraint_matrix_i, int *lp_constraint_matrix_j,
double *lp_constraint_matrix_values,
int *lp_bounds_type, double *lp_bounds_lower,
double *lp_bounds_upper,
double *lp_optimum,
int *lp_col_stat,
double *lp_objective_vars_values,
double *lp_objective_dual_values,
int *lp_row_stat,
double *lp_row_prim_aux,
double *lp_row_dual_aux,
int *lp_verbosity,
int *lp_presolve,
int *lp_time_limit,
int *lp_status,
int *write_fmt,
char **fname);
int *lp_direction_of_constraints, double *lp_right_hand_side,
int *lp_number_of_objective_vars,
double *lp_objective_coefficients,
int *lp_objective_var_is_integer,
int *lp_objective_var_is_binary,
int *lp_is_integer, //should be boolean
int *lp_number_of_values_in_constraint_matrix,
int *lp_constraint_matrix_i, int *lp_constraint_matrix_j,
double *lp_constraint_matrix_values,
int *lp_bounds_type, double *lp_bounds_lower,
double *lp_bounds_upper,
double *lp_optimum,
int *lp_col_stat,
double *lp_objective_vars_values,
double *lp_objective_dual_values,
int *lp_row_stat,
double *lp_row_prim_aux,
double *lp_row_dual_aux,
int *lp_verbosity,
int *lp_presolve,
int *lp_time_limit,
int *lp_status,
int *write_fmt,
char **fname,
int *write_sensitivity_report,
char **fname_sensitivity_report);
void Rglpk_initialize(void);
void Rglpk_get_engine_version(char **GLPK_version);
void R_glp_read_file (char **file, int *type,
int *lp_direction_of_optimization,
int *lp_n_constraints, int *lp_n_objective_vars,
int *lp_n_values_in_constraint_matrix,
int *lp_n_integer_vars, int *lp_n_binary_vars,
char **lp_prob_name,
char **lp_obj_name,
int *lp_verbosity);
int *lp_direction_of_optimization,
int *lp_n_constraints, int *lp_n_objective_vars,
int *lp_n_values_in_constraint_matrix,
int *lp_n_integer_vars, int *lp_n_binary_vars,
char **lp_prob_name,
char **lp_obj_name,
int *lp_verbosity);
void Rglpk_delete_prob();
void Rglpk_retrieve_MP_from_file (char **file, int *type,
int *lp_n_constraints,
int *lp_n_objective_vars,
double *lp_objective_coefficients,
int *lp_constraint_matrix_i,
int *lp_constraint_matrix_j,
double *lp_constraint_matrix_values,
int *lp_direction_of_constraints,
double *lp_right_hand_side,
double *lp_left_hand_side,
int *lp_objective_var_is_integer,
int *lp_objective_var_is_binary,
int *lp_bounds_type,
double *lp_bounds_lower,
double *lp_bounds_upper,
int *lp_ignore_first_row,
int *lp_verbosity,
char **lp_constraint_names,
char **lp_objective_vars_names
);
int *lp_n_constraints,
int *lp_n_objective_vars,
double *lp_objective_coefficients,
int *lp_constraint_matrix_i,
int *lp_constraint_matrix_j,
double *lp_constraint_matrix_values,
int *lp_direction_of_constraints,
double *lp_right_hand_side,
double *lp_left_hand_side,
int *lp_objective_var_is_integer,
int *lp_objective_var_is_binary,
int *lp_bounds_type,
double *lp_bounds_lower,
double *lp_bounds_upper,
int *lp_ignore_first_row,
int *lp_verbosity,
char **lp_constraint_names,
char **lp_objective_vars_names
);
static const R_CMethodDef CEntries[] = {
{"R_glp_solve", (DL_FUNC) &R_glp_solve, 29},
{"R_glp_solve", (DL_FUNC) &R_glp_solve, 31},
{"Rglpk_initialize", (DL_FUNC) &Rglpk_initialize, 0},
{"Rglpk_get_engine_version", (DL_FUNC) &Rglpk_get_engine_version, 1},
{"R_glp_read_file", (DL_FUNC) &R_glp_read_file, 11},
......
library(Rglpk)
##
## Example 1
##
obj <- c(2, 4, 3)
mat <- matrix(c(3, 2, 1, 4, 1, 3, 2, 2, 2), nrow = 3)
dir <- c("<=", "<=", "<=")
rhs <- c(60, 40, 80)
max <- TRUE
s <- Rglpk_solve_LP(obj, mat, dir, rhs, max = max)
stopifnot(sum(abs(s$solution - c(0, 20/3, 50/3))) < 1e-4)
##
## Example 2
##
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)
types <- c("I", "C", "I")
max <- TRUE
s <- Rglpk_solve_LP(obj, mat, dir, rhs, types = types, max = max)
stopifnot(sum(abs(s$solution - c(5, 11/4, 3))) < 1e-4)
##
## Example 3
##
bounds <- list(lower = list(ind = c(1L, 3L), val = c(-Inf, 2)),
upper = list(ind = c(1L, 2L), val = c(4, 100)))
s <- Rglpk_solve_LP(obj, mat, dir, rhs, bounds, types, max)
stopifnot(sum(abs(s$solution - c(4, 10/4, 3))) < 1e-4)
##
## Example 4
##
types <- c("B", "B", "B")
s <- Rglpk_solve_LP(obj, mat, dir, rhs, bounds, types, max)
stopifnot(sum(abs(s$solution - c(1, 1, 1))) < 1e-4)
##
## Example 5
##
types <- c("I", "B", "I")
s <- Rglpk_solve_LP(obj, mat, dir, rhs, bounds, types, max)
s$solution
stopifnot(sum(abs(s$solution - c(2, 1, 2))) < 1e-4)
##
## Example 6
##
mat <- rbind(mat, c(1, 1, 0))
dir <- c(dir, "==")
rhs <- c(rhs, 1)
types <- c("B", "B", "B")
s <- Rglpk_solve_LP(obj, mat, dir, rhs, bounds, types, max)
stopifnot(sum(abs(s$solution - c(1, 0, 1))) < 1e-4)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment