Rglpk/0000755000175100001440000000000012730050053011342 5ustar hornikusersRglpk/inst/0000755000175100001440000000000012721324725012331 5ustar hornikusersRglpk/inst/examples/0000755000175100001440000000000012435675425014157 5ustar hornikusersRglpk/inst/examples/plan.lp0000644000175100001440000000234612435675425015453 0ustar hornikusers\* plan.lp *\ Minimize value: .03 bin1 + .08 bin2 + .17 bin3 + .12 bin4 + .15 bin5 + .21 alum + .38 silicon Subject To yield: bin1 + bin2 + bin3 + bin4 + bin5 + alum + silicon = 2000 fe: .15 bin1 + .04 bin2 + .02 bin3 + .04 bin4 + .02 bin5 + .01 alum + .03 silicon <= 60 cu: .03 bin1 + .05 bin2 + .08 bin3 + .02 bin4 + .06 bin5 + .01 alum <= 100 mn: .02 bin1 + .04 bin2 + .01 bin3 + .02 bin4 + .02 bin5 <= 40 mg: .02 bin1 + .03 bin2 + .01 bin5 <= 30 al: .70 bin1 + .75 bin2 + .80 bin3 + .75 bin4 + .80 bin5 + .97 alum >= 1500 si1: .02 bin1 + .06 bin2 + .08 bin3 + .12 bin4 + .02 bin5 + .01 alum + .97 silicon >= 250 si2: .02 bin1 + .06 bin2 + .08 bin3 + .12 bin4 + .02 bin5 + .01 alum + .97 silicon <= 300 Bounds bin1 <= 200 bin2 <= 2500 400 <= bin3 <= 800 100 <= bin4 <= 700 bin5 <= 1500 End \* eof *\ Rglpk/inst/examples/plan.mod0000644000175100001440000000164112435675425015614 0ustar hornikusers/* plan.mod */ var bin1, >= 0, <= 200; var bin2, >= 0, <= 2500; var bin3, >= 400, <= 800; var bin4, >= 100, <= 700; var bin5, >= 0, <= 1500; var alum, >= 0; var silicon, >= 0; minimize value: .03 * bin1 + .08 * bin2 + .17 * bin3 + .12 * bin4 + .15 * bin5 + .21 * alum + .38 * silicon; subject to yield: bin1 + bin2 + bin3 + bin4 + bin5 + alum + silicon = 2000; fe: .15 * bin1 + .04 * bin2 + .02 * bin3 + .04 * bin4 + .02 * bin5 + .01 * alum + .03 * silicon <= 60; cu: .03 * bin1 + .05 * bin2 + .08 * bin3 + .02 * bin4 + .06 * bin5 + .01 * alum <= 100; mn: .02 * bin1 + .04 * bin2 + .01 * bin3 + .02 * bin4 + .02 * bin5 <= 40; mg: .02 * bin1 + .03 * bin2 + .01 * bin5 <= 30; al: .70 * bin1 + .75 * bin2 + .80 * bin3 + .75 * bin4 + .80 * bin5 + .97 * alum >= 1500; si: 250 <= .02 * bin1 + .06 * bin2 + .08 * bin3 + .12 * bin4 + .02 * bin5 + .01 * alum + .97 * silicon <= 300; end; /* eof */ Rglpk/inst/examples/assign.mod0000644000175100001440000000404512435675425016147 0ustar hornikusers/* ASSIGN, Assignment Problem */ /* Written in GNU MathProg by Andrew Makhorin */ /* The assignment problem is one of the fundamental combinatorial optimization problems. In its most general form, the problem is as follows: There are a number of agents and a number of tasks. Any agent can be assigned to perform any task, incurring some cost that may vary depending on the agent-task assignment. It is required to perform all tasks by assigning exactly one agent to each task in such a way that the total cost of the assignment is minimized. (From Wikipedia, the free encyclopedia.) */ param m, integer, > 0; /* number of agents */ param n, integer, > 0; /* number of tasks */ set I := 1..m; /* set of agents */ set J := 1..n; /* set of tasks */ param c{i in I, j in J}, >= 0; /* cost of allocating task j to agent i */ var x{i in I, j in J}, >= 0; /* x[i,j] = 1 means task j is assigned to agent i note that variables x[i,j] are binary, however, there is no need to declare them so due to the totally unimodular constraint matrix */ s.t. phi{i in I}: sum{j in J} x[i,j] <= 1; /* each agent can perform at most one task */ s.t. psi{j in J}: sum{i in I} x[i,j] = 1; /* each task must be assigned exactly to one agent */ minimize obj: sum{i in I, j in J} c[i,j] * x[i,j]; /* the objective is to find a cheapest assignment */ solve; printf "\n"; printf "Agent Task Cost\n"; printf{i in I} "%5d %5d %10g\n", i, sum{j in J} j * x[i,j], sum{j in J} c[i,j] * x[i,j]; printf "----------------------\n"; printf " Total: %10g\n", sum{i in I, j in J} c[i,j] * x[i,j]; printf "\n"; data; /* These data correspond to an example from [Christofides]. */ /* Optimal solution is 76 */ param m := 8; param n := 8; param c : 1 2 3 4 5 6 7 8 := 1 13 21 20 12 8 26 22 11 2 12 36 25 41 40 11 4 8 3 35 32 13 36 26 21 13 37 4 34 54 7 8 12 22 11 40 5 21 6 45 18 24 34 12 48 6 42 19 39 15 14 16 28 46 7 16 34 38 3 34 40 22 24 8 26 20 5 17 45 31 37 43 ; end; Rglpk/inst/examples/plan.mps0000644000175100001440000000432612435675425015637 0ustar hornikusers*000000001111111111222222222233333333334444444444555555555566 *234567890123456789012345678901234567890123456789012345678901 NAME PLAN ROWS N VALUE E YIELD L FE L CU L MN L MG G AL L SI COLUMNS BIN1 VALUE .03000 YIELD 1.00000 FE .15000 CU .03000 MN .02000 MG .02000 AL .70000 SI .02000 BIN2 VALUE .08000 YIELD 1.00000 FE .04000 CU .05000 MN .04000 MG .03000 AL .75000 SI .06000 BIN3 VALUE .17000 YIELD 1.00000 FE .02000 CU .08000 MN .01000 AL .80000 SI .08000 BIN4 VALUE .12000 YIELD 1.00000 FE .04000 CU .02000 MN .02000 AL .75000 SI .12000 BIN5 VALUE .15000 YIELD 1.00000 FE .02000 CU .06000 MN .02000 MG .01000 AL .80000 SI .02000 ALUM VALUE .21000 YIELD 1.00000 FE .01000 CU .01000 AL .97000 SI .01000 SILICON VALUE .38000 YIELD 1.00000 FE .03000 SI .97000 RHS RHS1 YIELD 2000.00000 FE 60.00000 CU 100.00000 MN 40.00000 SI 300.00000 MG 30.00000 AL 1500.00000 RANGES RNG1 SI 50.00000 BOUNDS UP BND1 BIN1 200.00000 UP BIN2 2500.00000 LO BIN3 400.00000 UP BIN3 800.00000 LO BIN4 100.00000 UP BIN4 700.00000 UP BIN5 1500.00000 ENDATA Rglpk/inst/CHANGELOG0000644000175100001440000001221712727574424013557 0ustar hornikusers2016-06-13 Stefan Theussl * ADDED: new control parameters "presolve" and "tm_limit" * ADDED: reduced cost in return value (solution_dual) * ADDED: value of auxiliary variable (primal|dual) in return value * RELEASE: Rglpk 0.6-2 on CRAN 2015-07-01 Stefan Theussl * FIXED: S3method properly registered * FIXED: R does not terminate abnormally on an internal GLPK library error since an error handler is now registered. Thanks to a patch by Heinrich Schuchardt. * RELEASE: Rglpk 0.6-1 on CRAN 2014-06-15 Stefan Theussl * UPDATED: Rglpk does not ship GLPK sources anymore * UPDATED: Licence now GPL-2 | GPL-3 * RELEASE: Rglpk 0.6-0 on CRAN 2013-11-27 Stefan Theussl * UPDATED: Rglpk now ships with GLPK sources version 4.52.1 * FIXED: handling of bounds passed down from ROI * RELEASE: Rglpk 0.5-2 on CRAN 2013-06-03 Stefan Theussl * UPDATED: Rglpk now ships with GLPK sources version 4.52 * UPDATED: new patches are needed for this GLPK release. * FIXED: Copyright holder statements as demanded by CRAN policy * RELEASE: Rglpk 0.5-1 on CRAN 2013-06-03 Stefan Theussl * UPDATED: Rglpk now ships with GLPK sources version 4.50 * UPDATED: some extra patches are needed for this GLPK release. * RELEASE: Rglpk 0.4-1 on CRAN 2012-09-11 Stefan Theussl * UPDATED: argument list now in the following order: obj, mat, dir, rhs, bounds = NULL, types = NULL, max = FALSE, control = NULL. Currently, control can only be used for setting verbosity level. * UPDATED: use only a subset of file reader example data * FIXED: file reader improvements (C API), thx to ceeboo * RELEASE: Rglpk 0.3-10 on CRAN 2012-09-04 Stefan Theussl * ADDED: example data for file reader function * FIXED: fixing segfault when reading large instances from files * UPDATED: maintainer mail address * RELEASE: Rglpk 0.3-9 on CRAN 2012-01-16 Stefan Theussl * FIXED: gcc 4.5.x warning * RELEASE: Rglpk 0.3-8 on CRAN 2012-01-12 Stefan Theussl * ADDED: added MATHPROG reader support * ADDED: retrieving constraint names from file based instances * RELEASE: Rglpk 0.3-7 on CRAN 2011-12-30 Stefan Theussl * UPDATED: now using packageStartupMessage() * UPDATED: Windows build toolchain changed * UPDATED: configure script now searching for system library * UPDATED: Rglpk now includes GLPK sources of version 4.47 * RELEASE: Rglpk 0.3-7 on CRAN 2010-02-15 Stefan Theussl * FIXED: Further Windows improvements (Makevars.win, Makefile.win) * RELEASE: Rglpk 0.3-5 on CRAN 2010-02-02 Stefan Theussl * FIXED: Now includes a static library for windows * RELEASE: Rglpk 0.3-4 on CRAN 2010-01-28 Stefan Theussl * UPDATED: Rglpk now includes GLPK version 4.42 * FIXED: compile warnings have been fixed in Upstream code * ADDED: Windows support via separate configure script and Makevars * RELEASE: Rglpk 0.3-3 on CRAN 2009-09-07 Stefan Theussl * UPDATED: Rglpk now includes GLPK version 4.39 * FIXED: lower, upper bound conversion in bound_table * ADDED: separate configure script and Makevars due to major changes in upstream code 2009-06-26 Stefan Theussl * REMOVED: sparse matrix support from Rglpk package * ADDED: slam dependency which replaces the old S3 sparse matrix support * RELEASE: Rglpk 0.3-1 on CRAN 2009-03-30 Stefan Theussl * UPDATED: Rglpk now includes GLPK version 4.37 * RELEASE: Rglpk 0.2-9 on CRAN 2009-02-06 Stefan Theussl * UPDATED: Rglpk now includes GLPK version 4.36 * RELEASE: Rglpk 0.2-8 on CRAN 2008-12-08 Stefan Theussl * UPDATED: Rglpk now includes GLPK version 4.34 * RELEASE: Rglpk 0.2-7 on CRAN 2008-11-16 Stefan Theussl * UPDATED: Rglpk now includes GLPK version 4.33 * FIXED: replaced abort() with error() statments * RELEASE: Rglpk 0.2-6 on CRAN 2008-09-27 Stefan Theussl * UPDATED: Rglpk now includes GLPK version 4.31 2008-08-20 Stefan Theussl * RELEASE: Rglpk 0.2-5 on CRAN 2008-08-15 Stefan Theussl * UPDATED: GLPK 4.30 * FIXED: read/write MPS files new low level C routines * ADDED: .onLoad function to initialize default printer in C (Rprintf) * ADDED: GLPK version information printed in R after loading shared library 2008-07-30 Stefan Theussl * FIXED: integer/binary variables are now rounded to reduce failures due to numerical artefacts 2008-07-21 Stefan Theussl * UPDATED: GLPK 4.29 integrated 2008-06-06 Stefan Theussl * RELEASE: Rglpk released to CRAN. It interfaces GLPK version 4.28. Facilities to read MPS and CPLEX-LP format added. Rglpk/src/0000755000175100001440000000000012727570451012150 5ustar hornikusersRglpk/src/Rglpk_read_file.c0000644000175100001440000001716712727615123015375 0ustar hornikusers/* These are the interface functions to GLPK's MPS reader/writer Since * 2012-01-11: Rglpk now supports MATHPROG files and retrieves * variables names and constraints names. Thanks to Michael Kapler! * 2012-09-06: A fix to random segfaults introduced with the patch by * Michael has been contributed by Christian Buchta. */ #include "Rglpk.h" #include // pointer to problem object. static glp_prob *lp = NULL; // call destructor from the R level to guarantee that data has been // copied to R data structures. void Rglpk_delete_prob() { extern glp_prob *lp; // delete problem object (if any) if (lp){ glp_delete_prob(lp); lp = NULL; } } // read in all necessary elements for retrieving the LP/MILP void Rglpk_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 status; extern glp_prob *lp; glp_tran *tran; const char *str; // Turn on/off Terminal Output if (*lp_verbosity==1) glp_term_out(GLP_ON); else glp_term_out(GLP_OFF); // create problem object if (lp) glp_delete_prob(lp); lp = glp_create_prob(); // read file -> gets stored as an GLPK problem object 'lp' // which file type do we have? switch (*type){ case 1: // Fixed (ancient) MPS Format, param argument currently NULL status = glp_read_mps(lp, GLP_MPS_DECK, NULL, *file); break; case 2: // Free (modern) MPS format, param argument currently NULL status = glp_read_mps(lp, GLP_MPS_FILE, NULL, *file); break; case 3: // CPLEX LP Format status = glp_read_lp(lp, NULL, *file); break; case 4: // MATHPROG Format (based on lpx_read_model function) tran = glp_mpl_alloc_wksp(); status = glp_mpl_read_model(tran, *file, 0); if (!status) { status = glp_mpl_generate(tran, NULL); if (!status) { glp_mpl_build_prob(tran, lp); } } glp_mpl_free_wksp(tran); break; } // if file read successfully glp_read_* returns zero if ( status != 0 ) { glp_delete_prob(lp); lp = NULL; error("Reading file %s failed", *file); } // retrieve problem name str = glp_get_prob_name(lp); if (str){ *lp_prob_name = (char *) str; } // retrieve name of objective function str = glp_get_obj_name(lp); if (str){ *lp_obj_name = (char *) str; } // retrieve optimization direction flag *lp_direction_of_optimization = glp_get_obj_dir(lp); // retrieve number of constraints *lp_n_constraints = glp_get_num_rows(lp); // retrieve number of objective variables *lp_n_objective_vars = glp_get_num_cols(lp); // retrieve number of non-zero elements in constraint matrix *lp_n_values_in_constraint_matrix = glp_get_num_nz(lp); // retrieve number of integer variables *lp_n_integer_vars = glp_get_num_int(lp); // retrieve number of binary variables *lp_n_binary_vars = glp_get_num_bin(lp); } // retrieve all missing values of LP/MILP 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 ) { extern glp_prob *lp; glp_tran *tran; const char *str; int i, j, lp_column_kind, tmp; int ind_offset, status; // Turn on/off Terminal Output if (*lp_verbosity==1) glp_term_out(GLP_ON); else glp_term_out(GLP_OFF); // create problem object if (lp) glp_delete_prob(lp); lp = glp_create_prob(); // read file -> gets stored as an GLPK problem object 'lp' // which file type do we have? switch (*type){ case 1: // Fixed (ancient) MPS Format, param argument currently NULL status = glp_read_mps(lp, GLP_MPS_DECK, NULL, *file); break; case 2: // Free (modern) MPS format, param argument currently NULL status = glp_read_mps(lp, GLP_MPS_FILE, NULL, *file); break; case 3: // CPLEX LP Format status = glp_read_lp(lp, NULL, *file); break; case 4: // MATHPROG Format (based on lpx_read_model function) tran = glp_mpl_alloc_wksp(); status = glp_mpl_read_model(tran, *file, 0); if (!status) { status = glp_mpl_generate(tran, NULL); if (!status) { glp_mpl_build_prob(tran, lp); } } glp_mpl_free_wksp(tran); break; } // if file read successfully glp_read_* returns zero if ( status != 0 ) { glp_delete_prob(lp); lp = NULL; error("Reading file %c failed.", *file); } if(*lp_verbosity==1) Rprintf("Retrieve column specific data ...\n"); if(glp_get_num_cols(lp) != *lp_n_objective_vars) { glp_delete_prob(lp); lp = NULL; error("The number of columns is not as specified"); } // retrieve column specific data (values, bounds and type) for (i = 0; i < *lp_n_objective_vars; i++) { lp_objective_coefficients[i] = glp_get_obj_coef(lp, i+1); // Note that str must not be freed befor we have returned // from the .C call in R! str = glp_get_col_name(lp, i+1); if (str){ lp_objective_vars_names[i] = (char *) str; } lp_bounds_type[i] = glp_get_col_type(lp, i+1); lp_bounds_lower[i] = glp_get_col_lb (lp, i+1); lp_bounds_upper[i] = glp_get_col_ub (lp, i+1); lp_column_kind = glp_get_col_kind(lp, i+1); // set to TRUE if objective variable is integer or binary switch (lp_column_kind){ case GLP_IV: lp_objective_var_is_integer[i] = 1; break; case GLP_BV: lp_objective_var_is_binary[i] = 1; break; } } ind_offset = 0; if(*lp_verbosity==1) Rprintf("Retrieve row specific data ...\n"); if(glp_get_num_rows(lp) != *lp_n_constraints) { glp_delete_prob(lp); lp = NULL; error("The number of rows is not as specified"); } // retrieve row specific data (right hand side, direction of constraints) for (i = *lp_ignore_first_row; i < *lp_n_constraints; i++) { lp_direction_of_constraints[i] = glp_get_row_type(lp, i+1); str = glp_get_row_name(lp, i + 1); if (str) { lp_constraint_names[i] = (char *) str; } // the right hand side. Note we don't allow for double bounded or // free auxiliary variables if( lp_direction_of_constraints[i] == GLP_LO ) lp_right_hand_side[i] = glp_get_row_lb(lp, i+1); if( lp_direction_of_constraints[i] == GLP_UP ) lp_right_hand_side[i] = glp_get_row_ub(lp, i+1); if( lp_direction_of_constraints[i] == GLP_FX ) lp_right_hand_side[i] = glp_get_row_lb(lp, i+1); if( lp_direction_of_constraints[i] == GLP_DB ){ lp_right_hand_side[i] = glp_get_row_ub(lp, i+1); lp_left_hand_side[i] = glp_get_row_lb(lp, i+1); } tmp = glp_get_mat_row(lp, i+1, &lp_constraint_matrix_j[ind_offset-1], &lp_constraint_matrix_values[ind_offset-1]); if (tmp > 0) for (j = 0; j < tmp; j++) lp_constraint_matrix_i[ind_offset+j] = i+1; ind_offset += tmp; } if(*lp_verbosity==1) Rprintf("Done.\n"); } Rglpk/src/Makevars.in0000644000175100001440000000025712727615123014251 0ustar hornikusersPKG_CPPFLAGS = @GLPK_INCLUDE_PATH@ PKG_LIBS = @GLPK_LIB_PATH@ @GLPK_LIBS@ .PHONY: all @GLPK_TS@ all: $(SHLIB) $(OBJECTS): @GLPK_TS@ GLPK.ts: @(cd GLPK && make) touch $@ Rglpk/src/Rglpk_solve.c0000644000175100001440000001246512727615123014607 0ustar hornikusers/* This is the GLPK C Interface */ #include "Rglpk.h" #include #include // 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) { // GLPK problem object glp_prob *lp; // GLPK simplex control object glp_smcp control_sm; // GLPK mixed integer control object glp_iocp control_io; int i, kl, ku; jmp_buf env; // Patch provided by Xypron: A far jump is used to return if an // error occurs. Prior to that R crashed. if (setjmp(env)) { error("An error occured inside the GLPK library."); } else { glp_error_hook(Rglpk_error_hook, &env); // create problem object lp = glp_create_prob(); // Turn on/off Terminal Output if(*lp_verbosity==1) glp_term_out(GLP_ON); else glp_term_out(GLP_OFF); // direction of optimization if(*lp_direction==1) glp_set_obj_dir(lp, GLP_MAX); else glp_set_obj_dir(lp, GLP_MIN); // is it a mixed integer problem? -- seems to be an R glpk function //if(lp_integer) //lpx_set_class(lp, LPX_MIP); // add rows to the problem object 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; } } // add columns to the problem object glp_add_cols(lp, *lp_number_of_objective_vars); kl = ku = 0; for(i = 0; i < *lp_number_of_objective_vars; i++) { glp_set_col_bnds(lp, i+1, lp_bounds_type[i], lp_bounds_lower[i], lp_bounds_upper[i]); // 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); if (lp_objective_var_is_binary[i]) glp_set_col_kind(lp, i+1, GLP_BV); } // load the matrix // IMPORTANT: as glp_load_matrix requires triplets as vectors of the // form: ia[1] ... ia[n], we have to pass the pointer to the adress // [-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]); } // set optimizer control parameters glp_init_smcp(&control_sm); if (*lp_time_limit > 0) { control_sm.tm_lim = *lp_time_limit; } if (*lp_presolve == 1) { control_sm.presolve = GLP_ON; } // run simplex method to solve linear problem glp_simplex(lp, &control_sm); // retrieve status of optimization *lp_status = glp_get_status(lp); // retrieve optimum *lp_optimum = glp_get_obj_val(lp); // retrieve values of objective vars for(i = 0; i < *lp_number_of_objective_vars; i++) { lp_col_stat[i] = glp_get_col_stat(lp, i+1); lp_objective_vars_values[i] = glp_get_col_prim(lp, i+1); lp_objective_dual_values[i] = glp_get_col_dual(lp, i+1); } // retrieve primal/dual multipliers for(i = 0; i < *lp_number_of_constraints; i++) { lp_row_stat[i] = glp_get_row_stat(lp, i+1); lp_row_prim_aux[i] = glp_get_row_prim(lp, i+1); lp_row_dual_aux[i] = glp_get_row_dual(lp, i+1); } if(*lp_is_integer) { // set optimizer control parameters glp_init_iocp(&control_io); if (*lp_time_limit > 0) { control_io.tm_lim = *lp_time_limit; } if (*lp_presolve == 1) { control_io.presolve = GLP_ON; } // optimize glp_intopt(lp, &control_io); // retrieve status of optimization *lp_status = glp_mip_status(lp); // retrieve MIP optimum *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); } // 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); } } // delete problem object glp_delete_prob(lp); } } Rglpk/src/Rglpk.h0000644000175100001440000000017012727615123013372 0ustar hornikusers#include "glpk.h" #include #include void Rglpk_initialize(void); void Rglpk_error_hook(void *in); Rglpk/src/Makevars.win0000755000175100001440000000021112727615123014431 0ustar hornikusers#-*- Makefile -*- # PKG_CPPFLAGS=-g -D_R_=1 -DUSE_R=1 -I${GLPK_HOME}/include -DCHECK_GLPK_ARGS PKG_LIBS=-L${GLPK_HOME}/lib -lglpk -lgmp Rglpk/src/Rglpk_error.c0000644000175100001440000000054212727615123014601 0ustar hornikusers#include "Rglpk.h" #include "setjmp.h" /* * Path provided by Xypron * This hook function will be called if an error occured when * calling the glpk library */ void Rglpk_error_hook(void *in) { /* free glpk memory */ glp_free_env(); /* set print hook for terminal */ Rglpk_initialize(); /* safely return */ longjmp(*((jmp_buf*)in), 1); } Rglpk/src/Rglpk_initialize.c0000644000175100001440000000110712727615123015607 0ustar hornikusers#include "Rglpk.h" // Rglpk_print: print hook for redirecting GLPKs terminal output // note: info is not used here static int Rglpk_print(void *info, const char *message){ Rprintf("%s", message); return 1; /* Tell GLPK not to print */ } // Rglpk_initialize is called after loading the dynlib void Rglpk_initialize(void){ // set print hook for terminal glp_term_hook(Rglpk_print, NULL); } // returns the version of the GLPK callable library void Rglpk_get_engine_version(char **GLPK_version){ const char *str; str = glp_version(); *GLPK_version = (char *) str; } Rglpk/NAMESPACE0000644000175100001440000000017612545043456012602 0ustar hornikusersuseDynLib("Rglpk") import("slam") export("Rglpk_solve_LP") export("Rglpk_read_file") S3method("print", "MP_data_from_file") Rglpk/R/0000755000175100001440000000000012727572707011570 5ustar hornikusersRglpk/R/Rglpk_solve.R0000644000175100001440000001534712727574515014213 0ustar hornikusers## the R-ported GNU Linear Programming kit ## solve function --- C Interface Rglpk_solve_LP <- function(obj, mat, dir, rhs, bounds = NULL, types = NULL, max = FALSE, control = list(), ...) { ## validate direction of optimization if(!identical( max, TRUE ) && !identical( max, FALSE )) stop("'Argument 'max' must be either TRUE or FALSE.") direction_of_optimization <- as.integer(max) ## validate control list dots <- list(...) control[names(dots)] <- dots control <- .check_control_parameters( control ) verb <- control$verbose presolve <- control$presolve time_limit <- control$tm_limit ## match direction of constraints n_of_constraints <- length(dir) ## match relational operators to requested input direction_of_constraints <- match( dir, c("<", "<=", ">", ">=", "==") ) if( any(is.na(direction_of_constraints)) ) stop("Argument 'dir' must be either '<', '<=', '>', '>=' or '=='.") ## we need to verify that obj is a numeric vector ## FIXME: always use STMs? if(slam::is.simple_triplet_matrix(obj)) obj <- as.matrix(obj) obj <- as.numeric(obj) n_of_objective_vars <- length( obj ) constraint_matrix <- as.simple_triplet_matrix(mat) ## types of objective coefficients ## Default: "C" if(is.null(types)) types <- "C" ## check if valid types if(any(is.na(match(types, c("I", "B", "C"), nomatch = NA)))) stop("'types' must be either 'B', 'C' or 'I'.") ## replicate types to fit number of columns types <- rep(types, length.out = n_of_objective_vars) ## need a TRUE/FALSE integer/binary representation integers <- types == "I" binaries <- types == "B" ## do we have a mixed integer linear program? is_integer <- any( binaries | integers ) ## bounds of objective coefficients bounds <- as.glp_bounds( as.list( bounds ), n_of_objective_vars ) ## Sanity check: mat/dir/rhs if( !all(c(dim(mat)[ 1 ], length(rhs)) == n_of_constraints) ) stop( "Arguments 'mat', 'dir', and/or 'rhs' not conformable." ) ## Sanity check: mat, obj if( dim(mat)[ 2 ] != n_of_objective_vars ) stop( "Arguments 'mat' and 'obj' not conformable." ) ## 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, length(constraint_matrix$v), rhs, direction_of_constraints, n_of_constraints, is_integer, integers, binaries, direction_of_optimization, bounds[, 1L], bounds[, 2L], bounds[, 3L], verb, presolve, time_limit) solution <- x$lp_objective_vars_values ## are integer variables really integers? better round values solution[integers | binaries] <- round( solution[integers | binaries]) ## match status of solution status <- as.integer(x$lp_status) if(control$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)) } ## this function calls the C interface glp_call_interface <- function(lp_objective_coefficients, lp_n_of_objective_vars, lp_constraint_matrix_i, lp_constraint_matrix_j, lp_constraint_matrix_v, lp_n_of_values_in_constraint_matrix, lp_right_hand_side, lp_direction_of_constraints, lp_n_of_constraints, lp_is_integer, 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) { out <- .C("R_glp_solve", lp_direction_of_optimization= as.integer(lp_direction_of_optimization), lp_n_of_constraints = as.integer(lp_n_of_constraints), lp_direction_of_constraints = as.integer(lp_direction_of_constraints), lp_right_hand_side = as.double(lp_right_hand_side), lp_n_of_objective_vars = as.integer(lp_n_of_objective_vars), lp_objective_coefficients = as.double(lp_objective_coefficients), lp_objective_var_is_integer = as.integer(lp_objective_var_is_integer), lp_objective_var_is_binary = as.integer(lp_objective_var_is_binary), lp_is_integer = as.integer(lp_is_integer), lp_n_of_values_in_constraint_matrix = as.integer(lp_n_of_values_in_constraint_matrix), lp_constraint_matrix_i = as.integer(lp_constraint_matrix_i), lp_constraint_matrix_j = as.integer(lp_constraint_matrix_j), lp_constraint_matrix_values = as.double(lp_constraint_matrix_v), lp_bounds_type = as.integer(lp_bounds_type), lp_bounds_lower = as.double(lp_bounds_lower), ## lp_n_of_bounds_l = as.integer(length(lp_lower_bounds_i)), lp_bounds_upper = as.double(lp_bounds_upper), ## lp_n_of_bounds_u = as.integer(length(lp_upper_bounds_i)), lp_optimum = double(1), lp_objective_stat = integer(lp_n_of_objective_vars), lp_objective_vars_values = double(lp_n_of_objective_vars), lp_objective_dual_values = double(lp_n_of_objective_vars), lp_row_stat = integer(lp_n_of_constraints), lp_row_prim_aux = double(lp_n_of_constraints), lp_row_dual_aux = double(lp_n_of_constraints), lp_verbosity = as.integer(verbose), lp_presolve = as.integer(presolve), lp_time_limit = as.integer(time_limit), lp_status = integer(1), NAOK = TRUE, PACKAGE = "Rglpk") out } ## Convenience function for solving MILP objects ## upcoming ROI package (or for solving problems read with filereader) .ROI_glpk_solve <- function(x, control = list()){ if(!inherits(x, "MILP")) stop("'x' must be of class 'MILP'") if(is.null(control$verbose)) control$verbose <- FALSE Rglpk_solve_LP(x$objective, x$constraints[[1]], x$constraints[[2]], x$constraints[[3]], types = x$types, max = x$maximum, bounds = x$bounds, verbose = control$verbose) } Rglpk/R/milp.R0000644000175100001440000000146012435675425012652 0ustar hornikusers## MILP constructor ## borrowed from KH's relations package ## objective: numeric vector ## constraints: list [[1]] constr_mat ## [[2]] constr_dir, ## [[3]] constr_rhs), ## integers: ## maximum: logical MILP <- function(objective, constraints, bounds = NULL, types = NULL, maximum = FALSE) { ## In the simples case, 'constraints' is a (not necessarily named) ## list with mat, dir and rhs. Advanced solvers might allow for ## more advanced constraints, but let's worry about this later (and ## maybe also a little MILP_constraints() wrapper ...). structure(list(objective = slam::as.simple_triplet_matrix(objective), constraints = constraints, bounds = bounds, types = types, maximum = maximum), class = "MILP") } Rglpk/R/control.R0000644000175100001440000000202012727574470013364 0ustar hornikusers.check_control_parameters <- function( control ){ stopifnot(is.list(control)) ## Default paramenters (currently only verbosity supported) out <- list(verbose = FALSE, presolve = FALSE, tm_limit = 0L, canonicalize_status = TRUE) out[names(control)] <- control if (!is.null(out$verbose)) { out$verbose <- as.integer(out$verbose) if (!out$verbose %in% c(0L, 1L)) { warning("Improper value for 'verbose' parameter. Using default.") out$verbose <- 0L } } if (!is.null(out$presolve)) { out$presolve <- as.integer(out$presolve) if (!out$presolve %in% c(0L, 1L)) { warning("Improper value for 'presolve' parameter. Using default.") out$verbose <- 0L } } if (!is.null(out$canonicalize_status)) { out$canonicalize_status <- as.logical(out$canonicalize_status) } if( !is.null(control$tm_limit) ) out$tm_limit <- as.integer(out$tm_limit) out } Rglpk/R/Misc.R0000644000175100001440000000247712435675425012615 0ustar hornikusers## Miscellaneous functions used in this package ## Get the right representation of integer vector. ## This function takes an index vector and returns a vector of logicals ## with length 'n'. #glp_integers <- #function(x, n) #{ # if(!all(x <= n)) #stop("Indices must not exceed the number of objective coefficients.") # out <- logical(n) # out[x] <- TRUE # out #} print.MP_data_from_file <- function(x, ...){ if(!inherits(x, "MP_data_from_file")) stop("'x' must be of class 'MP_data_from_file'") if(attr(x, "n_integer_vars") > 0L){ writeLines(paste("A mixed integer linear program with", attr(x, "n_objective_vars"), "objective variables,")) writeLines(paste(attr(x, "n_integer_vars"), "are integer and", attr(x, "n_binary_vars"), "of which are binary variables.")) writeLines(paste("This problem has", attr(x, "n_constraints"), "constraints with", attr(x, "n_nonzeros"), "non-zero values in the constraint matrix.")) } else{ writeLines(paste("A linear program with", attr(x, "n_objective_vars"), "objective variables.")) writeLines(paste("This problem has", attr(x, "n_constraints"), "constraints with", attr(x, "n_nonzeros"), "non-zero values in the constraint matrix.")) } } Rglpk/R/bounds.R0000644000175100001440000000601512435675425013204 0ustar hornikusers## bounds of objective coefficients ## fixes the GLPK bound types given a data.frame with bounds ## GLP_FR 1 free variable ## GLP_LO 2 variable with lower bound ## GLP_UP 3 variable with upper bound ## GLP_DB 4 double-bounded variable ## GLP_FX 5 fixed variable 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, 2L), ifelse(is.finite(x$upper), 3L, 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, ...) ## ## A generic function which allows to take different dense and sparse ## representations of bounds. as.glp_bounds <- function(x, ...) UseMethod("as.glp_bounds") ## No default representation. as.glp_bounds.default <- function(x) stop("There is no default method for bounds representations.") ## returns identity as.glp_bounds.bound_table <- function(x, n) x ## list -> GLPK bounds representation as.glp_bounds.list <- function(x, n) glp_bounds(x, n) 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), lower = 0.0, upper = Inf) class(bound_table) <- c("bound_table", class(bound_table)) ## Lower bounds lower <- x$lower ## check for zero-length bounds if( !any(unlist(lapply(lower, length))) ) lower <- NULL if(!is.null(lower)){ ## input validation glp_bounds_check_sanity(lower, n) if(any(lower[[1L]] == Inf)) stop("Lower bound cannot be 'Inf'") ## if everything is OK set new lower bounds bound_table[lower[[1L]], 2L] <- lower[[2L]] } ## Upper bounds upper <- x$upper ## check for zero-length bounds if( !any(unlist(lapply(upper, length))) ) upper <- NULL if(!is.null(upper)){ ## input validation glp_bounds_check_sanity(upper, n) if(any(upper[[1L]] == -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[[1L]], 2L] > upper[[2L]])) stop("Upper bounds have to be greater than or equal to lower bounds") bound_table[upper[[1L]], 3L] <- upper[[2L]] } ## 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[[1L]]) != length(x[[2L]])) stop("Length of bound indices must be equal to the length of the corresponding bound values.") if(any(duplicated(x[[1L]]))) stop("Duplicated entries in bound indices found.") if((max(x[[1L]]) > n)) stop("Bound indices must not exceed number of objective coefficients.") } Rglpk/R/zzz.R0000644000175100001440000000056012435675425012546 0ustar hornikusers.onLoad <- function(libname, pkgname){ ## initialize print routines .C("Rglpk_initialize", PACKAGE = pkgname) } .onAttach <- function(libname, pkgname){ version <- .C( "Rglpk_get_engine_version", GLPK_version = character(1L), PACKAGE = pkgname ) packageStartupMessage( sprintf("Using the GLPK callable library version %s", version) ) } Rglpk/R/filereader.R0000644000175100001440000002773012435675425014023 0ustar hornikusers## Reads linear programs from MPS files ## uses GLPK's facilities for reading these files ## Interface to GLPK's MPS file reader ## Since 2012-01-11: Rglpk supports MathProg files and retrieves ## variables names and constraints names. Thanks to Michael Kapler! ## Input: Path to a file specifying a mathematical program (MP), ## the model specification language ## Output: an object of class 'MP_data_from_file' describing the MP ## Mathematical Programming (MP) Data Object (consisting of 2 parts) ## o MILP class ##$objective ... a 1 x n simple_triplet_matrix representing objective coeffs ##$constraints[[1]] ... a m x n simple_triplet_matrix specifying the constraints ##$constraints[[2]] ... contains the m direction of constraints ##$constraints[[3]] ... vector of m right hand side values ##$bounds ... a list with elements $upper and $lower. Each of which contains indices and bounds of objective variables ##$types ... a character vector specifying which objective variable is of type 'binary' (B), continuous (C), or 'integer' (I) ##$maximum ... can be either 'min' or 'max' ## o ATTRIBUTES ##$n_objective_vars ... number of objective variables ##$n_integer_vars ... number of variables which are of type 'integer' ##$n_binary_vars ... number of variables which are of type 'binary' ##$n_constraints ... number of constraints ##$n_nonzero ... number of values in constraint matrix ##$problem_name ... name of the problem ##$objective_name ... name of the problem ##$constraint_names ... names of the constraints ##$objective_vars_names ... names of the objective vars ##$file_name ... absolute path to original data file ##$file_type ... file type (currently 'MPS-fixed', 'MPS-free', 'CPLEX LP', 'MathProg') Rglpk_read_file <- function(file, type = c("MPS_fixed", "MPS_free", "CPLEX_LP", "MathProg"), ignore_first_row = FALSE, verbose = FALSE){ if(!file.exists(file)) stop(paste("There is no file called", file, "!")) ## which file type to read from type <- match.arg(type) type_db <- c("MPS_fixed" = 1L, "MPS_free" = 2L, "CPLEX_LP" = 3L, "MathProg" = 4L ) type <- type_db[type] obj <- list(file = tools::file_path_as_absolute(file), type = type) ## read files in a two step approach ## first, retrieve meta data: e.g., the number of objective variables, etc. ## we need this to allocate memory on the R level for the result vectors meta_data <- glp_get_meta_data_from_file(obj, verbose) ## second, read all remaining data milp_data <- glp_retrieve_MP_from_file(meta_data, ignore_first_row, verbose) ## merge everything together MP_data <- glp_merge_MP_data(meta_data, milp_data) ## Post processing MP_data$type <- names(type_db[type_db == MP_data$type]) ## and a direction '<=' dir_db <- c("FR" = 1L, ">=" = 2L, "<=" = 3L, "DB" = 4L, "==" = 5L) MP_data$direction_of_constraints <- names(dir_db[MP_data$direction_of_constraints]) ## we remove constraints marked as unbounded (GLP_FR) ind_FR <- MP_data$direction_of_constraints == "FR" if(any(ind_FR)){ MP_data$constraint_matrix <- MP_data$constraint_matrix[ !ind_FR, ] MP_data$right_hand_side <- MP_data$right_hand_side[ !ind_FR ] MP_data$left_hand_side <- MP_data$left_hand_side[ !ind_FR ] MP_data$direction_of_constraints <- MP_data$direction_of_constraints[ !ind_FR ] MP_data$constraint_names <- MP_data$constraint_names[ !ind_FR ] MP_data$n_constraints <- MP_data$n_constraints - sum( ind_FR ) } ## we add an additional constraint for double bounded constraints(GLP_DB) ind_DB <- MP_data$direction_of_constraints == "DB" if(any(ind_DB)){ n_double_bounded <- sum( ind_DB ) MP_data$constraint_matrix <- rbind( MP_data$constraint_matrix, MP_data$constraint_matrix[ ind_DB, ] ) ## upper bounds already in rhs vector MP_data$direction_of_constraints[ ind_DB ] <- "<=" length(MP_data$direction_of_constraints) <- length(MP_data$direction_of_constraints) + sum(ind_DB) MP_data$direction_of_constraints[is.na(MP_data$direction_of_constraints)] <- ">=" length(MP_data$right_hand_side) <- length(MP_data$right_hand_side) + sum(ind_DB) MP_data$right_hand_side[is.na(MP_data$right_hand_side)] <- MP_data$left_hand_side[ind_DB ] MP_data$constraint_names <- c(MP_data$constraint_names, MP_data$constraint_names[ ind_DB ]) MP_data$n_constraints <- MP_data$n_constraints + sum( ind_DB ) } ## default is to have only continuous variables ## if any is binary or integer set the value accordingly types <- rep("C", length.out = MP_data$n_objective_vars) if(any(MP_data$objective_var_is_integer)){ types[MP_data$objective_var_is_integer] <- "I" } if(any(MP_data$objective_var_is_binary)){ types[MP_data$objective_var_is_binary] <- "B" } ## recalculate number of nonzeroes MP_data$n_values_in_constraint_matrix <- length(MP_data$constraint_matrix$v) ## build object we want to return ## First add MILP to the object out <- MILP(objective = MP_data$objective_coefficients, constraints = list(MP_data$constraint_matrix, MP_data$direction_of_constraints, MP_data$right_hand_side), bounds = MP_data$bounds, types = types, maximum = MP_data$maximize ) attr(out, "n_objective_vars") <- MP_data$n_objective_vars attr(out, "n_integer_vars") <- MP_data$n_integer_vars attr(out, "n_binary_vars") <- MP_data$n_binary_vars attr(out, "n_constraints") <- MP_data$n_constraints attr(out, "n_nonzeros") <- MP_data$n_values_in_constraint_matrix attr(out, "problem_name") <- MP_data$problem_name attr(out, "objective_name") <- MP_data$objective_name attr(out, "objective_vars_names") <- MP_data$objective_vars_names attr(out, "constraint_names") <- MP_data$constraint_names attr(out, "file_type") <- MP_data$type attr(out, "file_name") <- MP_data$file class(out) <- c("MP_data_from_file", class(out)) out } ## First parse file to get some meta data of the LP/MILP ## (number of constraints/objective variables, direction of optimization, ...) glp_get_meta_data_from_file <- function(x, verbose){ res <- .C("Rglpk_read_file", file = as.character(x$file), type = as.integer(x$type), direction_of_optimization = integer(1L), n_constraints = integer(1L), n_objective_vars = integer(1L), n_values_in_constraint_matrix = integer(1L), n_integer_vars = integer(1L), n_binary_vars = integer(1L), problem_name = character(1L), objective_name = character(1L), verbosity = as.integer(verbose), PACKAGE = "Rglpk") ## free memory by deleting C-level problem object .C("Rglpk_delete_prob", PACKAGE = "Rglpk") res } ## Retrieve all missing elements of the LP/MILP glp_retrieve_MP_from_file <- function(x, ignore_first_row, verbose = FALSE){ res <- .C("Rglpk_retrieve_MP_from_file", file = as.character(x$file), type = as.integer(x$type), n_constraints = x$n_constraints, n_objective_vars = x$n_objective_vars, objective_coefficients = double(x$n_objective_vars), constraint_matrix_i = integer(x$n_values_in_constraint_matrix), constraint_matrix_j = integer(x$n_values_in_constraint_matrix), constraint_matrix_values = double(x$n_values_in_constraint_matrix), direction_of_constraints = integer(x$n_constraints), right_hand_side = double(x$n_constraints), left_hand_side = double(x$n_constraints), objective_var_is_integer = integer(x$n_objective_vars), objective_var_is_binary = integer(x$n_objective_vars), bounds_type = integer(x$n_objective_vars), bounds_lower = double(x$n_objective_vars), bounds_upper = double(x$n_objective_vars), lp_ignore_first_row = as.integer(ignore_first_row), verbosity = as.integer(verbose), constraint_names = rep(character(1L), x$n_constraints), objective_vars_names = rep(character(1L), x$n_objective_vars), PACKAGE = "Rglpk") ## free memory by deleting C-level problem object .C("Rglpk_delete_prob", PACKAGE = "Rglpk") ## lp_is_integer = as.integer(lp_is_integer), ## replace infinity values res$bounds_lower <- replace(res$bounds_lower, res$bounds_lower == -.Machine$double.xmax, -Inf) res$bounds_upper <- replace(res$bounds_upper, res$bounds_upper == .Machine$double.xmax, Inf) ## in MPS definition first row is sometimes problematic. E.g., in MIPLIB2003 ## it has to be removed! if(ignore_first_row){ res$n_constraints <- res$n_constraints - 1 ## zeros values in the constraint matrix have to be removed, these ## are the values from the first row to_remove <- which(res$constraint_matrix_values == 0) res$constraint_matrix_i <- res$constraint_matrix_i[-to_remove] - 1 res$constraint_matrix_j <- res$constraint_matrix_j[-to_remove] res$constraint_matrix_values <- res$constraint_matrix_values[-to_remove] res$right_hand_side <- res$right_hand_side[-1] res$left_hand_side <- res$left_hand_side[-1] #res$direction_of_constraints <- res$direction_of_constraints[-length(res$right_hand_side)] } res } glp_merge_MP_data <- function(x, y){ out <- list(objective_coefficients = y$objective_coefficients, constraint_matrix = simple_triplet_matrix( y$constraint_matrix_i, y$constraint_matrix_j, y$constraint_matrix_values, y$n_constraints, y$n_objective_vars), direction_of_constraints = y$direction_of_constraints, right_hand_side = y$right_hand_side, left_hand_side = y$left_hand_side, objective_var_is_integer = as.logical(y$objective_var_is_integer), objective_var_is_binary = as.logical(y$objective_var_is_binary), ## minimization if GLP_MIN (1L) or max if GLP_MAX (2L) maximize = x$direction_of_optimization == 2L, bounds = list(lower = list(ind = 1L:x$n_objective_vars, val = y$bounds_lower), upper = list(ind = 1L:x$n_objective_vars, val = y$bounds_upper)), n_objective_vars = x$n_objective_vars, n_integer_vars = x$n_integer_vars, n_binary_vars = x$n_binary_vars, ## here from y because it might have changed -> ignore_first_row_parameter n_constraints = y$n_constraints, n_values_in_constraint_matrix = x$n_values_in_constraint_matrix, ## problem_name = x$problem_name, file = x$file, type = x$type, problem_name = x$problem_name, objective_name = x$objective_name, constraint_names = y$constraint_names, objective_vars_names = y$objective_vars_names ) out } Rglpk/MD50000644000175100001440000000241612730050053011655 0ustar hornikusers2b0e21215a77ec0bf21714aa61cd3163 *DESCRIPTION 5a45a9a2b361ccbdb0960632f3b7cfd8 *NAMESPACE 89802f16b53ebb2fb07679fb89ac7b33 *R/Misc.R e7e782abb3d433766b8c4d28118b9f87 *R/Rglpk_solve.R d4b39ae0e53f3ee9e1e23c5de5cec533 *R/bounds.R 1697e847ac1d653ac49b23e7393d758c *R/control.R faa5f26eb76db3d27ef13252da904d5e *R/filereader.R f8672da398fee3461bded8d8de6cec02 *R/milp.R 9a3dde9c92c8c109ba717446f2d7b2b2 *R/zzz.R 5299c161b149974ccae263af06494afc *cleanup 1262f7a12fddb89ebbe29f58c04a1c00 *configure 68b329da9893e34099c7d8ad5cb9c940 *configure.win 014d1c8deaa10cb011bb29c391f505cf *inst/CHANGELOG bdee58c3965c7b68c5923ee60183e736 *inst/examples/assign.mod 72aa9eab3996ee9aa7abeaeb4c05ff12 *inst/examples/plan.lp 45e60857cbfdfb15805eb12cc2e17d94 *inst/examples/plan.mod 0a0c722569a00b732639ed320453181c *inst/examples/plan.mps 9e22c38d5268676761f77a2c82020cf8 *man/Rglpk_read_file.Rd cbc6f245b8b610ec1cac22cd665e4341 *man/Rglpk_solve.Rd 16928375c376f342565f9f81b85aff65 *src/Makevars.in 82b5dfd7323f3bba9c092029c5ee25d7 *src/Makevars.win 00cf4d6bd6d46443d99cb7ebe5b53403 *src/Rglpk.h 52bc8e948dd2a9d1d5a5105c3780aa3e *src/Rglpk_error.c 5622e753d3d13b4bf264756073cbc667 *src/Rglpk_initialize.c f0c2674ec4184bca3eebbbeaadfb5cb2 *src/Rglpk_read_file.c c1264cc9d3ac93788b0b96bbe320c171 *src/Rglpk_solve.c Rglpk/DESCRIPTION0000644000175100001440000000201712730050053013050 0ustar hornikusersPackage: Rglpk Version: 0.6-2 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), mixed integer linear programming (MILP) and other related problems. Authors@R: c(person("Stefan", "Theussl", role = c("aut", "cre"), email = "Stefan.Theussl@R-project.org"), person("Kurt", "Hornik", role = "aut"), person("Christian", "Buchta", role = "ctb"), person("Heinrich", "Schuchardt", role = "ctb")) Depends: slam (>= 0.1-9) SystemRequirements: GLPK library package (e.g., libglpk-dev on Debian/Ubuntu) License: GPL-2 | GPL-3 URL: http://R-Forge.R-project.org/projects/rglp/, http://www.gnu.org/software/glpk/ NeedsCompilation: yes Packaged: 2016-06-13 20:40:51 UTC; theussl Author: Stefan Theussl [aut, cre], Kurt Hornik [aut], Christian Buchta [ctb], Heinrich Schuchardt [ctb] Maintainer: Stefan Theussl Repository: CRAN Date/Publication: 2016-06-14 20:42:51 Rglpk/configure0000755000175100001440000000262412435675425013277 0ustar hornikusers#! /bin/sh ## For the time being, this is a simple shell script ... ## Test whether a complete GLPK library environment is available, ## e.g. ftp://ftp.gnu.org/gnu/glpk/ ## 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" GLPK_LIBS="-lglpk" ## Test whether we can compile and link a minimal program. rm -f conftest.* cat > conftest.cc < int main () { glp_prob *lp; lp = glp_create_prob(); glp_delete_prob(lp); return 0; } EOF _R_SHLIB_BUILD_OBJECTS_SYMBOL_TABLES_=false \ "${R}" CMD SHLIB conftest.cc ${GLPK_LIBS} >/dev/null 2>&1 \ && "$R" --slave --vanilla -e 'dyn.load("conftest.so")' status=${?} if test ${status} -ne 0; then rm -f conftest.*o GLPK_LIBS="-lglpk -lgmp -lm" _R_SHLIB_BUILD_OBJECTS_SYMBOL_TABLES_=false \ "${R}" CMD SHLIB conftest.cc ${GLPK_LIBS} >/dev/null 2>&1 \ && "$R" --slave --vanilla -e 'dyn.load("conftest.so")' status=${?} fi rm -f conftest.* if test ${status} -eq 0; then GLPK_INCLUDE_PATH= GLPK_LIB_PATH= GLPK_TS= else GLPK_INCLUDE_PATH="-IGLPK" GLPK_LIB_PATH="-LGLPK" GLPK_LIBS="-lglpk" GLPK_TS="GLPK.ts" fi sed -e "s|@GLPK_INCLUDE_PATH@|${GLPK_INCLUDE_PATH}|" \ -e "s|@GLPK_LIB_PATH@|${GLPK_LIB_PATH}|" \ -e "s|@GLPK_LIBS@|${GLPK_LIBS}|" \ -e "s|@GLPK_TS@|${GLPK_TS}|" \ src/Makevars.in > src/Makevars Rglpk/man/0000755000175100001440000000000012727613642012134 5ustar hornikusersRglpk/man/Rglpk_solve.Rd0000644000175100001440000001432612727615073014720 0ustar hornikusers\name{Rglpk_solve_LP} \alias{Rglpk_solve_LP} \title{Linear and Mixed Integer Programming Solver Using GLPK} \description{ High level R interface to the GNU Linear Programming Kit (GLPK) for solving linear as well as mixed integer linear programming (MILP) problems. } \usage{ Rglpk_solve_LP(obj, mat, dir, rhs, bounds = NULL, types = NULL, max = FALSE, control = list(), \ldots) } \arguments{ \item{obj}{a numeric vector representing the objective coefficients.} \item{mat}{a numeric vector or a (sparse) matrix of constraint coefficients. If the optimization problem is unconstrained then a matrix of dimension 0 times the number of objective variables is required.} \item{dir}{a character vector with the directions of the constraints. For a nonzero number of constraints each element must be one of \code{"<"}, \code{"<="}, \code{">"}, \code{">="}, or \code{"=="}.} \item{rhs}{a numeric vector representing 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 indicating the types of the objective variables. \code{types} can be either \code{"B"} for binary, \code{"C"} for continuous or \code{"I"} for integer. By default \code{NULL}, 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{control}{a list of parameters to the solver. See *Details*.} \item{\ldots}{a list of control parameters (overruling those specified in \code{control}).} } \details{ GLPK is open source. The current version can be found at \url{http://www.gnu.org/software/glpk/glpk.html}. Package \pkg{Rglpk} provides a high level solver function using the low level C interface of the GLPK solver. R interface packages which port all low level C routines of the GLPK API to R are also available. Consult the \sQuote{See Also} Section for references. Matrix \code{mat} and \code{obj} may be sparse arrays or matrices (\code{simple_triplet_matrix}) as provided by the \pkg{slam} package. The \code{control} argument can be used to set GLPK's many parameters. See the respective method section of the \cite{GNU Linear Programming Kit Reference Manual} for further details. The following parameters are supported: \describe{ \item{verbose:}{turn GLPK terminal output on (\code{TRUE}) or off (\code{FALSE}, the default).} \item{presolve:}{turn presolver on (\code{TRUE}) or off (\code{FALSE}, the default).} \item{tm_limit:}{time limit in milliseconds of call to optimizer. Can be any nonnegative integer. Default: 0 (use GLPK default).} \item{canonicalize_status:}{a logical indicating whether to canonicalize GLPK status codes (on success \code{Rglpk_solve_LP()} returns code 0) or not (1). Default: \code{TRUE}.}} } \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. If the control parameter \code{canonicalize_status} is set (the default) then it will return 0 for the optimal solution being found, and non-zero otherwise. If the control parameter is set to \code{FALSE} it will return the GLPK status codes.} \item{solution_dual}{variable reduced cost, if available (\code{NA} otherwise).} \item{auxiliary}{a list with two vectors each containing the values of the auxiliary variable associated with the respective constraint at solution, primal and dual (if available, \code{NA} otherwise).} } \references{ GNU Linear Programming Kit (\url{http://www.gnu.org/software/glpk/glpk.html}). GLPK Interface to R (\url{http://cran.R-project.org/package=Rglpk}). } \author{Stefan Theussl and Kurt Hornik} \seealso{ \pkg{glpk} and \pkg{glpkAPI} for C API bindings; \code{\link[lpSolve]{lp}} in package \pkg{lpSolve}; \code{\link[ROI]{ROI_solve}} in package \pkg{ROI}; \code{\link[Rsymphony]{Rsymphony_solve_LP}} in package \pkg{Rsymphony}. } \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 + 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, 2, 2), nrow = 3) dir <- c("<=", "<=", "<=") rhs <- c(60, 40, 80) max <- TRUE Rglpk_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) types <- c("I", "C", "I") max <- TRUE Rglpk_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))) Rglpk_solve_LP(obj, mat, dir, rhs, bounds, types, max) ## Examples from the GLPK manual ## Solver output enabled ## 1.3.1 ## maximize: 10 x_1 + 6 x_2 + 4 x_3 ## subject to: x_1 + x_2 + x_3 <= 100 ## 10 x_1 + 4 x_2 + 5 x_3 <= 600 ## 2 x_1 + 2 x_2 + 6 x_3 <= 300 ## x_1, x_2, x_3 are non-negative real numbers obj <- c(10, 6, 4) mat <- matrix(c(1, 10, 2, 1, 4, 2, 1, 5, 6), nrow = 3) dir <- c("<=", "<=", "<=") rhs <- c(100, 600, 300) max <- TRUE Rglpk_solve_LP(obj, mat, dir, rhs, max = max, control = list("verbose" = TRUE, "canonicalize_status" = FALSE)) } \keyword{optimize} Rglpk/man/Rglpk_read_file.Rd0000644000175100001440000000674512435675425015513 0ustar hornikusers\name{Rglpk_read_file} \alias{Rglpk_read_file} \alias{print.MP_data_from_file} \title{Interface to GLPK's file reader} \description{ High level R interface to the CPLEX\_LP, MATHPROG and MPS reader of the GNU Linear Programming Kit (GLPK). Example data from the GLPK release is included in the \code{'./examples/'} sub-directory. } \usage{ ## File reader for various formats Rglpk_read_file(file, type = c("MPS_fixed", "MPS_free", "CPLEX_LP", "MathProg"), ignore_first_row = FALSE, verbose = FALSE) ## print method \method{print}{MP_data_from_file}(x, \ldots) } \arguments{ \item{file}{a character string specifying the relative or absolute path to the model file.} \item{type}{a character string specifying the file format. This can be either \code{"MPS_fixed"}, \code{"MPS_free"}, \code{"CPLEX_LP"}, and GNU \code{"MathProg"}.} \item{ignore_first_row}{a logical indicating whether the first row of the model file should be ignored or not. Default: \code{FALSE}.} \item{verbose}{a logical for turning on/off additional solver output. Default: \code{FALSE}.} \item{x}{an object of class \code{"MP_data_from_file"}.} \item{\ldots}{further arguments passed on to the print method.} } \details{\code{Rglpk_read_file()} takes the path to a file as an argument and calls GLPK's file reader. The description of the linear or mixed integer linear program is returned as an object of class \code{"MP_data_from_file"}. } \value{ \code{Rglpk_read_file()} returns the specification of a (mixed integer) linear program defined in \code{file} as an object of class \code{"MP_data_from_file"}. The returned object is a list containing the following components. \item{objective}{a \code{"\link[slam]{simple_triplet_matrix}"} representing the coefficients to \eqn{x} in the objective function.} \item{constraints}{a list with three elements: a \code{"\link[slam]{simple_triplet_matrix}"} of coefficients, a character vector of constraint directions, and a numeric vector representing the right hand side.} \item{bounds}{a list containing two elements: \code{lower} and \code{upper}. Each of which contain a list specifying indices (\code{ind}) and corresponding bounds (\code{val}).} \item{types}{a character vector specifying whether the corresponding objective variable is of type binary (\code{"B"}), continuous (\code{"C"}), or integer (\code{"I"}).} \item{maximum}{a logical indicating whether a minimum or a maximum is sought.} Further meta data is provided as attributes to the object. } %%\references{} \author{Stefan Theussl} %%\seealso{} \examples{ ## read a CPLEX LP file x <- Rglpk_read_file( system.file(file.path("examples", "plan.lp"), package = "Rglpk"), type = "CPLEX_LP") x ## optimal solution: 296.2166 Rglpk_solve_LP(x$objective, x$constraints[[1]], x$constraints[[2]], x$constraints[[3]], x$bounds, x$types, x$maximum) ## read a MATHPROG file x <- Rglpk_read_file( system.file(file.path("examples", "assign.mod"), package = "Rglpk"), type = "MathProg") x ## optimal solution: 76 Rglpk_solve_LP(x$objective, x$constraints[[1]], x$constraints[[2]], x$constraints[[3]], x$bounds, x$types, x$maximum) ## read a MATHPROG file x <- Rglpk_read_file( system.file(file.path("examples", "plan.mps"), package = "Rglpk"), type = "MPS_fixed") x ## optimal solution: 296.2166 Rglpk_solve_LP(x$objective, x$constraints[[1]], x$constraints[[2]], x$constraints[[3]], x$bounds, x$types, x$maximum) } \keyword{IO} \keyword{utilities} Rglpk/configure.win0000644000175100001440000000000112435675425014053 0ustar hornikusers Rglpk/cleanup0000755000175100001440000000027112435675425012741 0ustar hornikusers#! /bin/sh (cd src/GLPK; if test -f Makefile; then make distclean || true make distclean SUBDIRS= || true fi) rm -f config.* autom4te.cache src/GLPK.ts src/Makevars exit 0