1% BEGIN LICENSE BLOCK 2% Version: CMPL 1.1 3% 4% The contents of this file are subject to the Cisco-style Mozilla Public 5% License Version 1.1 (the "License"); you may not use this file except 6% in compliance with the License. You may obtain a copy of the License 7% at www.eclipse-clp.org/license. 8% 9% Software distributed under the License is distributed on an "AS IS" 10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11% the License for the specific language governing rights and limitations 12% under the License. 13% 14% The Original Code is The ECLiPSe Constraint Logic Programming System. 15% The Initial Developer of the Original Code is Cisco Systems, Inc. 16% Portions created by the Initial Developer are 17% Copyright (C) 2006 Cisco Systems, Inc. All Rights Reserved. 18% 19% Contributor(s): Joachim Schimpf and Kish Shen, IC-Parc 20% 21% END LICENSE BLOCK 22% 23% Description: ECLiPSe/CPLEX interface 24% 25% System: ECLiPSe Constraint Logic Programming System 26% Author/s: Joachim Schimpf, IC-Parc 27% Kish Shen, IC-Parc 28% Version: $Id: eplex_.ecl,v 1.17 2015/01/14 01:31:08 jschimpf Exp $ 29% 30% TODO: 31% - cplex_change_col_type: accept list 32% - elimiate cplex_type_code/2 (use atoms) 33% - review role of our own probtype flag (only for probes?) 34 35 36:- lib(linearize). 37%:- lib(var_name). % load only if needed! 38:- lib(hash). 39:- lib(constraint_pools). 40 41%:- set_flag(toplevel_module,eplex). % debugging 42 43 44% Ranged Variables ---------- 45 46:- export deletemostfract/4. % deletemostfract(-Var, +List, +Handle, -Rest) 47:- export deletefract/5. % deletefract(-Var, +List, +Handle, +Tolerance, -Rest) 48:- export int_tolerance/1. 49 50% Constraints ---------- 51 52:- export add_constraint/1. % add_constraint(+Constraint) 53:- export lp_add_constraints/3. % lp_add_constraints(+Handle, +Constraints, +Integers) 54:- export lp_add_constraints/4. % lp_add_constraints(+Handle, +Constraints, +Int, -Indices) 55:- export lp_add_cutpool_constraints/4. % lp_add_cutpool_constraints(+Handle, +Constraints, +Options, -Indices). 56:- tool(add_constraint/1, add_pool_constraint/2). 57 58% Versions and licensing ---------- 59 60:- export lp_get_license/0. % lp_get_license 61:- export lp_get_license/2. % lp_get_license(+LicStr, +LicNum) 62:- export lp_release_license/0. % lp_release_license 63:- export lp_get_license_challenge/1. % lp_get_license_challenge(-Challenge) 64 65:- skipped lp_get_license/2. % hide licensing-related stuff 66:- untraceable lp_get_license/2. 67:- untraceable lp_get_license_challenge/1. 68 69% Simplified high-level solver invocation ---------- 70 71:- export optimize/2. % optimize(+Objective, -Cost) 72:- export optimize/3. % optimize(+Objective, +Options, -Cost) 73 74:- tool(optimize/2, optimize_body/3). 75:- tool(optimize/3, optimize_body/4). 76 77% Constraints manipulation ---------- 78 79:- export normalise_cstrs/3. % normalise_cstrs(+Constraints, 80 % -NormConstraints, -NonlinConstraints) 81:- export collect_lp_constraints_norm/1. 82 % collect_lp_constraints_norm(-NormConstraints) 83:- export collect_integers/1. % collect_integers(-Integers) 84:- export collect_reals/1. % collect_reals(-Reals) 85:- export normalise_cstr/2. 86:- export renormalise_cstrs/2. 87:- export renormalise_cstr/2. 88:- export denormalise_cstr/2. 89 90% Explicit solver handling ---------- 91 92:- export lp_setup/4. % lp_setup(+NormConstraints, +Objective, 93 % +Options, -Handle) 94:- export lp_add/3. % lp_add(+Handle, +NormConstraints, +Integers) 95:- export lp_cleanup/1. % lp_cleanup(+Handle) 96:- export lp_get/3. % lp_get(+Handle, +What, -Data) 97:- export lp_set/3. % lp_set(+Handle, +What, +Data). 98:- export lp_solve/2. % lp_solve(+Handle, -Cost) 99:- export lp_probe/3. % lp_probe(+Handle, +TmpObjective, -Cost). 100 101:- export lp_add_indexed/4. % lp_add_indexed(+Handle, +NormConstraints, +Ints, -Indices) 102:- export lp_add_vars/2. % lp_add_vars(+Handle, +Vars) 103:- export lp_add_columns/2. % lp_add_columns(+Handle, +VarCols) 104 105:- export lp_demon/5. % lp_demon(+Handle, ?Cost, +PreGoal, +PostGoal, +Module) 106:- export lp_demon_setup/5. % lp_demon_setup(+Objective, ?Cost, +Options, 107 % +TriggerModes, -Handle[,+Module]) 108:- export lp_demon_setup/6. % obsolete 109:- export lp_write/3. % lp_write(+Handle, +Format, +File) 110:- export lp_read/3. % lp_read(+File, +Format, -Handle) 111 112:- export lp_set/2. % lp_set(+Param, +Value) 113:- export lp_get/2. % lp_get(+Param, -Value) 114:- export lp_var_get/3. % lp_var_get(+Var, +What, -Value) obsolete 115:- export lp_var_get/4. % lp_var_get(+Handle, +Var, +What, -Value) 116:- export lp_var_solution/2. % lp_var_solution(+Var,-Value) obsolete 117:- export lp_var_solution/3. % lp_var_solution(+Handle, +Var, -Value) 118:- export lp_var_occurrence/3. % lp_var_occurrence(+Var, -Handle, -Index) 119 120:- export lp_var_set_bounds/4. % lp_var_set_bounds(+Handle, +Var, +Lo, +Hi) 121:- export lp_var_non_monotonic_set_bounds/4. 122 % lp_var_non_monotonic_set_bounds(+Handle, +Var, +Lo, +Hi) 123:- export lp_var_get_bounds/4. % lp_var_get_bounds(+Handle, +Var, -Lo, -Hi) 124 125:- export lp_get_iis/5. % lp_get_iis(+Handle, -NCstrs, -NCVars, -CCstrIdxs, -CVarStats) 126:- export lp_verify_solution/3. % lp_verify_solution(+Handle, -ViolatedCstrs, -ViolatedVars) 127 128:- tool(lp_demon_setup/6,lp_demon_setup_body/7). 129:- tool(lp_demon_setup/5,lp_demon_setup_body/6). 130:- tool(lp_setup/4,lp_setup_body/5). 131 132:- export solution_out_of_range/1. % solution_out_of_range(+Handle) 133:- export instantiation_deviates/1. % instantiation_deviates(+Handle) 134 135 136% Handler ---------- 137 138:- export lp_var_print/2. 139 140:- meta_attribute(eplex, [ 141 print:lp_var_print/2, 142 unify:unify_eplex/2, 143 get_bounds:lp_attr_get_bounds/3, 144 set_bounds:lp_attr_set_bounds/3, 145 suspensions:suspensions_eplex/3]). 146 147 148:- set_event_handler(lp_obj_nobounds_warning, lp_obj_nobounds_warning/0). 149 150 151% Change variable support 152:-export suspend_on_change/3. % (+Var, +Susp, +Pool) 153:-export get_changeable_value/3. % (+Var,-Val, +Pool) 154:-export lp_suspend_on_change/3. % (+Handle, +Var, +Susp) 155:-export lp_get_changeable_value/3. % (+Handle, +Var, -Val,) 156 157% Pools ----------- 158 159:- export eplex_instance/1. % eplex_instance(+PoolName) 160 161% Predicates with pool argments (don't reexport these in eplex!) 162:- export lp_eq/3. % =:=/2 163:- export lp_ge/3. % >=/2 164:- export lp_le/3. % =</2 165:- export lp_interval/3. % ::/2, $::/2 166:- export integers/2. % integers/1 167:- export reals/2. % reals/1 168:- export eplex_get/3. % eplex_get/2 169:- export eplex_set/3. % eplex_set/2 170:- export eplex_read/3. % eplex_read/2 171:- export eplex_write/3. % eplex_write/2 172:- export eplex_cleanup/1. % eplex_cleanup/0 173:- export eplex_probe/3. % eplex_probe/2 174:- export eplex_solve/2. % eplex_solve/1 175:- export eplex_var_get/4. % eplex_var_get/3 176:- export eplex_var_get_bounds/4. % eplex_var_get_bounds/3. 177:- export eplex_add_constraints/3. % eplex_add_constraints/2 178:- export eplex_get_iis/5. % eplex_get_iis/4 179:- export eplex_verify_solution/3. % eplex_verify_solution/2. 180 181:- local struct(constraint_type(integers,reals,linear,sos,idc)). 182:- local struct(probes(obj,sense,ints,rhs,bounds)). % types of probe in lp/eplex_probe 183 184% These operators are a subset of those in lib(ic) 185:- export op(700, xfx, [$>=, $=, $=<, $::]). 186:- export op(780, yfx, [=>]). 187:- export op(750, fx, [neg]). 188 189:- local struct(cp_options(group,active,add_initially)). % cutpool cstrs options 190 191valid_cp_opt(group, group of cp_options) :- !. 192valid_cp_opt(active, active of cp_options) :- !. 193valid_cp_opt(add_initially, add_initially of cp_options). 194 195valid_cp_optval(group, Name, Handle, PIdx) ?- 196 get_named_cp_index(Handle, Name, PIdx). 197valid_cp_optval(active, InVal, _, OutVal) ?- 198 ( InVal == 1 ; InVal == 0 ), !, 199 InVal = OutVal. 200valid_cp_optval(add_initially, InVal, _, OutVal) ?- 201 ( InVal == 1 ; InVal == 0 ), !, 202 InVal = OutVal. 203 204%---------------------------------------------------------------------- 205% Initialisation and licencing 206% 207% When lib(eplex) is loaded, we also load one of the solver interfaces. 208% 209% Several solver interfaces (cplex/xpress, different versions) might 210% be installed. Only one can be loaded, using the following criteria: 211% 212% Preferences can be specified by loading one of the specific 213% dummy libraries eplex_<solver>_<version> or eplex_<solver>. 214% lib(eplex) tests for the existence of modules of this name. 215% 216% When there is an eplex_lic_info.ecl file, we load the solver that 217% corresponds to the first matching entry in this file. 218% 219% If there is no eplex_lic_info.ecl file (runtime systems for example), 220% then we load any of the installed solvers. 221% 222% After loading, we try to obtain a license for the loaded solver. 223% If that is not possible, a warning is printed. 224%---------------------------------------------------------------------- 225 226:- import 227 symbol_address/2, 228 replace_attribute/3 229 from sepia_kernel. 230 231:- local variable(licence_data, none). % 'none' or held(LicStr,LicNum) 232:- local variable(loaded_solver, none). % 'none' or loaded(Solver,Version) 233:- local variable(presolve_default, 1). % 1 or 0 234:- local variable(timeout_default, 0.0). % non-negative float, 0.0 no timeout 235 236:- pragma(nodebug). % the licensing code should be untraceable! 237 238optimizer_code(cplex). 239optimizer_code(xpress). 240optimizer_code(osi). % treat the solver used as versions of OSI 241optimizer_code(gurobi). 242 243% selected_solver(-Solver, -Version) is det. 244 245selected_solver(Solver, Version) :- 246 current_module(EplexSolverVersion), 247 atom_string(EplexSolverVersion, EplexSolverVersionString), 248 split_string(EplexSolverVersionString, "_", "_", ["eplex",SolverS,VersionS]), 249 atom_string(Solver, SolverS), 250 optimizer_code(Solver), 251 atom_string(Version, VersionS), 252 !. 253selected_solver(Solver, _Version) :- 254 current_module(EplexSolver), 255 atom_string(EplexSolver, EplexSolverString), 256 split_string(EplexSolverString, "_", "_", ["eplex",SolverS]), 257 atom_string(Solver, SolverS), 258 optimizer_code(Solver), 259 !. 260selected_solver(_Solver, _Version). 261 262 263% licensed_solver(?Solver, ?Version, -LicStr, -LicNum) is nondet. 264% Return licensed solvers on backtracking (in order of preference) 265 266licensed_solver(Solver, Version, LicStr, LicNum) :- 267 get_flag(hostname, HostnameString), 268 atom_string(Hostname, HostnameString), 269 get_flag(installation_directory, EclipseDir), 270 concat_string([EclipseDir,'/lib/eplex_lic_info.ecl'], LicInfo), 271 get_file_info(LicInfo,readable,on), % may fail 272 open(LicInfo,read,S), 273 repeat, 274 read(S, T), 275 ( T == end_of_file -> close(S), !, fail ; true ), 276 T = licence(Hostname, Solver, Version, LicStr, LicNum). 277 278 279% installed_solver(?Solver, ?Version, -File) is nondet. 280% Return matching installed solvers on backtracking 281% secplexXY.so or sexpressXY.so are expected in the Arch subdirectory. 282% Must be called with the current directory being the library directory. 283 284installed_solver(Solver, Version, File) :- 285 get_flag(hostarch, Arch), 286 get_flag(object_suffix, O), 287 optimizer_code(Solver), 288 concat_string(["se",Solver], ESolver), 289 concat_string([ESolver,"*.",O], Pattern), 290 read_directory(Arch, Pattern, _, Files), 291 member(File, Files), 292 pathname(File, _, Base, _), 293 once append_strings(ESolver, VersionString, Base), 294 atom_string(Version, VersionString). 295 296 297% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 298% Try to load a solver interface 299% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 300 301% If the external solver is a dynamic library, 302% try to load it explicitly to avoid PATH problems (otherwise fail) 303 304load_external_solver(Arch, Solver, Version, Suffix) :- 305 ( Solver = cplex ; Solver == gurobi ), !, 306 concat_string([Solver,Version,".",Suffix], SolverLibName), 307 ( concat_string([Arch,/,SolverLibName], SolverLib) 308 ; concat_string([Arch,"/e",Solver,Version,/,SolverLibName], SolverLib) ), 309 exists(SolverLib), 310 catch(load(SolverLib), abort, fail). 311load_external_solver(Arch, xpress, Version, "dll") ?- !, 312 atom_string(Version, VersionString), 313 ( substring(VersionString, "13", 1) -> 314 concat_string([Arch,"/express",Version,"/xprs.dll"], SolverLib), 315 exists(SolverLib), 316 catch(load(SolverLib), abort, fail) 317 ; 318 concat_string([Arch,"/express",Version,"/xprl.dll"], SolverLib1), 319 exists(SolverLib1), 320 catch(load(SolverLib1), abort, fail), 321 concat_string([Arch,"/express",Version,"/xprs.dll"], SolverLib2), 322 exists(SolverLib2), 323 catch(load(SolverLib2), abort, fail) 324 ). 325load_external_solver(Arch, xpress, Version, "so") ?- 326 atom_string(Version, VersionString), 327 \+ substring(VersionString, "13", 1), !, % assume this means > 13 328 % unfortunately Solaris needs the version specific .so files 329 % (i.e. *.so.<Version>). So the directory should contain only 330 % one version of each lib file 331 concat_string([Arch, "/express",Version], SolverDir), 332 read_directory(SolverDir, "libxprl.so*", _, [LicLib|_]), 333 concat_string([SolverDir, "/", LicLib], LicPath), 334 load(LicPath), 335 read_directory(SolverDir, "libxprs.so*", _, [SolverLib|_]), 336 concat_string([SolverDir, "/", SolverLib], SolverPath), 337 load(SolverPath). 338load_external_solver(_, _, _, _). 339 340:- 341 % we want one of the solvers that have been asked for 342 % in order of preference (if specified in eplex_lic_info.ecl) 343 findall(solver(Solver, Version), ( 344 selected_solver(Solver, Version), 345 ( licensed_solver(Solver,Version,_LS,_LN) ; true ) 346 ), 347 Candidates), 348 ( 349 % find the first installed candidate 350 member(solver(Solver, Version), Candidates), 351 installed_solver(Solver, Version, ObjFile), 352 353 get_flag(hostarch, Arch), 354 concat_string([Arch,/,ObjFile], DirObjFile), 355 356 ( symbol_address(p_cpx_init, _) -> 357 true % already loaded 358 ; 359 printf(log_output, "loading %A %s ... %b", [Solver,Version]), 360 get_flag(object_suffix, O), 361 ( load_external_solver(Arch, Solver, Version, O) -> true ; true ), 362 ( O = "o" -> 363 concat_string([Arch,/,ObjFile,' -lm'], Load) 364 ; 365 concat_string([Arch,/,ObjFile], Load) 366 ), 367 % loading might abort because of stupid library 368 % incompatibilities, etc., so fail to try other alternatives 369 catch(load(Load), abort, fail), 370 writeln(log_output, done) 371 ) 372 -> 373 external(lp_get_license_challenge/1, p_cpx_challenge), 374 external(cplex_init/3, p_cpx_init), 375 external(cplex_exit/0, p_cpx_exit), 376 external(cplex_prob_init/8, p_cpx_prob_init), 377 external(cplex_lo_hi/2, p_cpx_lo_hi), 378 external(cplex_set_rhs_coeff/4, p_cpx_set_rhs_coeff), 379 external(cplex_set_obj_coeff/3, p_cpx_set_obj_coeff), 380 external(cplex_set_qobj_coeff/4, p_cpx_set_qobj_coeff), 381 external(cplex_init_type/3, p_cpx_init_type), 382 external(cplex_init_bound/4, p_cpx_init_bound), 383 external(cplex_new_obj_coeff/3, p_cpx_new_obj_coeff), 384 external(cplex_new_qobj_coeff/4, p_cpx_new_qobj_coeff), 385 external(cplex_flush_obj/1, p_cpx_flush_obj), 386 external(cplex_get_param/3, p_cpx_get_param), 387 external(cplex_get_prob_param/3, p_cpx_get_prob_param), 388 external(cplex_set_param/3, p_cpx_set_param), 389 external(cplex_set_matbeg/4, p_cpx_set_matbeg), 390 external(cplex_set_matval/4, p_cpx_set_matval), 391 external(cplex_get_row/4, p_cpx_get_row), 392 external(cplex_get_col_coef/5, p_cpx_get_col_coef), 393 external(cplex_get_obj_coef/3, p_cpx_get_obj_coef), 394 external(cplex_get_rhs/5, p_cpx_get_rhs), 395 external(cplex_loadprob/1, p_cpx_loadprob), 396 external(cplex_loadbase/3, p_cpx_loadbase), 397 external(cplex_loadorder/3, p_cpx_loadorder), 398 external(cplex_add_new_sos/4, p_cpx_add_new_sos), 399 external(cplex_flush_sos/1, p_cpx_flush_sos), 400 external(cplex_optimise/10, p_cpx_optimise), 401 external(cplex_get_objval/2, p_cpx_get_objval), 402 external(cplex_cleanup/1, p_cpx_cleanup), 403 external(cplex_lpwrite/3, p_cpx_lpwrite), 404 external(cplex_lpread/4, p_cpx_lpread), 405 external(cplex_output_stream/3, p_cpx_output_stream), 406 external(cplex_add_coeff/4, p_cpx_add_coeff), 407 external(cplex_flush_new_rowcols/2, p_cpx_flush_new_rowcols), 408 external(cplex_load_varname/3, p_cpx_load_varname), 409 external(cplex_change_col_type/3, p_cpx_change_col_type), % bt 410 external(cplex_change_lp_to_mip/1, p_cpx_change_lp_to_mip), % bt 411 external(cplex_change_obj_sense/2, p_cpx_change_obj_sense), 412 external(cplex_change_rhs/4, p_cpx_change_rhs), 413 external(cplex_change_cols_bounds/5, p_cpx_change_cols_bounds), 414 external(cplex_set_problem_type/3, p_cpx_set_problem_type), 415 416 external(create_darray/2, p_create_darray), 417 external(darray_size/2, p_darray_size), 418 external(get_darray_element/3, p_get_darray_element), 419 external(set_darray_element/3, p_set_darray_element), 420 external(darray_list/3, p_darray_list), 421 422 % column generation (adapted from AE 25/10/02) 423 external(cplex_new_row/5, p_cpx_new_row), 424 425 external(cplex_new_row_idc/5, p_cpx_new_row_idc), 426 external(cplex_flush_idcs/1, p_cpx_flush_idcs), 427 428 external(create_extended_iarray/3, p_create_extended_iarray), 429 external(create_extended_darray/3, p_create_extended_darray), 430 external(copy_extended_column_basis/4, p_copy_extended_column_basis), 431 external(copy_extended_arrays/6, p_copy_extended_arrays), 432 external(decode_basis/2, p_decode_basis), 433 434 % external(cplex_get_feas_result_array/3, p_cpx_get_feas_result_array), 435 external(create_iarray/2, p_create_iarray), 436 external(iarray_size/2, p_iarray_size), 437 external(get_iarray_element/3, p_get_iarray_element), 438 external(set_iarray_element/3, p_set_iarray_element), 439 external(iarray_list/2, p_iarray_list), 440 441 % standalone eplex 442 external(cplex_matrix_base/1, p_cpx_matrix_base), 443 external(cplex_matrix_offset/1, p_cpx_matrix_offset), 444 external(cplex_get_col_type/3, p_cpx_get_col_type), 445 external(cplex_impose_col_lwb/5, p_cpx_impose_col_lwb), % bt 446 external(cplex_impose_col_upb/5, p_cpx_impose_col_upb), % bt 447 external(cplex_impose_col_bounds/7, p_cpx_impose_col_bounds), % bt 448 external(cplex_get_col_bounds/4, p_cpx_get_col_bounds), 449 external(cplex_set_new_cols/6, p_cpx_set_new_cols), 450 451 % global constraint pools 452 external(cplex_get_cutpool_size/3, p_cpx_get_cutpool_size), 453 external(cplex_reset_cutpool_size/3, p_cpx_reset_cutpool_size), 454 external(cplex_init_cpcstr/5, p_cpx_init_cpcstr), 455 external(cplex_get_named_cp_index/4, p_cpx_get_named_cp_index), 456 external(cplex_get_named_cpcstr_indices/3, p_cpx_get_named_cpcstr_indices), 457 external(cplex_get_cpcstr_info/4, p_cpx_get_cpcstr_info), 458 external(cplex_set_cpcstr_cond/4, p_cpx_set_cpcstr_cond), 459 460 setval(loaded_solver, loaded(Solver,Version)) 461 ; 462 writeln(error, "Eplex error: Could not find any of the solver interfaces:"), 463 writeln(error, Candidates) 464 % we used to abort here - it's no longer done to allow the library 465 % to fcompile/icompile during installation despite missing solver 466 ). 467 468 469% lp_get_license(+LS, +LN) 470% LS is 'default' or path in OS syntax 471lp_get_license(default, LN) ?- 472 % If LS is 'default' we set it to point to the directory 473 % where we keep the XPRESS-MP OEM version password files. 474 getval(loaded_solver, loaded(Solver,Version)), 475 !, 476 get_flag(installation_directory, EclipseDir), 477 get_flag(hostarch, Arch), 478 concat_atom([EclipseDir,/,lib,/,Arch,/,e,Solver,Version], LS), 479 os_file_name(LS, OSLS), 480 lp_get_license(OSLS, LN). 481lp_get_license(LS, LN) :- 482 getval(licence_data, Held), % already holding this one? 483 Held == held(LS,LN), 484 !. 485lp_get_license(LS, LN) :- 486 getval(loaded_solver, loaded(_Solver,_Version)), 487 !, 488 lp_release_license, % possibly free other licence 489 unchecked_get_license(LS, LN). % may fail 490lp_get_license(LS, LN) :- 491 printf(error, "Eplex error: No solver loaded in %w%n", lp_get_license(LS, LN)), 492 fail. 493 494 495lp_get_license :- 496 getval(licence_data, held(_,_)), % already holding one? 497 !. 498lp_get_license :- 499 getval(loaded_solver, loaded(Solver,Version)), 500 !, 501 ( licensed_solver(Solver,Version,LS,LN) -> 502 lp_get_license(LS, LN) 503 ; 504 (lp_get_license("",0) -> 505 true /* initialised successfully with no license info */ 506 ; 507 get_flag(installation_directory, EclipseDir), 508 concat_string([EclipseDir,'/lib/eplex_lic_info.ecl'], LicInfo), 509 writeln(warning_output, "Eplex warning: No licensing information available."), 510 writeln(warning_output, "Use lp_get_license/2 or update license info database"), 511 writeln(warning_output, LicInfo), 512 fail 513 ) 514 ). 515lp_get_license :- 516 printf(error, "Eplex error: No solver loaded in %w%n", lp_get_license), 517 % don't abort here because lp_get_license/0 is called in a query 518 % below, and we don't want to abort loading the whole library. 519 fail. 520 521 get_solver_subdir(xpress, Version, SubDir) ?- !, 522 get_flag(installation_directory, EclipseDir), 523 get_flag(hostarch, Arch), 524 concat_string([EclipseDir,"/lib/",Arch,"/express",Version], SubDir). 525 get_solver_subdir(_, _, ""). 526 527 unchecked_get_license(LS, LN) :- 528 getval(loaded_solver, loaded(Solver,Version)), 529 get_solver_subdir(Solver,Version, SD), 530 may_start_license_manager(Solver, Version, LS, SD), 531 % SD needed for the Xpress 15 sh command ran during initialisation 532 os_file_name(SD, OSSD), 533 cplex_init(LS,LN,OSSD), % may fail 534 setval(licence_data, held(LS,LN)), 535 536 % Initialisation that can only be done after getting a license: 537 538% get_stream(output, OutS), 539% cplex_output_stream(0, 1, OutS), % cpxresults 540 get_stream(error, ErrS), 541 cplex_output_stream(1, 1, ErrS), % cpxerror 542% get_stream(log_output, LogS), 543% cplex_output_stream(3, 1, LogS), % log 544 get_stream(warning_output, WarnS), 545 cplex_output_stream(2, 1, WarnS). % cpxwarning 546 547 may_start_license_manager(xpress, Version, LicLoc, SolverDir) :- 548 atom_string(Version, VersionString), 549 substring(VersionString, "15", 1), !, 550 get_flag(tmp_dir, TDir), 551 get_user_name(User), 552 concat_string([TDir, "eclipse_xpress_",User,".log"], XPLog), 553 os_file_name(XPLog, OSXPLog), 554 concat_string([SolverDir, "/lmgrd"], LicMan), 555 % LicLoc is already in OS-specific form 556 exec([LicMan, "-c", LicLoc, "-l", OSXPLog], []). 557 may_start_license_manager(_, _, _, _). 558 559 get_user_name(User) :- /* Unix */ 560 getenv("USER", User), !. 561 get_user_name(User) :- /* Windows */ 562 getenv("USERNAME", User), !. 563 get_user_name("user"). 564 565lp_release_license :- 566 getval(licence_data, held(_LS,_LN)), 567 !, 568 cplex_exit, 569 setval(licence_data, none). 570lp_release_license. 571 572% cleanup when exiting 573:- local finalization(is_predicate(lp_release_license/0) -> lp_release_license ; true). 574 575 576:- pragma(debug). % allow debugging for the rest of the code 577 578% ---------------------------------------------------------------------- 579% Problem handle structure 580% 581% cplex_handle - pointer to C problem handle. This must be the 582% first argument (assumed by cplex_prob_init and cplex_cleanup)! 583% vars - a list of all variables involved 584% ints - a list of variables that the solver should consider 585% to be integers 586% sols,pis,slacks,djs,cbase,rbase - arrays holdings results 587% exported from cplex 588% obj - constant offset of the objective function 589% objcoeffs - objective coefficients 590% method, node_method - cplex main solving method (default, primal ...) 591% aux_method, node_aux_method - cplex auxiliary solving method 592% The interface works as follows: As constraints occur in the program, 593% they are first delayed (except when they are already ground). 594% When later lp_setup is called, the linear ones are collected 595% and processed, i.e. bounds and coefficients are computed for the 596% variables, rows and colunms are counted, the right hand sides extracted. 597% 598% For the result arrays we use: 599% _ the field should not be retrieved from CPLEX 600% [] no value yet 601% else array of values 602% ---------------------------------------------------------------------- 603 604% ***When adding new fields, remember to check both lp_setup *AND* lp_read!! 605:- export struct( 606 prob( 607% The first 2 fields are accessed by the C code and must be here in this order 608 cplex_handle, % handle to C data structure 609 stamp, % timestamp of last add/del trail 610% Input: 611 vars, % list of problem vars (reverse col order) 612 ints, % [Xi1,...Xik]: list of integer variables 613 objsense, % 1 for minimize, -1 for maximize 614 presolve, % 1 for yes, 0 for no 615 obj, % float: constant part of objective function 616 linobj, % list of C*X pairs (for delayed setup) 617 quadobj, % list of [C,X,Y] triplets (for delayed setup) 618 objcoeffs, % list of Index:Coeff pairs (for resetting) 619 qobjcoeffs, % list of q(I,J,Coeff) triplets (for resetting) 620 method, % int: cplex solving method (primal, dual...) 621 aux_method, % int: cplex auxiliary solving method 622 node_method, % int: cplex solving method (for MIP) 623 node_aux_method, % int: cplex auxiliary solving method (MIP) 624 demon_tol_int, % float: tolerable deviation of instantiation 625 demon_tol_real, % float: ... to simplex solution. 626 option_vnames, % atom: yes,no 627 timeout, % float: seconds, 0.0 no timeout 628 629 post_equality, % atom: yes,no: post equality constr 630 option_dump, % dump problem before solving (no or 631 % write_before_solve/2) 632 option_mipstart, % in [none,all,integers] 633% Solver demon 634 solver_id, % int: Eplex's id for solver 635 suspension, % suspension or variable 636 sync_bounds, % atom: yes,no 637 nc_trigger, % atom: yes,no (yes implies nonvar(suspension)) 638 bd_trigger, % atom: no,bounds,deviating_bounds 639 triggermodes, % list of atoms 640 aux_susps, % extra suspensions associated with handle 641 pool, % associated pool if any, else var 642 change_suspensions, % list of suspensions to schedule on solution 643% Handler Goal 644 caller_module, % module from which eplex/lp setup was called 645 subopth, % suboptimal state handler, else var 646 unboundh, % unbounded state handler, else var 647 unkh, % unknown state handler, else var 648 aborth, % abort state handler, else var 649 infeash, % infeasible state handler, else var 650% Output (from last solve): 651 mr, % int: number of user rows 652 % m = (mr + nccpr) 653% ncpr, % int: number of uncond. cutpool cstrs 654% nccpr, % int: number of active cond. cutpool cstrs 655 % results from last solve 656 status, % return status of last successful invocation 657 cost, % float: objval of the current solution 658 bestbound, % float: best bound on objval for current sol. 659 worstbound, % float: worst bound on objval for current sol. 660% Output arrays (must start with sols and remain consecutive - accessed from C!) 661 sols, % array[n] of raw solutions (or [] or _) 662 pis, % array[m] of dual values (or [] or _) 663 slacks, % array[m] of slacks (or [] or _) 664 djs, % array[n] of reduced costs (or [] or _) 665 cbase, % iarray[n] of basis status (or [] or _) 666 rbase, % iarray[m] of basis status (or [] or _) 667 cp_cond_map, % array of mapping from conditional pool 668 % to added conditional constraints index 669 iis_rows, % iarray[cm] of conflict row ids (or [] or _) 670 iis_cols, % iarray[cn] of conflict col ids (or [] or _) 671 iis_colstats % string[cn] of conflict col status (or [] or _) 672 ) 673 ). 674 675% temporary data needed only during solver setup 676:- local struct(temp_prob( 677 sos, % list of sos1(Vars) or sos2(Vars) 678 extra_vars, % list of extra problem variables 679 use_copy % 1 for yes, 0 for no 680 )). 681 682:- export portray(prob/(property(arity) of prob), lp_handle_tr_out/2, []). 683:- export lp_handle_tr_out/2. 684lp_handle_tr_out(prob{solver_id: Id}, lp_handle(Id)). 685 686 687array(X) :- string(X). 688 689 690% ---------------------------------------------------------------------- 691% The variables 692% 693%---------------------------------------------------------------------- 694 695:- export struct( 696 eplex( 697 stamp, % time stamp for variable in this solver 698 solver, % A solver that this variable occurs in (prob Handle) 699 idx, % The column number in that solver's matrix 700 intol_inst, % Suspension list to be woken on intolerable 701 % instantiation, for simplex demons 702 next % can point to a different eplex attribute for another 703 % handler, or the atom 'end' 704 ) 705 ). 706 707 708get_lp_attr(X{eplex:Attr0}, Handle, Attr) ?- 709 Handle = prob{solver_id:SId}, 710 ( var(Attr0) -> 711 new_lp_attr(X, Handle, Attr) 712 ; 713 Attr0 = eplex{solver:prob{solver_id:SId0},next:Next}, 714 % should not fail unless Attr0 incorrect 715 (SId0 == SId -> 716 Attr = Attr0 717 ; 718 get_lp_attr1(Next, Attr0, Handle, SId, Attr) 719 ) 720 ). 721get_lp_attr(X, Handle, Attr) :- % make a new eplex-variable 722 free(X), 723 new_lp_attr(X, Handle, Attr). 724 725 get_lp_attr1(ThisAttr, Attr0, Handle, _SId, Attr) :- 726 atom(ThisAttr), !, % chain terminated by atom 'end' 727 new_lp_attrstruct(Handle, Attr), 728 setarg(next of eplex, Attr0, Attr). 729 get_lp_attr1(ThisAttr, _Attr0, Handle, SId, Attr) :- 730 compound(ThisAttr), 731 ThisAttr = eplex{solver:prob{solver_id:SId0},next:NextAttr}, 732 (SId0 = SId -> 733 Attr = ThisAttr 734 ; 735 get_lp_attr1(NextAttr, ThisAttr, Handle, SId, Attr) 736 ). 737 738 new_lp_attr(X, Handle, Attr) :- % make a new eplex-variable: 739 new_lp_attrstruct(Handle, Attr), 740 add_attribute(X, Attr, eplex). % and add an eplex-attribute 741 742:- mode new_lp_attrstruct(+,-). 743new_lp_attrstruct(Handle, Attr) :- 744 Attr = eplex{solver:Handle,next:end}, 745 sepia_kernel: timestamp_update(Attr, stamp of eplex), 746 init_suspension_list(intol_inst of eplex, Attr). 747 748 749% From an lp_attr, searches for the attribute corresponding to that for the 750% first argument. Fails if none found. 751get_lp_attr_for_handle(Handle, Attr0, Attr) :- 752 Handle = prob{solver_id:SId}, 753 compound(Attr0), 754 get_lp_attr_for_sid(SId, Attr0, Attr). 755 756get_lp_attr_for_sid(SId, Attr0, Attr) :- 757 % no need to test for var(Attr0) in chain 758 Attr0 = eplex{solver:prob{solver_id:SId0},next:NextAttr}, 759 (SId0 == SId -> 760 Attr0 = Attr 761 ; 762 get_lp_attr_for_sid(SId, NextAttr, Attr) 763 ). 764 765 766% Update bounds 767 768% the user accessible lp_var_set_bounds/4 raises a range error if variable 769% not in problem represented by Handle 770lp_var_set_bounds(Handle, V, Lo0, Hi0) :- var(Handle), !, 771 error(4, lp_var_set_bounds(Handle, V, Lo0, Hi0)). 772lp_var_set_bounds(Handle, V, Lo0, Hi0) :- 773 Handle = prob{solver_id:SId}, 774 !, 775 ( get_var_index(V, SId, I) -> 776 Lo is float(Lo0), 777 Hi is float(Hi0), 778 get_lp_attr(V, Handle, Attr), 779 lp_impose_col_bounds(Handle, Attr, I, Lo, Hi), 780 wake 781 ; number(V) -> 782 V >= Lo0, 783 V =< Hi0 784 ; 785 printf(error, "Eplex error: variable %w is not a problem" 786 " variable for handle %w:%n",[V,Handle]), 787 error(6, lp_var_set_bounds(Handle, V, Lo0, Hi0)) 788 789 ). 790lp_var_set_bounds(Handle, V, Lo0, Hi0) :- 791 printf(error, "Eplex error: invalid problem handle %w:%n",[Handle]), 792 error(5, lp_var_set_bounds(Handle, V, Lo0, Hi0)). 793 794 795% Update bounds 796 797% the user accessible lp_var_non_monotonic_set_bounds/4 raises a range 798% error if variable not in problem represented by Handle 799% note we do not allow this for instances or handles with trigger 800% conditions and demons, so there is no need to schedule wakings after 801% the bound change as there can be none 802lp_var_non_monotonic_set_bounds(Handle, V, Lo0, Hi0) :- var(Handle), !, 803 error(4, lp_var_non_monotonic_set_bounds(Handle, V, Lo0, Hi0)). 804lp_var_non_monotonic_set_bounds(Handle, V, Lo0, Hi0) :- 805 Handle = prob{solver_id:SId, pool: Pool, suspension:S}, 806 ((is_suspension(S) ; nonvar(Pool)) -> 807 printf(error, "Eplex error: problem cannot be modified by %w " 808 "(has trigger conditions or is an eplex instance).%n", 809 [lp_var_non_monotonic_set_bounds(Handle, V, Lo0, Hi0)]), 810 abort 811 ; 812 true 813 ), 814 !, 815 (get_unique_var_index(V, SId, I) -> 816 Lo is float(Lo0), 817 Hi is float(Hi0), 818 get_lp_attr(V, Handle, Attr), 819 cplex_impose_col_bounds(Handle, Attr, I, 0, Lo, Hi, _Changed) 820 ; 821 % raise an error if variable is not a problem variable or 822 % has merged columns 823 printf(error, "Eplex error: %w is either not a problem" 824 " variable or it represents more than one column:%n", [V]), 825 error(6, lp_var_non_monotonic_set_bounds(Handle, V, Lo0,Hi0)) 826 ). 827lp_var_non_monotonic_set_bounds(Handle, V, Lo0, Hi0) :- 828 printf(error, "Eplex error: invalid problem handle %w:%n", [Handle]), 829 error(5, lp_var_non_monotonic_set_bounds(Handle, V, Lo0, Hi0)). 830 831 832eplex_var_get_bounds(V, Lo, Hi, Pool) :- 833 get_pool_handle(Handle,Pool), !, 834 lp_var_get_bounds(Handle, V, Lo, Hi). 835eplex_var_get_bounds(V, Lo, Hi, Pool) :- 836 printf(error, "Eplex error: instance %w has no associated solver:%n",[Pool]), 837 error(5, eplex_var_get_bounds(V, Lo, Hi)). 838 839lp_var_get_bounds(Handle, V, Lo, Hi) :- var(Handle), !, 840 error(4, lp_var_get_bounds(Handle, V, Lo, Hi)). 841lp_var_get_bounds(Handle, V, Lo, Hi) :- 842 Handle = prob{cplex_handle:CPH,solver_id:SId}, 843 !, 844 ( get_first_var_index(V, SId, I) -> % first index has the tightest bounds 845 cplex_get_col_bounds(CPH, I, Lo, Hi) 846 ; number(V) -> 847 Lo is float(V), 848 Hi is float(V) 849 ; 850 printf(error, "Eplex error: %w is not a problem variable for" 851 " handle %w:%n", [V,Handle]), 852 error(6, lp_var_get_bounds(Handle, V, Lo,Hi)) 853 ). 854lp_var_get_bounds(Handle, V, Lo, Hi) :- 855 printf(error, "Eplex error: Invalid problem handle %w:%n", [Handle]), 856 error(5, lp_var_get_bounds(Handle, V, Lo, Hi)). 857 858 859% may throw(abort) indicating error 860lp_impose_col_bounds(Handle, Attr, [I|_], Lo, Hi) :- 861 cplex_impose_col_bounds(Handle, Attr, I, 1, Lo, Hi, Changed), 862 schedule_demon_if_bounds_changed(Handle, I, Changed). 863 864 865 impose_col_bounds(Handle, Attr, I, Bound, Changed, (>=)) :- 866 cplex_impose_col_lwb(Handle, Attr, I, Bound, Changed). 867 impose_col_bounds(Handle, Attr, I, Bound, Changed, (=<)) :- 868 cplex_impose_col_upb(Handle, Attr, I, Bound, Changed). 869 impose_col_bounds(Handle, Attr, I, Bound, Changed, (=:=)) :- 870 cplex_impose_col_bounds(Handle, Attr, I, 1, Bound, Bound, Changed). 871 872 873% Number the variables from the end of list, from Col0 to ColN-1 874 875set_var_indices(Xs, Handle, Col0, Length, ColN) :- 876 length(Xs, Length), % create or count Xs 877 ColN is Col0 + Length, 878 ( foreach(X, Xs), 879 for(I, ColN-1, Col0, -1), 880 param(Handle) do 881 set_var_index(X, Handle, I) 882 ). 883 884 set_var_index(X, _Handle, _) :- nonvar(X). 885 set_var_index(X, Handle, J) :- var(X), 886 get_lp_attr(X, Handle, A), 887 % type error if already has an index (should not happen) 888 ( arg(idx of eplex, A, [J]) -> true 889 ; error(5, set_var_index(X, Handle, J)) 890 ). 891 892 893 894% Retrieve the variable's column for problem represented by SId. 895% Index will be in the form of a list 896 897get_first_var_index(V, SId, Index) :- 898 get_var_index(V, SId, Is), Is = [Index|_]. 899 900get_unique_var_index(V, SId, Index) :- 901 get_var_index(V, SId, Is), Is = [Index]. 902 903get_var_index(_{eplex:eplex{idx:I,next:Next,solver:prob{solver_id:SId0}}}, 904 SId, Index) ?- 905 (SId0 == SId -> I = Index ; get_var_index1(Next, SId, Index)). 906 907 get_var_index1(eplex{idx:I,solver:prob{solver_id:SId0},next:Next}, SId, Index) ?- 908 (SId0 == SId -> I=Index ; get_var_index1(Next, SId, Index)). 909 910 911 912lp_var_occurrence(X, Handle, Index) :- 913 var(Handle), 914 lp_var_occurrence1(X, Handle, Index). 915lp_var_occurrence(X, Handle, Index) :- 916 % returns the first col index 917 nonvar(Handle), 918 Handle = prob{solver_id:SId}, 919 get_first_var_index(X, SId, Index). 920 921 922 lp_var_occurrence1(_{eplex:Attr}, Handle, Index) ?- 923 lp_var_attrs(Attr, Handle, Index). 924 925 :- mode lp_var_attrs(+,-,-). 926 lp_var_attrs(eplex{solver:H,idx:[I|_],next:Next}, Handle, Index) ?- 927 (H=Handle, 928 I = Index 929 ; 930 lp_var_attrs(Next, Handle, Index) 931 ). 932 933 934 935lp_var_solution(Handle, _{eplex:Attr0}, Sol) ?- 936 get_lp_attr_for_handle(Handle, Attr0, Attr), 937 lp_attr_solution(Attr, Sol). 938lp_var_solution(_, X, Sol) :- 939 integer(X), 940 Sol is float(X). 941lp_var_solution(_, X, Sol) :- 942 real(X), 943 X = Sol. 944 945lp_var_typed_solution(Handle, _{eplex:Attr0}, TSol) ?- 946 get_lp_attr_for_handle(Handle, Attr0, Attr), 947 Attr = eplex{idx:[J|_],solver:prob{cplex_handle:CPH,sols:SolArr}}, 948 array(SolArr), 949 darray_size(SolArr, Size), J < Size, 950 get_typed_solution_for_col(CPH, J, SolArr, TSol). 951lp_var_typed_solution(_, X, Sol) :- 952 integer(X), 953 X = Sol. 954lp_var_typed_solution(_, X, Sol) :- 955 real(X), 956 X = Sol. 957 958 959get_typed_solution_for_col(CPH, J, SolArr, TSol) :- 960 get_darray_element(SolArr, J, Sol), 961 cplex_get_col_type(CPH, J, TypeCode), 962 cplex_type_code(T, TypeCode), 963 ( T == integer -> 964 TSol is fix(round(Sol)) 965 ; 966 % The following is necessary due to solver's limited precision... 967 % (assumes col bounds have not changed; otherwise solution 968 % value may be changed slightly if it is close to the new bounds) 969 cplex_get_col_bounds(CPH, J, XL, XH), 970 % use cplex_get_param here to access the feasibility_tol for 971 % the (possibly local) value for this CPH 972 ( Sol < XL,Sol >= XL-cplex_get_param(CPH,feasibility_tol) -> 973 TSol=XL 974 ; Sol > XH,Sol =< XH+cplex_get_param(CPH,feasibility_tol) -> 975 TSol=XH 976 ; 977 TSol=Sol 978 ) 979 ). 980 981 982lp_var_type(Handle, _{eplex:Attr0}, Type) ?- 983 get_lp_attr_for_handle(Handle, Attr0, Attr), 984 Attr = eplex{idx:[J|_],solver:prob{cplex_handle:CPH}}, 985 cplex_get_col_type(CPH, J, TCode), 986 cplex_type_code(Type, TCode). 987lp_var_type(_, X, Type) :- 988 integer(X), 989 Type = integer. 990lp_var_type(_, X, Type) :- 991 real(X), 992 Type = real. 993 994lp_var_redcost(Handle, _{eplex:Attr}, Val) ?- 995 get_lp_attr_for_handle(Handle, Attr, eplex{idx:Idxs,solver:prob{djs:Array}}), 996 array(Array), 997 (Idxs = [J] -> 998 % one column only, can get reduced cost for column 999 darray_size(Array, Size), J < Size, 1000 get_darray_element(Array, J, Val) 1001 ; 1002 % more than one column presented by variable, the simple safe 1003 % reduced cost to return is 0 1004 Val = 0.0 1005 ). 1006lp_var_redcost(_Handle, X, Val) :- 1007 number(X), 1008 Val = 0.0. 1009 1010lp_attr_itol(eplex{solver:prob{demon_tol_int:Tol0}}, Tol) ?- 1011 Tol=Tol0. 1012 1013lp_attr_rtol(eplex{solver:prob{demon_tol_real:Tol0}}, Tol) ?- 1014 Tol=Tol0. 1015 1016lp_attr_solution(eplex{idx:[J|_],solver:prob{sols:SolArr}}, Sol) ?- 1017 % solution value is the same for unified columns, just get from one 1018 array(SolArr), 1019 darray_size(SolArr, Size), J < Size, 1020 get_darray_element(SolArr, J, Sol). 1021 1022 1023eplex_var_get(X, What, Val, Pool) :- 1024 get_pool_item(Pool, Handle), 1025 ( Handle == 0 -> 1026 printf(error, "Eplex error: instance has no solver set up in %w%n", 1027 [Pool:eplex_var_get(X, What, Val)]), 1028 abort 1029 ; 1030 lp_var_get1(Handle, X, What, Val) 1031 ). 1032 1033 1034lp_var_get(Handle, X, What, Val) :- var(Handle), !, 1035 error(4, lp_var_get(Handle, X, What, Val)). 1036lp_var_get(Handle, X, What, Val) :- compound(Handle), !, 1037 lp_var_get1(Handle, X, What, Val). 1038lp_var_get(Handle, X, What, Val) :- 1039 error(5, lp_var_get(Handle, X, What, Val)). 1040 1041 1042 lp_var_get1(Handle, X, solution, Val) :- !, 1043 (lp_var_solution(Handle, X, Val) -> 1044 true 1045 ; 1046 fail_if_valid_var_get(lp_var_get(Handle,X,solution,Val), 1047 X, Handle, sols of prob) 1048 ). 1049 lp_var_get1(Handle, X, typed_solution, TVal) :- !, 1050 (lp_var_typed_solution(Handle, X, TVal) -> 1051 true 1052 ; 1053 fail_if_valid_var_get(lp_var_get(Handle,X,typed_solution,TVal), 1054 X, Handle, sols of prob) 1055 ). 1056 lp_var_get1(Handle, X, type, Type) :- !, 1057 (lp_var_type(Handle, X, Type) -> 1058 true 1059 ; 1060 printf(error, "Eplex error: %w not a problem variable:%n", [X]), 1061 error(6, lp_var_get(Handle, X, type, Type)) 1062 ). 1063 lp_var_get1(Handle, X, reduced_cost, Val) :- !, 1064 (lp_var_redcost(Handle, X, Val) -> 1065 true 1066 ; 1067 fail_if_valid_var_get(lp_var_get(Handle,X,reduced_cost,Val), 1068 X, Handle, djs of prob) 1069 ). 1070 lp_var_get1(Handle, X, What, Val) :- 1071 error(6, lp_var_get(Handle, X, What, Val)). 1072 1073 1074 % fails only if the variable is a problem variable for Handle and 1075 % there is a value array at Pos waiting to be filled. Error otherwise 1076 fail_if_valid_var_get(Goal, X, Handle, Pos) :- 1077 arg(solver_id of prob, Handle, SId), 1078 (get_var_index(X, SId, _) -> 1079 arg(Pos, Handle, Array), 1080 var(Array), % fails silently otherwise 1081 writeln(error, "Eplex error: information not requested at" 1082 " solver setup:"), 1083 error(6, Goal) 1084 ; 1085 writeln(error, "Eplex error: not accessing an eplex problem variable:"), 1086 error(6, Goal) 1087 ). 1088 1089% obsolete 1090lp_var_get(X{eplex:eplex{solver:Handle,next:Next}}, What, Val) ?- !, 1091 ( Next == end -> 1092 lp_var_get(Handle, X, What, Val) 1093 ; 1094 writeln(error, "Eplex error: more than one solver handle in lp_var_get/3 - use lp_var_get/4"), 1095 abort 1096 ). 1097lp_var_get(X, What, Sol) :- 1098 number(X), 1099 lp_var_get1(_Handle, X, What, Sol). 1100 1101% obsolete 1102lp_var_solution(X, Val) :- 1103 lp_var_get(X, solution, Val). 1104 1105 1106/*** 1107% Debugging 1108checkvar(X) :- 1109 var(X), !, 1110 var_type(X, Type), 1111 var_range(X, Lo, Hi), 1112 ( 1113 Type == integer, 1114 (abs(Lo-round(Lo)) > 0.000001 ; abs(Hi-round(Hi)) > 0.000001) 1115 -> 1116 writeq(error, checkvar(X)),nl(error) 1117% ; 1118% Lo >= Hi 1119% -> 1120% writeq(error, checkvar(X)),nl(error) 1121 ; 1122 true 1123 ). 1124checkvar([]) :- !. 1125checkvar([X|Xs]) :- !, 1126 checkvar(X), 1127 checkvar(Xs). 1128checkvar(_). 1129***/ 1130 1131 1132% Unify handler: 1133% With var/var binding of two eplex variables, their eplex attributes are 1134% merged. Existing eplex attribute chains should each represent different 1135% solver. On merging, the two variables may contain attributes for different 1136% columns of the same solver, in which case, the attribute representing one 1137% of the columns is lost. 1138 1139unify_eplex(_Term, Attr) :- 1140 var(Attr). % Ignore if no attribute for this extension 1141unify_eplex(Term, Attr) :- 1142 compound(Attr), 1143 unify_term_eplex(Term, Attr). 1144 1145:- mode unify_term_eplex(?, +). 1146unify_term_eplex(Y{eplex:AttrY}, AttrX) :- 1147 -?-> 1148 unify_eplex_eplex(Y, AttrX, AttrY). 1149unify_term_eplex(X, Attr) :- 1150 integer(X), % The variable was instantiated 1151 unify_number_eplex(X, Attr). 1152unify_term_eplex(X, Attr) :- 1153 real(X), % The variable was instantiated 1154 unify_number_eplex(X, Attr). 1155 1156unify_eplex_eplex(Y, AttrX, AttrY) :- 1157 var(AttrY), % No attribute for this extension 1158 AttrX = AttrY, % Transfer the attribute 1159 notify_constrained(Y). 1160unify_eplex_eplex(Y, AttrX, AttrY) :- 1161 nonvar(AttrY), 1162 ( nonvar(AttrX) -> 1163 AttrY = eplex{idx:IdxY,solver:prob{solver_id:SIdY}}, 1164 (AttrX = eplex{idx:IdxY,solver:prob{solver_id:SIdY}} -> 1165 true % same attribute, do nothing 1166 ; 1167 % merge X's attributes into Y 1168 hash_create(HashY), 1169 attributes_to_hash(AttrY, HashY, LastAttrY), 1170 setarg(next of eplex, LastAttrY, AttrX), 1171 remove_and_merge_hashed_occurences(AttrX, LastAttrY, Y, HashY), 1172 notify_constrained(Y) 1173 ) 1174 ; 1175 notify_constrained(Y) 1176 ). 1177 1178 1179unify_number_eplex(X0, Attr) :- 1180 compound(Attr), 1181 Attr = eplex{solver:Handle, idx:Is}, 1182 X is float(X0), 1183 % impose the column bounds the first column only 1184 lp_impose_col_bounds(Handle, Attr, Is, X, X), 1185 ( lp_attr_solution(Attr, S) -> 1186 arg(cplex_handle of prob, Handle, CPH), 1187 lp_attr_tol(CPH, Is, Attr, Tol), 1188 ( abs(S-X) =< Tol -> 1189 true 1190 ; 1191 schedule_suspensions(intol_inst of eplex, Attr) 1192 ) 1193 ; 1194 true 1195 ), 1196 Attr = eplex{next:NextAttr}, 1197 unify_number_eplex(X, NextAttr). 1198unify_number_eplex(_X, end) ?- true. 1199 1200 lp_attr_tol(CPH, [I|_], Attr, Tol) :- 1201 % look at first col only: col types of all merged col are the same 1202 cplex_get_col_type(CPH, I, TC), 1203 (cplex_type_code(integer, TC) -> 1204 lp_attr_itol(Attr, Tol) 1205 ; 1206 lp_attr_rtol(Attr, Tol) 1207 ). 1208 1209attributes_to_hash(Attr, Hash, LastAttr) :- 1210 Attr = eplex{next:Next,solver:prob{solver_id:SId}}, 1211 hash_add(Hash, SId, Attr), 1212 (Next == end -> 1213 LastAttr = Attr ; attributes_to_hash(Next, Hash, LastAttr) 1214 ). 1215 1216remove_and_merge_hashed_occurences(Attr, PrevAttr, Var, Hash) :- 1217 Attr = eplex{next:Next,idx:Idx,solver:Handle}, 1218 Handle = prob{solver_id:SId,cplex_handle:CPH,post_equality:PostEq}, 1219 (hash_find(Hash, SId, MergedAttr) -> 1220 % MergedAttr represents other column(s) in the matrix. Merge 1221 % the information from Attr into it 1222 (PostEq == no -> 1223 Scheduled = no 1224 ; 1225 add_equality_constraint(Var, Attr, Scheduled) 1226 ), 1227 merge_and_check_cols(CPH, Handle, Idx, MergedAttr, Scheduled), 1228 merge_suspension_lists(intol_inst of eplex, Attr, 1229 intol_inst of eplex, MergedAttr), 1230 % remove Attr from chain 1231 setarg(next of eplex, PrevAttr, Next), 1232 PrevAttr1 = PrevAttr 1233 ; 1234 PrevAttr1 = Attr 1235 ), 1236 remove_and_merge_hashed_occurences(Next, PrevAttr1, Var, Hash). 1237remove_and_merge_hashed_occurences(end, _, _, _) ?- true. 1238 1239 1240 merge_and_check_col_bounds(CPH, Handle, [I0|_], [I1|_], Attr0, Scheduled) :- 1241 cplex_get_col_bounds(CPH, I0, Lo0, Hi0), 1242 cplex_get_col_bounds(CPH, I1, Lo1, Hi1), 1243 1244 (Lo0 =:= Lo1 -> 1245 NewLo = Lo0 1246 ; 1247 NewLo is max(Lo0, Lo1), 1248 Changed = 1 1249 ), 1250 (Hi0 =:= Hi1 -> 1251 NewHi = Hi0 1252 ; 1253 NewHi is min(Hi0, Hi1), 1254 Changed = 1 1255 ), 1256 NewHi >= NewLo, 1257 (Changed == 1 -> 1258 % impose new bound on first column 1259 cplex_impose_col_bounds(Handle, Attr0, I0, 1, NewLo, NewHi, _), 1260 (Scheduled \== yes -> 1261 % not already scheduled due to new_constraints trigger. 1262 schedule_demon_if_bounds_changed(Handle, 1.0Inf, 1) 1263 % with col number set to 1.0Inf, trigger test for deviating 1264 % bounds will fail and so not trigger 1265 ; 1266 true 1267 ) 1268 ; 1269 true 1270 ). 1271 1272 % merge the column(s) represented by Idx into Attr0 1273 merge_and_check_cols(CPH, Handle, Idx1, Attr0, Scheduled) :- 1274 Attr0 = eplex{idx:Idx0}, 1275 merge_col_type(CPH, Handle, Idx0, Idx1), 1276 merge_and_check_col_bounds(CPH, Handle, Idx0, Idx1, Attr0, Scheduled), 1277 % Idx0 should be in front in the MergedIdx to preserve the same 1278 % first idx for Attr0 1279 append(Idx0, Idx1, MergedIdx), 1280 setarg(idx of eplex, Attr0, MergedIdx). 1281 1282 merge_col_type(CPH, Handle, Idx0, Idx1) :- 1283 % make sure all merged columns have the same type. 1284 % note that as we do this every time we merge columns, so 1285 % if Idx0 and Idx1 are multiple columns, they must have the same 1286 % type across the multiple columns 1287 Idx0 = [I0|_], 1288 Idx1 = [I1|_], 1289 cplex_get_col_type(CPH, I0, TypeCode0), 1290 cplex_type_code(Type0, TypeCode0), 1291 cplex_get_col_type(CPH, I1, TypeCode1), 1292 cplex_type_code(Type1, TypeCode1), 1293 (Type0 \== Type1 -> 1294 % one of the column is of integer type. Make the other column(s) 1295 % the same integer type 1296 (Type0 == integer -> /* Idx0 is integer */ 1297 Idxs = Idx1, 1298 TypeCode = TypeCode0 1299 ; /* assume Idx1 is integer */ 1300 Idxs = Idx0, 1301 TypeCode = TypeCode1 1302 ), 1303 (foreach(I, Idxs), param(Handle,TypeCode) do 1304 cplex_change_col_type(Handle, I, TypeCode) % backtrackable 1305 ) 1306 ; 1307 true /* column types same, no need to change column types */ 1308 ). 1309 1310 1311 add_equality_constraint(X1, X2Att, Trigger) :- 1312 % two variables in the same solver are unified, send an equality 1313 % constraint for the two columns to the external solver. 1314 % Use a dummy variable as `container' for the attribute X2Att, 1315 % as original X2 is not available to the unification handler 1316 % X1 must contain an attribute which has the same solver 1317 % as X2Att. 1318 normalise_cstr((X1 =:= X2), Norm), 1319 add_attribute(X2, X2Att, eplex), 1320 X2Att = eplex{solver:Handle}, 1321 Handle = prob{solver_id:SId, cplex_handle:CPH, nc_trigger:Trigger, 1322 suspension:Susp}, 1323 setup_new_rows(CPH, SId, 0, _, [Norm], _), 1324 clear_result(Handle, cbase of prob), % added a new row 1325 clear_result(Handle, rbase of prob), 1326 cplex_flush_new_rowcols(Handle, 0), 1327 (Trigger == yes -> 1328 schedule_suspensions(1, s([Susp])) 1329 ; 1330 true 1331 ). 1332 1333 1334suspensions_eplex(_{eplex:Attr}, Susps, Susps0) ?- 1335 ( var(Attr) -> 1336 Susps0=Susps ; collect_suspensions_eplex(Attr, Susps, Susps0) 1337 ). 1338 1339collect_suspensions_eplex(end, Susps, Susps0) ?- Susps=Susps0. 1340collect_suspensions_eplex(eplex{intol_inst:S, next:NextAttr}, 1341 Susps, Susps0) ?- 1342 Susps = [S|Susps1], 1343 collect_suspensions_eplex(NextAttr, Susps1, Susps0). 1344 1345 1346schedule_demon_if_bounds_changed(prob{ 1347 bd_trigger:TrigCond,cplex_handle:CPH,suspension:Susp, 1348 demon_tol_real:RT,demon_tol_int:IT,sols:SolArr}, I, 1) ?- 1349 check_if_should_trigger(TrigCond, CPH, RT, IT, SolArr, I), 1350 !, 1351 schedule_suspensions(1, s([Susp])). 1352schedule_demon_if_bounds_changed(_,_,_). 1353 1354 1355bound_change_requires_scheduling(prob{ 1356 bd_trigger:TrigCond,cplex_handle:CPH, 1357 demon_tol_real:RT,demon_tol_int:IT,sols:SolArr}, I) ?- 1358 check_if_should_trigger(TrigCond, CPH, RT, IT, SolArr, I). 1359 1360 1361check_if_should_trigger(bounds,_,_,_,_,_). 1362check_if_should_trigger(deviating_bounds, CPH, RT, IT, SolArr, I) :- 1363 array(SolArr), 1364 darray_size(SolArr, Size), I < Size, 1365 get_darray_element(SolArr, I, S), 1366 cplex_get_col_bounds(CPH, I, Lo, Hi), 1367 \+ tolerable_range_var(S, Lo, Hi, CPH, I, RT, IT). 1368 1369 1370 1371 1372 1373% Print handler 1374lp_var_print(_{eplex:Attr}, Printed) ?- 1375 nonvar(Attr), 1376 lp_var_print1(Attr, Sols), 1377 % fails and print nothing if Sols is [] 1378 (Sols = [Printed] -> true ; Sols = [_|_], Sols = Printed). 1379 1380 lp_var_print1(Attr, SolsIn0) :- 1381 Attr = eplex{next:NextAttr, idx:[I|_], 1382 solver:prob{cplex_handle:CPH}}, 1383 nonvar(CPH), % we do have the low-level information 1384 catch(cplex_get_col_bounds(CPH, I, L, H),_, 1385 (L='?', H='?') ), /* catch case when var not yet in solver */ 1386 (lp_attr_solution(Attr, Sol) -> 1387 SolsIn0 = [L..H@Sol|SolsIn1] 1388 ; 1389 SolsIn0 = [L..H|SolsIn1] 1390 ), 1391 lp_var_print1(NextAttr, SolsIn1). 1392 lp_var_print1(end, SolsIn1) ?- SolsIn1 = []. 1393 1394 1395% Find the variable with the most fractional lp-solution. 1396% Never fails on a non-empty list. 1397 1398deletemostfract(BestX, [X|Xs], Handle, Rest) :- 1399 nonvar(Handle), 1400 lp_var_solution(Handle, X, Val), 1401 Diff is abs(Val - round(Val)), 1402 deletemostfract(Xs, X, Handle, Diff, BestX, Rest). 1403deletemostfract(BestX, Xs, Handle, Rest) :- 1404 var(Handle), 1405 error(4, deletemostfract(BestX, Xs, Handle, Rest)). 1406 1407 1408deletemostfract([], BestX, _Handle, _BestDiff, BestX, []). 1409deletemostfract([X|Xs], BestX, Handle, BestDiff, Res, Rest) :- 1410 lp_var_solution(Handle, X, Val), 1411 Diff is abs(Val - round(Val)), 1412 ( Diff > BestDiff -> 1413 Rest = [BestX|Rest0], 1414 deletemostfract(Xs, X, Handle, Diff, Res, Rest0) 1415 ; 1416 Rest = [X|Rest0], 1417 deletemostfract(Xs, BestX, Handle, BestDiff, Res, Rest0) 1418 ). 1419 1420 1421% Find the first variable whose lp-solution deviates more than Tolerance 1422% from the nearest integer. Fails if there is no such variable in the list. 1423 1424deletefract(BestX, Xs, Handle, Tolerance, Rest) :- 1425 nonvar(Handle), 1426 deletefract1(BestX, Xs, Handle, Tolerance, Rest). 1427deletefract(BestX, Xs, Handle, Tolerance, Rest) :- 1428 var(Handle), 1429 error(4, deletefract(BestX, Xs, Handle, Tolerance, Rest)). 1430 1431 deletefract1(BestX, [X|Xs], Handle, Tolerance, Rest) :- 1432 lp_var_solution(Handle, X, Val), 1433 ( abs(Val - round(Val)) > Tolerance -> 1434 BestX = X, 1435 Rest = Xs 1436 ; 1437 Rest = [X|Rest0], 1438 deletefract1(BestX, Xs, Handle, Tolerance, Rest0) 1439 ). 1440 1441% set_bounds handler 1442 1443lp_attr_set_bounds(_{eplex:Attr}, Lo, Hi) ?- 1444 % Attr guaranteed to be nonvar 1445 lp_attr_set_bounds1(Attr, Lo, Hi). 1446 1447 lp_attr_set_bounds1(Attr, Lo0, Hi0) ?- 1448 Attr = eplex{solver:Handle,idx:I, next:Next}, 1449 Lo is float(Lo0), 1450 Hi is float(Hi0), 1451 lp_impose_col_bounds(Handle, Attr, I, Lo, Hi), 1452 lp_attr_set_bounds1(Next, Lo, Hi). 1453 lp_attr_set_bounds1(end, _, _) ?- 1454 wake. 1455 1456 1457% get_bounds handler 1458 1459lp_attr_get_bounds(_{eplex:Attr}, Lo, Hi) ?- 1460 % Attr guaranteed to be nonvar 1461 lp_attr_get_bounds1(Attr, -1.0Inf, 1.0Inf, Lo, Hi). 1462 1463 lp_attr_get_bounds1(eplex{solver:prob{cplex_handle:CPH},idx:[I|_],next:Next}, 1464 Lo0, Hi0, Lo, Hi) ?- 1465 cplex_get_col_bounds(CPH, I, Lo1, Hi1), 1466 Lo2 is max(Lo0, Lo1), 1467 Hi2 is min(Hi0, Hi1), 1468 lp_attr_get_bounds1(Next, Lo2, Hi2, Lo, Hi). 1469 lp_attr_get_bounds1(end, Lo0, Hi0, Lo, Hi) ?- 1470 Lo0 = Lo, Hi0 = Hi. 1471 1472% ---------------------------------------------------------------------- 1473% The user-level constraints 1474% ---------------------------------------------------------------------- 1475 1476:- local reference(lp_info). 1477:- local struct(lp_info(newid, % int: next handler id 1478 pending % suspension: lp_pending's suspension 1479 )). 1480 1481lp_impose_interval(Vs, Interval, Pool) :- 1482 (range(Interval, Lo, Hi) -> Hi >= Lo 1483 ; throw(abort) 1484 ), 1485 extract_vars(Vs, Lo, Hi, no, [], VList), % may abort 1486 get_pool_item(Pool, Handle), 1487 (Handle == 0 -> 1488 (foreach(V, VList), param(Pool, Lo, Hi) do 1489 % just post constraints (no solver to add to yet) 1490 cplex_lo_hi(MInf, PInf), 1491 (Lo < MInf -> Lo1 = MInf ; Lo1 = Lo), 1492 (Hi > PInf -> Hi1 = PInf ; Hi1 = Hi), 1493 (Lo1 == Hi1 -> 1494 add_pool_constraint(V=:=Lo1, Pool) 1495 ; 1496 add_pool_constraint(V>=Lo1, Pool), 1497 add_pool_constraint(V=<Hi1, Pool) 1498 ) 1499 ) 1500 ; 1501 lp_add_vars_interval(Handle, VList, Lo, Hi) 1502 ). 1503 1504 1505lp_interval(Vs, Interval, Pool) :- 1506 catch(lp_impose_interval(Vs, Interval, Pool), Tag, 1507 colon_interval_warning((::), Vs, Interval, Tag)). 1508 1509 % warn about: poolname:X::1..N 1510 colon_interval_warning(Functor, Vs, Interval, abort) :- !, 1511 Goal =.. [Functor,Vs,Interval], 1512 ( nonvar(Vs), Vs = (_:_) -> 1513 printf(error, "Eplex error: invalid syntax detected in %w; missing" 1514 " brackets perhaps?%n", [Goal]), 1515 throw(abort) 1516 ; 1517 error(5, Goal) 1518 ). 1519 colon_interval_warning(_Functor, _Vs, _Interval, Tag) :- 1520 throw(Tag). 1521 1522 :- mode range(?,-,-). 1523 range(L..H, Lo, Hi) ?- 1524 bound(L, Lo), 1525 bound(H, Hi). 1526 range([L..H], Lo, Hi) ?- % for IC/FD compatability 1527 bound(L, Lo), 1528 bound(H, Hi). 1529 1530 bound(L, _) :- var(L), !, fail. 1531 bound(L, Lo) :- integer(L), !, Lo is float(L). 1532 bound(L, Lo) :- rational(L), !, Lo is float(L). 1533 bound(L, Lo) :- real(L), !, Lo=L. 1534 bound(-inf, Lo) :- !, Lo = -1.0Inf. 1535 bound(inf, Hi) :- !, Hi = 1.0Inf. 1536 bound(+inf, Hi) :- !, Hi = 1.0Inf. 1537 bound(E, Bnd) :- 1538 catch((Bnd0 is E), _, fail), 1539 Bnd is float(Bnd0). 1540 1541% may throw(abort) indicating error 1542extract_vars(V, _, _, _, VList0, VList) :- 1543 var(V), !, 1544 VList = [V|VList0]. 1545extract_vars(V, Lo, Hi, CheckInt, VList0, VList) :- 1546 number(V), !, 1547 (CheckInt == yes -> integer(V) ; true), 1548 V >= Lo, V =< Hi, 1549 VList = VList0. 1550extract_vars([], _, _, _, VList0, VList) :- !, VList0 = VList. 1551extract_vars([X|Xs], Lo, Hi, CheckInt, VList0, VList) :- !, 1552 extract_vars(X, Lo, Hi, CheckInt, VList0, VList1), 1553 extract_vars(Xs, Lo, Hi, CheckInt, VList1, VList). 1554extract_vars(subscript(Array,Index), Lo, Hi, CheckInt, VList0, VList) :- 1555 subscript(Array, Index, E), !, 1556 extract_vars(E, Lo, Hi, CheckInt, VList0, VList). 1557extract_vars(_,_,_,_,_,_) :- throw(abort). 1558 1559 1560% Add constraint of any type (linear,sos,idc) to Pool 1561add_pool_constraint(Cstr, Pool) :- 1562 ( get_pool_handle(Handle, Pool) -> 1563 lp_add_constraints(Handle, [Cstr], []) 1564 ; 1565 % We don't have a solver yet: post constraints to pool. 1566 % For linear constraints, normalise and ground check them first. 1567 post_constraint_to_pool(Cstr, Pool) 1568 ). 1569 1570% Add constraints of any type (linear,sos,idc) to Pool 1571eplex_add_constraints(Cstrs, Ints, Pool) :- 1572 (get_pool_handle(Handle, Pool) -> 1573 lp_add_constraints(Handle, Cstrs, Ints) 1574 ; 1575 (foreach(C, Cstrs), param(Pool) do 1576 post_constraint_to_pool(C, Pool) 1577 ), 1578 integers(Ints, Pool) 1579 ). 1580 1581 1582 % Post linear, sos or idc constraints to Pool. 1583 % Linear ones get normalised and ground checked first. 1584 post_constraint_to_pool(Cstr, Pool) :- var(Cstr), !, 1585 error(4, post_constraint_to_pool(Cstr, Pool)). 1586 post_constraint_to_pool(Cstr, Pool) :- Cstr=sos1(_), !, 1587 post_typed_pool_constraint(Pool, sos of constraint_type, Cstr), 1588 set_lp_pending. 1589 post_constraint_to_pool(Cstr, Pool) :- Cstr=sos2(_), !, 1590 post_typed_pool_constraint(Pool, sos of constraint_type, Cstr), 1591 set_lp_pending. 1592 post_constraint_to_pool(Cstr, Pool) :- Cstr=(_=>_), !, 1593 post_typed_pool_constraint(Pool, idc of constraint_type, Cstr), 1594 set_lp_pending. 1595 post_constraint_to_pool(Cstr, Pool) :- 1596 normalise_cstr(Cstr, Norm0), 1597 !, 1598 try_ground_check(Norm0, Norm), % may fail 1599 ( var(Norm) -> 1600 true % simplified away 1601 ; 1602 post_typed_pool_constraint(Pool, linear of constraint_type, Norm), 1603 set_lp_pending 1604 ). 1605 post_constraint_to_pool(Cstr, Pool) :- 1606 error(5, post_constraint_to_pool(Cstr, Pool)). 1607 1608 1609lp_eq(X, Y, Pool) :- add_pool_constraint(X=:=Y, Pool). 1610 1611lp_ge(X, Y, Pool) :- add_pool_constraint(X>=Y, Pool). 1612 1613lp_le(X, Y, Pool) :- add_pool_constraint(X=<Y, Pool). 1614 1615sos1(Xs, Pool) :- add_pool_constraint(sos1(Xs), Pool). 1616 1617sos2(Xs, Pool) :- add_pool_constraint(sos2(Xs), Pool). 1618 1619indicator_constraint(Cond, Cstr, Pool) :- add_pool_constraint(Cond=>Cstr, Pool). 1620 1621 1622% Can handle only linear constraints, returns indexes 1623lp_add_constraints(Handle, Cstrs, Ints, Idxs) :- 1624 ( nonvar(Handle), nonvar(Cstrs), nonvar(Ints) -> true ; 1625 error(4, lp_add_constraints(Handle,Cstrs,Ints,Idxs)) 1626 ), 1627 normalise_and_check_linear_nonground(Cstrs, NormCs, lp_add_constraints), 1628 lp_add_indexed(Handle, NormCs, Ints, Idxs). 1629 1630 1631% Can handle only linear constraints, returns indexes 1632lp_add_cutpool_constraints(Handle, Cstrs, Opts, Idxs) :- 1633 ( nonvar(Handle), nonvar(Cstrs) -> true ; 1634 error(4, lp_add_cutpool_constraints(Handle, Cstrs, Opts, Idxs)) 1635 ), 1636 normalise_and_check_linear_nonground(Cstrs, NormCs, lp_add_cutpool_constraints), 1637 OptSet = cp_options{group:Name,active:Act,add_initially:Add}, 1638 ( (foreach(O:V, Opts), param(OptSet,Handle) do 1639 valid_cp_opt(O, OPos), 1640 valid_cp_optval(O, V, Handle, OVal), 1641 arg(OPos, OptSet, OVal) 1642 ) -> 1643 true 1644 ; 1645 printf(error, "Eplex error: Invalid option for" 1646 " lp_add_cutpool_constraints: %w%n", [Opts]), 1647 abort 1648 ), 1649 (var(Name) -> Name = [] ; true), 1650 (var(Act) -> Act = 1 ; true), 1651 (var(Add) -> Add = 1 ; true), 1652 Handle = prob{solver_id:SId,cplex_handle:CPH}, 1653 cplex_get_cutpool_size(CPH, NRows, NNzs), 1654 cplex_get_prob_param(CPH, 15, MaxVIdx), 1655 constraint_type_code(condcp, CType), 1656 get_named_cp_index(Handle, Name, NIdx), 1657 (setup_new_rows(CPH, SId, CType, MaxVIdx, NormCs, Idxs) -> 1658 (foreach(I,Idxs), param(CPH,NIdx,Act,Add) do 1659 rawidx_cstridx(_, RawI, I), 1660 cplex_init_cpcstr(CPH, RawI, NIdx, Act, Add) 1661 ) 1662 ; 1663 % NormCs has non-orginal variables - reset global constraints 1664 % pool and abort 1665 cplex_reset_cutpool_size(CPH, NRows, NNzs), 1666 printf(error, "Eplex error: trying to post cutpool constraints" 1667 " that contain new variables in %w.%n", 1668 [lp_add_cutpool_constraints(Handle, Cstrs, Opts, Idxs)]), 1669 abort 1670 ). 1671 1672 1673normalise_and_check_linear_nonground(Cstrs, NormCs, PredCall) :- 1674 ( normalise_cstrs(Cstrs, NormCs, NonLins) -> true ; 1675 printf(error, "Eplex error: unknown constraint in %w:%n%w%n", [PredCall,Cstrs]), 1676 abort 1677 ), 1678 ( NonLins = [Example|_] -> 1679 printf(error, "Eplex error: no nonlinear constraints allowed in %w:%n%w%n", [PredCall,Example]), 1680 abort 1681 ; 1682 true 1683 ), 1684 % check that there are no ground constraints 1685 ( (foreach(_:[_,_|_], NormCs) do true) -> true ; 1686 printf(error, "Eplex error: no ground constraints allowed in %w:%n%w%n", [PredCall,Cstrs]), 1687 abort 1688 ). 1689 1690all_nonground(NormCs) :- 1691 ( foreach(_:[_,_|_], NormCs) do true ). 1692 1693 1694% Add constraints of any type (linear,sos,idc) to existing Handle 1695lp_add_constraints(_Handle, [], []) :- !. 1696lp_add_constraints(Handle, Cstrs, Ints) :- 1697 ( nonvar(Handle), nonvar(Ints), nonvar(Cstrs) -> true ; 1698 error(4, lp_add_constraints(Handle,Cstrs,Ints)) 1699 ), 1700 normalise_cstrs(Cstrs, NormCs0, NonLins), 1701 !, 1702 % analyse the nonlinear part 1703 ( 1704 foreach(NonLin,NonLins), 1705 fromto(SOSs,SOSs1,SOSs2,[]), 1706 fromto(IDCs3,IDCs1,IDCs2,[]), 1707 fromto(NLs,NLs1,NLs2,[]) 1708 do 1709 ( var(NonLin) -> 1710 SOSs1=SOSs2, IDCs1=IDCs2, NLs1 = [NonLin|NLs2] 1711 ; NonLin = sos1(_) -> 1712 SOSs1 = [NonLin|SOSs2], IDCs1=IDCs2, NLs1=NLs2 1713 ; NonLin = sos2(_) -> 1714 SOSs1 = [NonLin|SOSs2], IDCs1=IDCs2, NLs1=NLs2 1715 ; NonLin = (_=>_), normalise_idc(NonLin, NormIDC) -> 1716 SOSs1=SOSs2, IDCs1 = [NormIDC|IDCs2], NLs1=NLs2 1717 ; SOSs1=SOSs2, IDCs1=IDCs2, NLs1 = [NonLin|NLs2] 1718 ) 1719 ), 1720 ( NLs = [Example|_] -> 1721 printf(error, "Unknown or nonlinear constraint in lp_add_constraints/3:%n%w%n", [Example]), 1722 abort 1723 ; 1724 true 1725 ), 1726 % preprocess the indicator constraints (may lead to new linear ones) 1727 ( 1728 foreach(IDC,IDCs3), 1729 fromto(IDCs,IDCs4,IDCs5,[]), 1730 fromto(NormCs3,NormCs2,NormCs1,NormCs0) 1731 do 1732 preprocess_idc(IDC, IDCs4, IDCs5, NormCs2, NormCs1) 1733 ), 1734 % preprocess the linear constraints 1735 ( 1736 foreach(Norm0, NormCs3), 1737 fromto(NormCs,NC0,NC1,[]), 1738 fromto(BoundCs,BC0,BC1,[]) 1739 do 1740 preprocess_norm_cstr(Norm0, NC0, NC1, BC0, BC1) 1741 ), 1742 lp_add_normalised(Handle, NormCs, BoundCs, Ints, SOSs, IDCs, _, OldInts, ChangedCols), 1743 wake_solver_if_needed(Handle, NormCs, OldInts, ChangedCols). 1744lp_add_constraints(Handle, Cstr, Ints) :- 1745 error(5, lp_add_constraints(Handle, Cstr, Ints)). 1746 1747 1748integers(Xs, Pool) :- 1749 catch(extract_vars(Xs, -1.0Inf, 1.0Inf, yes, VarsTail, Vars), abort, 1750 error(5, integers(Xs, Pool))), 1751 store_integers(Vars, VarsTail, Pool). 1752 1753reals(Xs, Pool) :- 1754 catch(extract_vars(Xs, -1.0Inf, 1.0Inf, no, VsTail, Vs), abort, 1755 error(5, reals(Xs, Pool))), 1756 get_pool_item(Pool, Handle), 1757 add_pool_vars(Handle, Pool, Vs, VsTail). 1758 1759 1760add_pool_vars(0, Pool, Xs, Tail) :- !, 1761% solver instance not yet created 1762 get_typed_pool_constraints(Pool, reals of constraint_type, Tail), 1763 set_typed_pool_constraints(Pool, reals of constraint_type, Xs). 1764add_pool_vars(Handle, _Pool, Xs, []) :- 1765 lp_add_vars(Handle, Xs). 1766 1767lp_add_vars(Handle, Xs) :- 1768 nonvar(Handle), 1769 Handle = prob{solver_id:SId, cplex_handle:CPH,option_vnames:VNames}, 1770 filter_and_index_new_vars(Handle, Xs, VarList, _OldXs, OldCols, NAdded), 1771 setup_new_cols(Handle, [], [], [], [], OldCols, NAdded, 0), 1772 cplex_flush_new_rowcols(Handle, 0), 1773 % Technically, variables without constraints do not need to trigger 1774 % a solver, but it would be difficult to add the triggers later... 1775 lp_add_var_triggers(Handle, VarList, NAdded), 1776 load_varnames(VNames, NAdded, CPH, SId, VarList). 1777 1778 1779% Add bound constraints to new or old variables. Lo and Hi are floats. 1780lp_add_vars_interval(Handle, Xs, Lo, Hi) :- 1781 nonvar(Handle), 1782 Handle = prob{solver_id:SId, cplex_handle:CPH,option_vnames:VNames}, 1783 filter_and_index_new_vars(Handle, Xs, VarList, OldVs, OldCols, NAdded), 1784 1785 % Add new variables with bounds and names 1786 % (we could pass bounds right here, but would need lists) 1787 setup_new_cols(Handle, [], [], [], [], OldCols, NAdded, 0), 1788 % set bounds on new variables 1789 ( 1790 count(_,1,NAdded), 1791 fromto(VarList,[X|Xs1],Xs1,_), 1792 param(SId,CPH,Lo,Hi) 1793 do 1794 get_unique_var_index(X, SId, J), 1795 cplex_init_bound(CPH, J, (>=), Lo), 1796 cplex_init_bound(CPH, J, (=<), Hi) 1797 ), 1798 cplex_flush_new_rowcols(Handle, 0), 1799 lp_add_var_triggers(Handle, VarList, NAdded), 1800 load_varnames(VNames, NAdded, CPH, SId, VarList), 1801 1802 % update intervals for old columns 1803 ( foreach(X, OldVs), param(Handle, Lo, Hi) do 1804 get_lp_attr(X, Handle, Attr), 1805 Attr = eplex{idx: Is}, 1806 lp_impose_col_bounds(Handle, Attr, Is, Lo, Hi) 1807 ), 1808 wake. 1809 1810 1811% Constraints with 1 or more variables and Integers are collected in 1812% constraint pool(s). lp_pending/0 is used to indicate that there might 1813% be pending constraints in the pools. 1814% The auxiliary lp_pending_cleanup/1 delays on 'postponed' and kills 1815% itself and the lp_pending/0 when woken. 1816 1817 1818lp_pending. 1819 1820set_lp_pending :- % setup lp_pending suspension if needed 1821 get_lp_info(LPInfo), 1822 LPInfo = lp_info{pending:Pending}, 1823 (is_suspension(Pending) -> 1824 true 1825 ; 1826 make_suspension(lp_pending, 12, NewPending), 1827 setarg(pending of lp_info, LPInfo, NewPending), 1828 suspend(lp_pending_cleanup(S), 11, trigger(postponed), S) 1829 ). 1830 1831:- demon lp_pending_cleanup/1. 1832lp_pending_cleanup(Susp) :- 1833 recorded(lp_pools, PoolName), 1834 \+ pool_is_empty(PoolName), 1835 !, 1836 % some constraints pending, kill only cleanup's suspension. 1837 kill_suspension(Susp). 1838lp_pending_cleanup(Susp) :- 1839 kill_suspension(Susp), 1840 get_lp_info(lp_info{pending:PSusp}), 1841 ( is_suspension(PSusp) -> kill_suspension(PSusp) ; true ). 1842 1843:- local portray(lp_pending/0, tr_out/2, [goal]). 1844:- export tr_out/2. 1845tr_out(lp_pending, Goals) :- 1846 recorded_list(lp_pools, PoolNames), 1847 (foreach(Pool, PoolNames), fromto(GoalList, GsIn,GsOut, []) do 1848 get_typed_pool_constraints(Pool, integers of constraint_type, Integers), 1849 get_typed_pool_constraints(Pool, reals of constraint_type, Reals), 1850 get_typed_pool_constraints(Pool, linear of constraint_type, NormCstrs), 1851 get_typed_pool_constraints(Pool, sos of constraint_type, SOSs), 1852 get_typed_pool_constraints(Pool, idc of constraint_type, IDCs), 1853 ( Integers == [] -> GsIn=Gs0 ; GsIn=[Pool:integers(Integers)|Gs0]), 1854 ( Reals == [] -> Gs0=Gs1 ; Gs0=[Pool:reals(Reals)|Gs1]), 1855 ( foreach(SOS,SOSs), fromto(Gs1,[Goal|Goal1],Goal1,Gs2), param(Pool) do 1856 Goal = Pool:SOS 1857 ), 1858 ( foreach(IDC,IDCs), fromto(Gs2,[Goal|Goal1],Goal1,Gs3), param(Pool) do 1859 Goal = Pool:IDC 1860 ), 1861 ( foreach(NormCstr,NormCstrs), fromto(Gs3,[Goal|Goal1],Goal1,GsOut), param(Pool) do 1862 denormalise_cstr(NormCstr, Cstr), 1863 Goal = Pool:Cstr 1864 ) 1865 ), 1866 (fromto(GoalList, [Goal|GL0],GL0, [LastGoal]), 1867 fromto(Goals, (Goal,Goals0),Goals0, LastGoal) do true 1868 ). 1869 1870 1871% collect variables declared by reals/1 1872collect_reals(Vars) :- 1873 collect_typed_pool_constraints(eplex, reals of constraint_type, Vars). 1874 1875collect_integers(Integers) :- 1876 collect_typed_pool_constraints(eplex, integers of constraint_type, Integers). 1877 1878store_integers(NewIntegers, Tail, Pool) :- 1879 (get_pool_handle(Handle, Pool) -> 1880 % if there is a solver store the integer constraint 1881 Tail = [], 1882 lp_add_normalised(Handle, [], [], NewIntegers, [], [], _, OldInts, _BdChgs), 1883 1884 Handle = prob{suspension:Susp, nc_trigger: NCTrigger}, 1885 % wake demon if a old variable is made integer 1886 % and new_constraint trigger condition is defined 1887 ( OldInts \== [], NCTrigger == yes -> 1888 schedule_suspensions(1, s([Susp])), 1889 wake 1890 ; 1891 true 1892 ) 1893 ; 1894 set_lp_pending, 1895 get_typed_pool_constraints(Pool, integers of constraint_type, OldIntegers), 1896 set_typed_pool_constraints(Pool, integers of constraint_type, NewIntegers), 1897 Tail = OldIntegers 1898 ). 1899 1900collect_lp_constraints_norm(CstrsNorm) :- 1901 collect_typed_pool_constraints(eplex, linear of constraint_type, CstrsNorm). 1902 1903 1904 1905% ---------------------------------------------------------------------- 1906% The black-box solver 1907% ---------------------------------------------------------------------- 1908 1909optimize_body(OptExpr, ObjVal, Caller) :- 1910 optimize_body(OptExpr, [], ObjVal, Caller). 1911 1912optimize_body(OptExpr, Options, ObjVal, Caller) :- 1913 get_pool_item(eplex, 0), % may fail 1914 !, 1915 collect_lp_constraints_norm(Cstr), 1916 collect_integers(Ints), 1917 lp_setup_body(Cstr, OptExpr, [integers(Ints)|Options], Handle, Caller), 1918% lp_write(Handle, lp, 'eplex_lastprob'), 1919 lp_solve(Handle, ObjVal), 1920 lp_get(Handle, vars, VArr), 1921 lp_get(Handle, typed_solution, SolutionVector), 1922 VArr = SolutionVector, % do the bindings 1923 lp_cleanup(Handle). 1924optimize_body(OptExpr, _Options, ObjVal, _) :- 1925 printf(error, "Eplex error: instance 'eplex' already has an associated solver in %w%n", 1926 [optimize(OptExpr, ObjVal)]), 1927 abort. 1928 1929/* 1930% for the manual: 1931optimize(OptExpr, ObjVal) :- 1932 eplex:eplex_solver_setup(OptExpr), 1933 eplex:eplex_solve(ObjVal), 1934 eplex:eplex_get(vars, VArr), 1935 eplex:eplex_get(typed_solution, SolutionVector), 1936 VArr = SolutionVector, % do the bindings 1937 eplex:eplex_cleanup. 1938*/ 1939 1940% ---------------------------------------------------------------------- 1941% Invoking the LP-solver as a demon 1942% ---------------------------------------------------------------------- 1943:- local struct(demon_opts(collect_from,initial_solve,priority)). 1944 1945 1946:- tool(eplex_solver_setup_cbody/6, eplex_solver_setup_body/7). % compatibility 1947eplex_solver_setup_body(OptExpr, Cost, Options, Prio, TriggerModes, Pool, CallerModule) :- 1948 eplex_solver_setup_body(OptExpr, Cost, [priority(Prio)|Options], 1949 TriggerModes, Pool, CallerModule). 1950 1951 1952:- tool(eplex_solver_setup_cbody/5, eplex_solver_setup_body/6). 1953eplex_solver_setup_body(OptExpr, Cost, Options, TriggerModes, Pool, CallerModule) :- 1954 lp_demon_setup_body(OptExpr, Cost, [collect_from(pool(Pool))|Options], TriggerModes, _Handle, CallerModule). 1955 1956:- tool(eplex_solver_setup/2, eplex_solver_setup/3). 1957eplex_solver_setup(OptExpr, Pool, CallerModule) :- 1958 lp_demon_setup_body(OptExpr, _Cost, [priority(0),collect_from(pool(Pool))], [], _Handle, CallerModule). 1959 1960 1961% compatibility 1962lp_demon_setup_body(OptExpr, Cost, Options, Prio, TriggerModes, Handle, CallerModule) :- 1963 lp_demon_setup_body(OptExpr, Cost, [priority(Prio)|Options], 1964 TriggerModes, Handle, CallerModule). 1965 1966lp_demon_setup_body(OptExpr, Cost, Options0, TriggerModes, Handle, CallerModule) :- 1967 set_default_demon_options(DemonOptions, TriggerModes), 1968 clean_options(Options0, Options, DemonOptions), 1969 DemonOptions = demon_opts{collect_from:CollectCstrs,priority:Prio, 1970 initial_solve:InitSolve}, 1971 (CollectCstrs = pool(Pool) -> 1972 % Pool should not already have an associated solver 1973 pool_has_no_solver(Pool), 1974 collect_typed_pool_constraints(Pool, linear of constraint_type, Cstr), 1975 collect_typed_pool_constraints(Pool, integers of constraint_type, Ints), 1976 collect_typed_pool_constraints(Pool, reals of constraint_type, PVars), 1977 collect_typed_pool_constraints(Pool, sos of constraint_type, SOSs), 1978 collect_typed_pool_constraints(Pool, idc of constraint_type, IDCs) 1979 ; 1980 Ints = [], Cstr = [], PVars = [], SOSs = [], IDCs = [] 1981 ), 1982 append(SOSs, Options, SOSsOptions), 1983 lp_setup_body(Cstr, OptExpr, [reals(PVars),integers(Ints)|SOSsOptions], 1984 Handle, CallerModule), 1985 % indicator constraints not accepted by lp_setup, add now 1986 lp_add_constraints(Handle, IDCs, []), 1987 1988 % associate solver with pool (must be done after lp_setup) 1989 (CollectCstrs = pool(Pool) -> lp_pool_associate_solver(Pool, Handle) ; true), 1990 1991 % rearranged code so that various initialisations are still done 1992 % with TriggerModes = [] as PostGoal must be initialised for 1993 % any initial solving 1994 Handle = prob{vars:VList,suspension:Susp}, 1995 (TriggerModes \== [] -> 1996 (cannot_impose_bound(Cost) -> 1997 event(lp_obj_nobounds_warning) 1998 ; 1999 true 2000 ), 2001 2002 make_suspension(lp_demon(Handle, Cost, PreGoal, PostGoal, CallerModule), Prio, Susp) 2003 ; 2004 % No trigger modes, no need to create the demon! 2005 true 2006 ), 2007 2008 ( global_triggers(TriggerModes, Handle, Susp, PreGoal, PostGoal, [], VarTriggerModes), 2009 var_triggers(VarTriggerModes, Handle, Susp, VList) 2010 -> 2011 true 2012 ; 2013 printf(error, "Eplex error: invalid trigger conditions" 2014 " specified while setting up problem:%w%n", [TriggerModes]), 2015 abort 2016 ), 2017 setarg(triggermodes of prob, Handle, VarTriggerModes), 2018 2019 !, 2020 (InitSolve == yes -> 2021 lp_solve(Handle, _LpCost), 2022 post_lp_demon_solve(Handle, Cost, PostGoal, CallerModule) 2023 ; 2024 true 2025 ). 2026 2027 2028 :- mode global_triggers(?,+,+,-,-,+,-). 2029 global_triggers(X, _, _, _, _, _, _) :- var(X), !, fail. 2030 global_triggers([], _, _, Pre, Post, VTM, VTM) :- !, 2031 ( Pre=true -> true ; true ), 2032 ( Post=true -> true ; true ). 2033 global_triggers([TM|TMs], H, S, Pre, Post, VTMs0, VTMs) :- !, 2034 global_triggers(TM, H, S, Pre, Post, VTMs0, VTMs1), 2035 global_triggers(TMs, H, S, Pre, Post, VTMs1, VTMs). 2036 global_triggers(new_constraint, H, _, _, _, VTM, VTM) :- !, 2037 setarg(nc_trigger of prob, H, yes). 2038 global_triggers(pre(Goal), _, _, Goal, _, VTM, VTM) :- !. 2039 global_triggers(post(Goal), _, _, _, Goal, VTM, VTM) :- !. 2040 global_triggers(trigger(Atom), _, S, _, _, VTM, VTM) :- !, 2041 attach_suspensions(Atom, S). 2042 global_triggers(suspension(S), _, S, _, _, VTM, VTM) :- !. 2043 global_triggers(VTM, _, _, _, _, VTMs, [VTM|VTMs]). 2044 2045 var_triggers([], _H, _S, _Vars) ?- true. 2046 var_triggers([TM|TMs], H, S, Vars) ?- 2047 var_triggers(TM, H, S, Vars), 2048 var_triggers(TMs, H, S, Vars). 2049 var_triggers(inst, _H, S, Vars) ?- 2050 insert_suspension(Vars, S, inst of suspend, suspend). 2051 var_triggers(deviating_inst, H, S, Vars) ?- 2052 (foreach(V, Vars), param(S, H) do 2053 (var(V) -> 2054 get_lp_attr(V, H, Attr), 2055 enter_suspension_list(intol_inst of eplex, Attr, S) 2056 ; true 2057 ) 2058 ). 2059 var_triggers(bounds, Handle, _S, _Vars) ?- 2060 setarg(bd_trigger of prob, Handle, bounds). 2061 var_triggers(deviating_bounds, Handle, _S, _Vars) ?- 2062 setarg(bd_trigger of prob, Handle, deviating_bounds). 2063 var_triggers(Module:Field, _H, S, Vars) ?- 2064 ( atom(Field) -> 2065 sepia_kernel:tr_of(no_macro_expansion(Field of Module), Index, Module) 2066 ; 2067 integer(Field), Index = Field 2068 ), 2069 insert_suspension(Vars, S, Index, Module). 2070 2071 set_default_demon_options(demon_opts{collect_from:pool(eplex), 2072 initial_solve:InitialSolve, priority:0}, TriggerModes) :- 2073 ( TriggerModes == [] -> InitialSolve = no ; InitialSolve = yes ). 2074 2075:- demon(lp_demon/5). 2076:- set_flag(lp_demon/5, priority, 5). 2077lp_demon(Handle, Cost, PreGoal, PostGoal, CallerModule) :- 2078 ( call(PreGoal)@CallerModule -> 2079 lp_solve(Handle, _LpCost), 2080 post_lp_demon_solve(Handle, Cost, PostGoal, CallerModule) 2081 ; 2082 true 2083 ). 2084 2085post_lp_demon_solve(Handle, Cost, PostGoal, CallerModule) :- 2086 call(PostGoal)@CallerModule, 2087 arg(bestbound of prob, Handle, BestBound), 2088 % bestbound is always a valid bestbound on Cost 2089 ( lp_get(Handle, sense, min) -> 2090 LpBound is BestBound - lp_get(Handle, optimizer_param(feasibility_tol)), 2091 2092 set_var_bounds(Cost, LpBound, 1.0Inf) 2093 ; 2094 LpBound is BestBound + lp_get(Handle, optimizer_param(feasibility_tol)), 2095 set_var_bounds(Cost, -1.0Inf, LpBound) 2096 ), 2097 wake. 2098 2099 2100lp_obj_nobounds_warning :- 2101 writeln(warning_output, "Warning: Setting up an lp_demon with a cost variable that cannot"), 2102 writeln(warning_output, "have bounds imposed. Consider using a domain variable."). 2103 2104% succeed if the argument cannot have a bound imposed (from branch_and_bound) 2105cannot_impose_bound(X) :- free(X). 2106cannot_impose_bound(X) :- meta(X), 2107 get_var_bounds(X, L, H), 2108 H =:= 1.0Inf, 2109 L =:= -1.0Inf, 2110 % try imposing a bound and check if it worked 2111 call_priority(( 2112 set_var_bounds(X, L, 0), 2113 get_var_bounds(X, _, H1), 2114 H1 =:= 1.0Inf 2115 ), 1). 2116 2117 2118 2119 2120 2121instantiation_deviates(Handle) :- 2122 Handle = prob{vars:VList, sols:OldSolution, 2123 demon_tol_real:RT, demon_tol_int:IT}, 2124 not tolerable_inst(VList, OldSolution, _, RT, IT). 2125 2126 tolerable_inst([], _, N, _, _) :- !, N = 0. 2127 tolerable_inst([X|Xs], SArr, N1, RT, IT) :- 2128 tolerable_inst(Xs, SArr, N, RT, IT), 2129 N1 is N + 1, 2130 get_darray_element(SArr, N, S), 2131 tolerable_inst(X, S, RT, IT). 2132 2133 tolerable_inst(X, S, _, IT) :- 2134 integer(X), 2135 X-IT =< S, S =< X+IT. 2136 tolerable_inst(X, S, RT, _) :- 2137 real(X), 2138 X-RT =< S, S =< X+RT. 2139 tolerable_inst(X, _S, _RT, _IT) :- 2140 var(X). 2141 2142 2143solution_out_of_range(Handle) :- 2144 Handle = prob{vars:VList, sols:OldSolution, 2145 cplex_handle:CPH, 2146 demon_tol_real:RT, demon_tol_int:IT}, 2147 not tolerable_range(VList, OldSolution, CPH, Handle, _, RT, IT). 2148 2149 2150tolerable_range([], _, _, _, N, _, _) :- !, cplex_matrix_base(N). 2151tolerable_range([X|Xs], SArr, CPH, Handle, N1, RT, IT) :- 2152 tolerable_range(Xs, SArr, CPH, Handle, N, RT, IT), 2153 % cannot rely on getting col. no. from X as it may be non-var 2154 get_darray_element(SArr, N, S), 2155 lp_var_get_bounds(Handle, X, Min, Max), 2156 N1 is N + 1, 2157 tolerable_range_var(S, Min, Max, CPH, N, RT, IT). 2158 2159 2160% Bounds Min, Max supplied to allow caller of tolerable_range_var to chose 2161% how bounds are obtained 2162tolerable_range_var(S, Min, Max, CPH, I, RT, IT) :- 2163 cplex_get_col_type(CPH, I, TC), 2164 cplex_type_code(T, TC), 2165 ( T = integer -> 2166 Min-IT =< S, S =< Max+IT 2167 ; 2168 Min-RT =< S, S =< Max+RT 2169 ). 2170 2171 2172% If Handle has a delayed solver, check 4 waking conditions: 2173% - We have the 'new_constraint' trigger (nc_trigger=yes) and 2174% not all constraints are satisfied with their current solutions. 2175% - We have the 'new_constraint' trigger (nc_trigger=yes) and 2176% any variable had its type changed (integrality imposed) 2177% - We have the 'bounds' trigger and any bound changed 2178% - We have the 'deviating_bounds' trigger and any bound change 2179% excluded the current solution 2180wake_solver_if_needed(Handle, NormCstrs, TypeChangedVars, ChangedCols) :- 2181 Handle = prob{suspension:Susp, nc_trigger:NcTrigger}, 2182 ( 2183 is_suspension(Susp), 2184 ( 2185 NcTrigger == yes, 2186 TypeChangedVars = [_|_] 2187 ; 2188 NcTrigger == yes, 2189 member(Norm, NormCstrs), 2190 \+satisfied_now(Norm, Handle) 2191 ; 2192 member(I, ChangedCols), 2193 bound_change_requires_scheduling(Handle, I) 2194 ) 2195 -> 2196 schedule_suspensions(1, s([Susp])), 2197 wake 2198 ; 2199 true 2200 ). 2201 2202 2203% ---------------------------------------------------------------------- 2204% Preprocessing - treat the trivial constraints: 2205% Check the ground ones, turn single-variable constraints into bound updates. 2206% ---------------------------------------------------------------------- 2207 2208 2209preprocess_norm_cstr(NormIn, Linears, Linears0, Bounds, Bounds0) :- 2210 NormIn = Sense:[Cst*_|Lhs], 2211 ( Lhs = [] -> % ground: check immediately 2212 satisfied(Sense, Cst), 2213 Bounds = Bounds0, 2214 Linears = Linears0 2215 ; Lhs = [_C*_X] -> % single var 2216 Bounds = [NormIn|Bounds0], 2217 Linears = Linears0 2218 ; 2219 Linears = [NormIn|Linears0], 2220 Bounds = Bounds0 2221 ). 2222 2223try_ground_check(NormIn, NormOut) :- 2224 NormIn = Sense:[Cst*_|Lhs], 2225 ( Lhs = [] -> % ground: check immediately 2226 satisfied(Sense, Cst) 2227 ; 2228 NormIn = NormOut 2229 ). 2230 2231 2232% Filter out degenerate indicator constraints (Bool 0 or 1) 2233% We do not further check the Bool variable here: must be done later. 2234% May fail if Bool instantiated, but not to 0 or 1 (of any numerical type) 2235preprocess_idc(IDC, IDCs, IDCs0, NormCs, NormCs0) :- 2236 IDC = idc(Cpl,BoolExpr,LinNorm), 2237 ( var(BoolExpr) -> 2238 IDCs = [IDC|IDCs0], NormCs = NormCs0 2239 ; 2240 Bool is BoolExpr, % evaluate subscripts etc 2241 ( var(Bool) -> 2242 IDCs = [idc(Cpl,Bool,LinNorm)|IDCs0], NormCs = NormCs0 2243 ; Bool =:= Cpl -> % constraint is void 2244 IDCs = IDCs0, NormCs = NormCs0 2245 ; Bool =:= 1-Cpl -> % degenerates to plain linear 2246 IDCs = IDCs0, NormCs = [LinNorm|NormCs0] 2247 ; 2248 fail 2249 ) 2250 ). 2251 2252 2253 renormalise_and_check_simple([], [], []). 2254 renormalise_and_check_simple([Sense:Expr|Cstrs], RemCstrs, BdCstrs) :- 2255 linrenorm(Expr, NormExpr0), 2256 preprocess_norm_cstr(Sense:NormExpr0, RemCstrs, RemCstrs1, BdCstrs, BdCstrs1), % may fail 2257 renormalise_and_check_simple(Cstrs, RemCstrs1, BdCstrs1). 2258 2259 2260% Process a list of normalised constraints and turn them into matrix 2261% coefficients (filled into the Cols array) and a list of the right hand sides. 2262% Bounds (single var) constraints are extracted into a separate list. 2263% Ground constraints are checked for consistency and may lead to failure. 2264% We also count the true constraints (rows) and the nonzero coefficients. 2265 2266%process_constraints(+Cstrs, -Rhss, -Bs, +SId, +RowNr0, -RowNr, +NZ0, -NZ, +Colz) 2267process_constraints([], [], [], _, Rows, Rows, NonZeros, NonZeros, _). 2268process_constraints([Cstr|Cstrs], Rhss, Bs, SId, Rows0, Rows, N0, N, Cols) :- 2269 Cstr = Sense:[Cst*_|Lhs], 2270 Rhs is -Cst, 2271 ( Lhs = [] -> % ground: check immediately 2272 Rows1 = Rows0, 2273 N1 = N0, 2274 Bs1 = Bs, 2275 Rhss1 = Rhss, 2276 satisfied(Sense, Cst) 2277 ; Lhs = [_] -> % collect bounds constraints for later 2278 Rows1 = Rows0, 2279 N1 = N0, 2280 Rhss = Rhss1, 2281 Bs = [Cstr|Bs1] 2282 ; 2283 Rows1 is Rows0+1, 2284 add_coeffs(Lhs, Cols, SId, Rows0, N0, N1), 2285 % writeln(Lhs-Sense-Rhs) 2286 Rhss = [Sense:Rhs|Rhss1], 2287 Bs1 = Bs 2288 ), 2289 process_constraints(Cstrs, Rhss1, Bs1, SId, Rows1, Rows, N1, N, Cols). 2290 2291 satisfied((=<), C) :- C =< 0. 2292 satisfied((>=), C) :- C >= 0. 2293 satisfied((=:=), C) :- C =:= 0. 2294 2295 swap_sense(C, (=<), (>=)) :- C < 0, !. 2296 swap_sense(C, (>=), (=<)) :- C < 0, !. 2297 swap_sense(_, S, S). 2298 2299 2300 add_coeffs([], _, _, _, N, N). 2301 add_coeffs([C*X|More], Cols, SId, Row, N0, N) :- 2302 % if there are merged cols, the coeff C should be put on 2303 % *one* of the columns only 2304 get_first_var_index(X, SId, J), 2305 J1 is J+cplex_matrix_offset, 2306 arg(J1, Cols, Col0), 2307 ( var(Col0) -> arg(J1, Cols, [Row:C]) 2308 ; setarg(J1, Cols, [Row:C|Col0]) ), 2309 N1 is N0+1, 2310 add_coeffs(More, Cols, SId, Row, N1, N). 2311 2312 2313satisfied_now(Sense:Lhs, Handle) :- 2314 eval_lhs(0.0, Handle, Lhs, ValLhs), 2315 satisfied(Sense, ValLhs). 2316 2317 eval_lhs(Cst,_,[],Cst). 2318 eval_lhs(Cst0,H,[C*V|Vs],N) :- 2319 lp_var_solution(H, V, Val), % can fail if V has no attribute 2320 Cst is Cst0 + C * Val, 2321 eval_lhs(Cst,H,Vs,N). 2322 2323% ---------------------------------------------------------------------- 2324% Setup the LP solver 2325% 2326% lp_setup - All the constraints are passed explicitly in the list Cstr. 2327% Also, the variables may have bounds already. The constraints are 2328% first simplified and converted into coefficients (and possibly 2329% bound updates). This data is then copied into cplex arrays. 2330% 2331% Accepts normalised linear constraints, and option integers(Ints). 2332% For backward compatibility, it also accepts sos[12](Xs) options. 2333% We don't accept indicator constraints, they must be added later. 2334% ---------------------------------------------------------------------- 2335 2336:- pragma(noexpand). % because of compiler bug 2337 2338lp_setup_body(Cstr, OptExpr, Options, Handle, CallerModule) :- 2339 ( getval(licence_data, none) -> 2340 writeln(error, "Eplex error: cannot use solver: no license" 2341 " information available."), 2342 abort 2343 ; var(OptExpr) -> error(4, lp_setup(Cstr, OptExpr, Options, Handle)) 2344 ; cplex_objsense(OptExpr, Sense, Expr) -> true 2345 ; printf(error, "Eplex error: optimisation direction not specified " 2346 "for objective.%n Should be min(%w) or max(%w)%n", 2347 [OptExpr,OptExpr]), 2348 error(5, lp_setup(Cstr, OptExpr, Options, Handle)) 2349 ), 2350 2351 Handle = prob{vars:Vars, ints:Ints, obj:ObjConst, objsense:Sense, 2352 linobj:LinObjFunct, quadobj:QuadObjFunct, 2353 solver_id:SId, caller_module:CallerModule, 2354 mr:0, sols:[]}, 2355 TempData = temp_prob{sos:[],extra_vars:[],use_copy:1}, 2356 % Initialise some fields in the handle... 2357 new_solver_id(SId), 2358 init_suspension_list(aux_susps of prob, Handle), 2359 2360 catch(process_options(Options, Handle, TempData), % read options 2361 abort, error(6, lp_setup(Cstr, OptExpr, Options, Handle)) 2362 ), 2363 fill_in_defaults(Handle), 2364 2365 renormalise_cstrs(Cstr, CstrNorm), 2366 quadnorm(Expr, ObjConst, LinObjFunct, QuadObjFunct), % After propagate! 2367 arg(extra_vars of temp_prob, TempData, ExtraVars), 2368 % Ints extracted from Options: could contain vars not in Cstr 2369 % use the *ObjFunct instead of Expr to avoid large structres 2370 % which may crash term_variables/2 2371 term_variables([ExtraVars,Ints,LinObjFunct,QuadObjFunct|CstrNorm], Vars), 2372 2373 % setup change_suspension list 2374 init_suspension_list(change_suspensions of prob, Handle), 2375 low_level_setup(Handle, TempData, CstrNorm). 2376 2377 2378 2379new_solver_id(SId) :- 2380 get_lp_info(LPInfo), 2381 LPInfo = lp_info{newid:SId}, 2382 SId1 is SId + 1, 2383 setarg(newid of lp_info, LPInfo, SId1). 2384 2385 2386get_lp_info(LPInfo) :- 2387 getval(lp_info, LPInfo0), 2388 (LPInfo0 = lp_info{} -> 2389 LPInfo0 = LPInfo 2390 ; 2391 LPInfo = lp_info{newid:0,pending:none}, 2392 setval(lp_info, LPInfo) 2393 ). 2394 2395:- pragma(expand). % because of compiler bug 2396 2397 2398% Low-level solver setup 2399 2400low_level_setup(Handle, TempData, CstrNorm) :- 2401 Handle = prob{ vars:VarList, % in 2402 ints:Ints, % in 2403 linobj:LinObjFunct, % in 2404 quadobj:QuadObjFunct, % in 2405 objsense:Sense, % in 2406 presolve:PreSolve, % in 2407 option_vnames:VNames, % in 2408 solver_id:SId, % in 2409 objcoeffs:ObjCoeffs, % out 2410 qobjcoeffs:QuadObjCoeffs % out 2411 }, 2412 TempData = temp_prob{use_copy:UseCopy,sos:SOSs}, 2413 2414 % convert constraints into matrix coefficients and rhs 2415 cplex_matrix_base(MBase), % starting column number 2416 set_var_indices(VarList, Handle, MBase, _, Cols), 2417 functor(ColCoeffs, '', Cols), 2418 process_constraints(CstrNorm, Rhs, BdCstrs, SId, MBase, Rows, 0, NonZeros, ColCoeffs), 2419 get_flag(tmp_dir, TDir), 2420 os_file_name(TDir,OSTDir), 2421 % solver setup, will cleanup on failure 2422 cplex_prob_init(PreSolve, UseCopy, Rows, Cols, NonZeros, OSTDir, 2423 Sense, Handle), 2424 arg(cplex_handle of prob, Handle, CPH), % after cplex_prob_init 2425 set_initial_bounds(CPH, SId, BdCstrs), % may fail 2426 obj_coeffs(LinObjFunct, SId, ObjCoeffs), 2427 set_obj_coeffs(CPH, ObjCoeffs), 2428 qobj_coeffs(QuadObjFunct, SId, QuadObjCoeffs), 2429 set_qobj_coeffs(CPH, QuadObjCoeffs), 2430 set_rhs(CPH, Rhs, 0), 2431 set_type_integer(CPH, SId, Ints), % may change prob type to MIP 2432 set_mat(CPH, ColCoeffs, 0, 0, Cols), 2433 set_sos(Handle, SOSs), % may change prob type to MIP 2434 cplex_loadprob(CPH), 2435 load_varnames(VNames, Cols, CPH, SId, VarList). 2436 2437 2438% ---------------------------------------------------------------------- 2439% Adding constraints and variables 2440% ---------------------------------------------------------------------- 2441 2442lp_add(Handle, Cstr, Integers) :- 2443 (var(Handle) ; var(Cstr) ; var(Integers)), !, 2444 error(4, lp_add(Handle, Cstr, Integers)). 2445lp_add(Handle, Cstr, Integers) :- 2446 renormalise_and_check_simple(Cstr, CstrNorm, BdCstrs), 2447 lp_add_normalised(Handle, CstrNorm, BdCstrs, Integers, [], [], _RowIdxs, _TypeChgs, _BdChgs). 2448 % don't wake here (as documented - but why?) 2449 2450 2451lp_add_var_triggers(Handle, AllVarsNewFirst, NAdded) :- 2452 nonvar(Handle), Handle = prob{suspension:Susp, triggermodes:VarTriggerModes}, 2453 ( var(Susp) -> 2454 true 2455 ; VarTriggerModes = [] -> 2456 true 2457 ; 2458 ( count(_,1,NAdded), fromto(AllVarsNewFirst,[X|Xs],Xs,_), foreach(X,NewVars) do 2459 true 2460 ), 2461 var_triggers(VarTriggerModes, Handle, Susp, NewVars) 2462 ). 2463 2464 2465% This is the core predicate for adding constraints. 2466% It will add CstrNorm as proper rows (without further checking 2467% or simplification, even when they are ground or single-variable). 2468% The single-variable BdCstrs will be added as bound updates. 2469% Integers will be added as integrality constraints. 2470% All of {CstrNorm,BdCstrs,Integers} may contain new variables. 2471% Returns indices of added rows, new variables, and a list of 2472% old variables that had integrality imposed. 2473% No waking is done here (but the necessary information is returned). 2474% New variables get row indices, but no suspensions. 2475 2476% lp_add_normalised(+Handle,+CstrNorm,+BdCstrs,+Integers,+SOSs,+IDCs,-RowIdxs,-TypeChanges,-ChangedCols) 2477lp_add_normalised(Handle, CstrNorm, BdCstrs, Integers, SOSs, IDCs, RowIdxs, TypeChanges, ChangedCols) :- 2478 Handle = prob{cplex_handle:CPH, solver_id:SId, 2479 ints:ExistingInts,option_vnames:VNames}, 2480 2481 % Split single-var constraints into new and old var ones 2482 % this must be done before new vars are given indices! 2483 filter_new_vars(SId, Integers, NewIntegers, TypeChanges), 2484 filter_new_vars_bc(SId, BdCstrs, NewBCs, OldBCs), 2485 % make a list that contains at least all new variables 2486 term_variables([](CstrNorm,NewBCs,NewIntegers,SOSs,IDCs), Vars), 2487 % give indices to the new variables (OldCols..OldCols+AddedCols-1) 2488 % Varlist will start with AddedCols new variables 2489 filter_and_index_new_vars(Handle, Vars, VarList, _, OldCols, AddedCols), 2490 2491 % destroy saved basis, if necessary 2492 ( AddedCols == 0, CstrNorm == [] -> true ; 2493 clear_result(Handle, cbase of prob), 2494 clear_result(Handle, rbase of prob) 2495 ), 2496 2497 % allocate and initialise buffer arrays (for columns) 2498 setup_new_cols(Handle, [], [], [], [], OldCols, AddedCols, 0), 2499 % set bounds on new variables 2500 set_initial_bounds(CPH, SId, NewBCs), % may fail 2501 2502 % update bounds on old variables 2503 update_bounds(Handle, OldBCs, ChangedCols), % may fail 2504 2505 ( Integers == [] -> true ; 2506 % we need to change problem type first before adding 2507 % integers; as cplex_init_type/3 also sets the 2508 % problem type to MIP (non-backtrackably) 2509 cplex_change_lp_to_mip(Handle), % backtrackable 2510 2511 % set integer type on new variables 2512 set_type_integer(CPH, SId, NewIntegers), 2513 2514 % change old variables to integers 2515 (foreach(Old, TypeChanges), param(Handle,CPH,SId), 2516 % OldIntegers1: existing prob. vars. which were not 2517 % of type integer already 2518 fromto([], OldInts0,OldInts1, OldIntegers1) do 2519 get_var_index(Old, SId, Is), % must exist 2520 Is = [FirstI|_], 2521 cplex_get_col_type(CPH, FirstI, OldTypeCode), 2522 cplex_get_col_bounds(CPH, FirstI, Lo, Hi), 2523 cplex_type_code(OldType, OldTypeCode), 2524 (OldType \== integer -> 2525 OldInts1 = [Old|OldInts0], 2526 type_to_cplex_type(integer, Lo, Hi, TypeCode), 2527 (foreach(I, Is), param(Handle,TypeCode) do 2528 cplex_change_col_type(Handle, I, TypeCode) % backtrackable 2529 ) 2530 ; 2531 OldInts1 = OldInts0 2532 ) 2533 ), 2534 append(NewIntegers, ExistingInts, AllIntegers0), 2535 append(OldIntegers1, AllIntegers0, AllIntegers), 2536 setarg(ints of prob, Handle, AllIntegers) 2537 ), 2538 2539 % new constraints and number of new variables 2540 setup_new_rows(CPH, SId, 0, _, CstrNorm, RowIdxs), 2541 cplex_flush_new_rowcols(Handle, 0), 2542 2543 % flush SOSs after new columns 2544 ( SOSs == [] -> true ; 2545 cplex_change_lp_to_mip(Handle), % backtrackable 2546 set_sos(Handle, SOSs), 2547 cplex_flush_sos(Handle) 2548 ), 2549 ( IDCs == [] -> true ; 2550 cplex_change_lp_to_mip(Handle), % backtrackable 2551 setup_new_idcs(Handle, IDCs), 2552 cplex_flush_idcs(Handle) 2553 ), 2554 load_varnames(VNames, AddedCols, CPH, SId, VarList), 2555 lp_add_var_triggers(Handle, VarList, AddedCols). 2556 2557 2558 % Split var list into new and old (known by solver SId) variables 2559 :- mode filter_new_vars(+,+,-,-). 2560 filter_new_vars(_, [], [], []). 2561 filter_new_vars(SId, [X|Xs], NewXs, OldXs) :- 2562 ( get_var_index(X, SId, _) -> 2563 OldXs = [X|OldXs0], 2564 filter_new_vars(SId, Xs, NewXs, OldXs0) 2565 ; 2566 NewXs = [X|NewXs0], 2567 filter_new_vars(SId, Xs, NewXs0, OldXs) 2568 ). 2569 2570 % Split bound-constraint list into new and old (known by solver SId) 2571 :- mode filter_new_vars_bc(+,+,-,-). 2572 filter_new_vars_bc(_, [], [], []). 2573 filter_new_vars_bc(SId, [BC|BCs], NewBCs, OldBCs) ?- 2574 BC = _Sense:[_Rhs,_C*X], 2575 ( get_var_index(X, SId, _) -> 2576 OldBCs = [BC|OldBCs0], 2577 filter_new_vars_bc(SId, BCs, NewBCs, OldBCs0) 2578 ; 2579 NewBCs = [BC|NewBCs0], 2580 filter_new_vars_bc(SId, BCs, NewBCs0, OldBCs) 2581 ). 2582 2583% filter_and_index_new_vars(+Handle, +Xs, -NewVarList, -OldXs, -Index, -NAdded) 2584% separate the variables in Xs into new and old variables (OldXs). Index 2585% the new variables and add them (in reverse order) to the Handle's 2586% variable list (NewVarList). NAdded is the number of added variables; 2587% Index is the start index of the added variables (original number of cols) 2588filter_and_index_new_vars(Handle, Xs, VarList, OldXs, I0, NAdded) :- 2589 Handle = prob{vars:VarList0, cplex_handle:CPH, solver_id:SId}, 2590 cplex_get_prob_param(CPH, 1, I0), 2591 ( foreach(X, Xs), fromto(I0, I1,I2, I), 2592 fromto(VarList0, NewXs0,NewXs1, VarList), 2593 fromto(OldXs, OldXs1,OldXs0, []), 2594 param(SId), param(Handle) do 2595 ( get_var_index(X, SId, _) -> 2596 % old variable 2597 NewXs0 = NewXs1, 2598 I1 = I2, 2599 OldXs1 = [X|OldXs0] 2600 ; var(X) -> 2601 % new variable 2602 set_var_index(X, Handle, I1), 2603 NewXs1 = [X|NewXs0], 2604 I2 is I1 + 1, 2605 OldXs1 = OldXs0 2606 ; number(X), 2607 % ignore 2608 NewXs0 = NewXs1, 2609 I1 = I2, 2610 OldXs1 = OldXs0 2611 ) 2612 ), 2613 NAdded is I - I0, 2614 setarg(vars of prob, Handle, VarList). 2615 2616% setup_new_rows(+CPH, +SId, +CType, +MaxIdx, +CstrNorm, -RowIdxs) 2617% setup new constraints (rows in matrix) of type CType (normal, 2618% unconditional + conditional cutpools) and return their row indices 2619% MaxIdx is used to test if the variables are `original' problem variables 2620% (for cutpools only) 2621setup_new_rows(_CPH, _SId, _CType, _MaxIdx, [], []). 2622setup_new_rows(CPH, SId, CType, MaxIdx, [Cstr|Cstrs], [Idx|Idxs]) :- 2623 Cstr = Sense:[Cst*_|Lhs], 2624 Rhs is -Cst, 2625 cplex_new_row(CPH, Sense, Rhs, CType, Idx0), 2626 rawidx_cstridx(CType, Idx0, Idx), 2627 add_row_coeffs(CPH, SId, CType, MaxIdx, Lhs), 2628 setup_new_rows(CPH, SId, CType, MaxIdx, Cstrs, Idxs). 2629 2630 add_row_coeffs(_CPH, _SId, _CType, _MaxIdx, []). 2631 add_row_coeffs(CPH, SId, CType, MaxIdx, [C*X|CXs]) :- 2632 get_valid_var_index(CType, MaxIdx, X, SId, J), 2633 cplex_add_coeff(CPH, J, C, CType), 2634 add_row_coeffs(CPH, SId, CType, MaxIdx, CXs). 2635 2636 get_valid_var_index(0, _, X, SId, J) :- !, /* normal constraints */ 2637 % if there are merged cols, the coeff C should be put on 2638 % *one* of the columns only 2639 get_first_var_index(X, SId, J). 2640 get_valid_var_index(_CType, MaxIdx, X, SId, J) :- /* global cut pool */ 2641 get_var_index(X, SId, Js), 2642 % fails if X is not an original problem variable -- need to check 2643 % all merged column indices. Return in J a valid original index 2644 check_original_index(Js, MaxIdx, J). 2645 2646 check_original_index([J|Js], MaxIdx, J0) ?- 2647 /* < MaxIdx: MaxIdx is actual maximum used index + 1 */ 2648 (J < MaxIdx -> J0 = J ; check_original_index(Js, MaxIdx, J0)). 2649 2650 2651setup_new_idcs(Handle, IDCs) :- 2652 Handle = prob{cplex_handle:CPH,solver_id:SId}, 2653 % Set up indcator row data (similar to setup_new_rows) 2654 ( foreach(idc(Cpl,Bool,Cstr),IDCs), param(CPH,SId) do 2655 Cstr = Sense:[Cst*_|Lhs], 2656 Rhs is -Cst, 2657 CType = 0, 2658 get_first_var_index(Bool, SId, J), 2659 cplex_new_row_idc(CPH, Sense, Rhs, Cpl, J), 2660 add_row_coeffs(CPH, SId, CType, _MaxIdx, Lhs) 2661 ). 2662 2663 2664% added by AE 25/10/02 2665% this is for adding rows whose index in the external 2666% solver we want to know for sure - when we get duals 2667% in colgen we really have to know we are getting the right 2668% ones associated with the sp cost function vars 2669 2670lp_add_indexed(Handle, Cstr, Ints, Indices) :- 2671 (var(Handle) ; var(Cstr) ; var(Ints)), !, 2672 error(4, lp_add_indexed(Handle, Cstr, Ints, Indices)). 2673lp_add_indexed(Handle, Cstr, Ints, Indices) :- 2674 lp_add_normalised(Handle, Cstr, [], Ints, [], [], Indices, _, _). 2675 2676 2677/* Added by AE 22/10/02 2678 * VarCols should now be a list of [Var:Col]s, where Col is a list of 2679 * RowIdx:Value pairs. For the first element, RowIdx can be obj (objective) 2680 */ 2681lp_add_columns(Handle, VarCols) :- 2682 ((nonvar(Handle), nonvar(VarCols)) -> true 2683 ; error(4, lp_add_columns(Handle, VarCols))), 2684 Handle = prob{cbase:CBase, 2685 cplex_handle:CPH, solver_id:SId, 2686 vars:Vars0, objcoeffs:ObjCoeffs0, option_vnames:VNames, 2687 pool: Pool, suspension:S}, 2688 ((is_suspension(S) ; nonvar(Pool)) -> 2689 printf(error, "Eplex error: problem cannot be modified by %w " 2690 "(has trigger conditions or is an eplex instance).%n", 2691 [lp_add_columns(Handle, VarCols)]), 2692 abort 2693 ; 2694 true 2695 ), 2696 cplex_get_prob_param(CPH, 1,NCols0), 2697 ( 2698 foreach(Var:Col0, VarCols), 2699 foreach(Obj, NewObjCoeffs), 2700 foreach(Lo, NewLos), 2701 foreach(Hi, NewHis), 2702 foreach(Col, NewColCoeffs), 2703 fromto(Vars0, Vs,[Var|Vs], Vars1), 2704 fromto(ObjCoeffs0, OCs0, OCs1, ObjCoeffs), 2705 fromto(0, NZ0,NZ1, NonZeros), 2706 fromto(NCols0, I0,I1, NCols), 2707 param(SId, Handle, VarCols) 2708 do 2709 ( get_var_index(Var, SId, _) -> 2710 printf(error, "Eplex error: adding existing variable %w" 2711 " in%n", [Var]), 2712 error(5, lp_add_columns(Handle, VarCols)) 2713 ; 2714 (Col0 = [obj:Obj|Col1] -> true ; Obj = 0.0, Col0 = Col1), 2715 (Col1 = [lo:Lo, hi:Hi|Col] -> true ; Lo = -1.0Inf, Hi = 1.0Inf, Col1 = Col ), 2716 set_var_index(Var, Handle, I0), 2717 (Obj =\= 0 -> OCs1 = [I0:Obj|OCs0] ; OCs1 = OCs0), 2718 I1 is I0 + 1, 2719 NZ1 is NZ0 + length(Col) 2720 ) 2721 ), 2722 AddedCols is NCols - NCols0, 2723 setarg(vars of prob, Handle, Vars1), 2724 setarg(objcoeffs of prob, Handle, ObjCoeffs), 2725 setup_new_cols(Handle, NewObjCoeffs, NewLos, NewHis, NewColCoeffs, NCols0, AddedCols, NonZeros), 2726 cplex_flush_new_rowcols(Handle, 1), 2727 load_varnames(VNames, AddedCols, CPH, SId, Vars1), 2728 ( array(CBase) -> 2729 extend_array(CBase, AddedCols, NewLos, NewHis, NewCBase), 2730 setarg(cbase of prob, Handle, NewCBase) 2731 ; 2732 true 2733 ). 2734 2735 2736% setup_new_cols(+Handle, +NewObjCoeffs, +NewLos, +NewHis, +NewColCoeffs, 2737% +OldCols, +AddedCols, +NonZeros) 2738% setups the buffer arrays for the new columns. The new variables have 2739% already been indexed and added to the Handle. 2740% NewObjCoeffs, NewLos, NewHis, NewColCoeffs are either all nil or 2741% length AddedCols 2742% NonZeros must correspond to the number of coeffs in NewColCoeffs 2743% (i.e. length of flattened NewColCoeffs) 2744setup_new_cols(Handle, NewObjCoeffs, NewLos, NewHis, NewColCoeffs, OldCols, AddedCols, NonZeros) :- 2745 Handle = prob{cplex_handle:CPH}, 2746 2747 (AddedCols > 0 -> 2748 clear_result(Handle, cbase of prob) 2749 ; 2750 true 2751 ), 2752 % allocate the buffer arrays 2753 cplex_set_new_cols(CPH, AddedCols, NewObjCoeffs, NewLos, NewHis, NonZeros), 2754 % fill the buffer arrays 2755 (foreach(ColCs, NewColCoeffs), 2756 count(I, OldCols, _), 2757 fromto(0, K0,K3, _NonZeros), 2758 param(CPH) do 2759 (foreach(J:C, ColCs), fromto(K0, K1,K2, K3), param(CPH) do 2760 cplex_set_matval(CPH, K1, J, C), 2761 K2 is K1 + 1 2762 ), 2763 cplex_set_matbeg(CPH, I, K0, K3) 2764 ). 2765 2766 2767 extend_array(Array, Added, NewLos, NewHis, ExtendedArray) :- 2768 create_extended_iarray(Array, Added, ExtendedArray), 2769 copy_extended_column_basis(Array, NewLos, NewHis, ExtendedArray). 2770 2771 extend_primal_arrays(OldBase, OldSol, OldDjs, AddedCols, 2772 ExtendedBase, ExtendedSol, ExtendedDjs) :- 2773 create_extended_iarray(OldBase, AddedCols, ExtendedBase), 2774 create_extended_darray(OldSol, AddedCols, ExtendedSol), 2775 create_extended_darray(OldDjs, AddedCols, ExtendedDjs), 2776 copy_extended_arrays(OldBase, OldSol, OldDjs, 2777 ExtendedBase, ExtendedSol, ExtendedDjs). 2778 2779% ---------------------------------------------------------------------- 2780% Solving 2781% lp_solve - cplex optimisation is invoked. When it finds a 2782% solution, succeed, return cost and store solution in handle. 2783% ---------------------------------------------------------------------- 2784 2785eplex_solve(Result, Pool) :- 2786 get_pool_handle(Handle, Pool), 2787 !, 2788 lp_solve(Handle, Result). 2789eplex_solve(Result, Pool) :- 2790 printf(error, "Eplex instance %w has no associated solver.%n", [Pool]), 2791 error(5, eplex_solve(Result)). 2792 2793lp_solve(Handle, ObjVal) :- var(Handle), !, 2794 error(4, lp_solve(Handle, ObjVal)). 2795lp_solve(Handle, ObjVal) :- 2796 Handle = prob{vars:VList,cplex_handle:CPH, timeout:TO, 2797 option_dump:DumpOpt, sync_bounds:SyncBounds, 2798 option_mipstart:MipStartOpt, 2799 method:M, aux_method:AM, 2800 node_method:NM, node_aux_method:NAM, 2801 obj:ObjConst,cbase:CBase,rbase:RBase, 2802 iis_rows:IISRows}, 2803 cplex_get_prob_param(CPH, 10, ProbState), 2804 ( ProbState = 0 -> % DESCR_EMPTY 2805 printf(error, "Eplex error: no problem loaded in %w.%n", 2806 [lp_solve(Handle, ObjVal)]), 2807 abort 2808 ; sync_bounds_mat(SyncBounds, VList, Handle, CPH) 2809 ), 2810 ( array(CBase) -> % use basis if available 2811% writeln(log_output, 'loading basis'), 2812 cplex_loadbase(CPH, CBase, RBase) 2813 ; 2814 true 2815 ), 2816 ( nonvar(IISRows) -> 2817 /* have a previous iis result from failure, clear it */ 2818 clear_result(Handle, iis_rows of prob), 2819 clear_result(Handle, iis_cols of prob), 2820 clear_result(Handle, iis_colstats of prob) 2821 ; 2822 true 2823 ), 2824 2825 cplex_optimise(Handle, m(M,AM,NM,NAM), TO, DumpOpt, MipStartOpt, 2826 sols of prob, Result, Stat, Worst, Best), 2827 set_lp_handle_value(Handle, status of prob, Stat), 2828 BestBound is ObjConst + Best, 2829 WorstBound is ObjConst + Worst, 2830 set_lp_handle_value(Handle, worstbound of prob, WorstBound), 2831 set_lp_handle_value(Handle, bestbound of prob, BestBound), 2832 cplex_get_prob_param(CPH, 0, MRows), 2833 set_lp_handle_value(Handle, mr of prob, MRows), 2834/* cplex_get_prob_param(CPH, 16, NCP), 2835 set_lp_handle_value(Handle, ncpr of prob, NCP), 2836 2837 cplex_get_prob_param(CPH, 18, NAct), 2838 set_lp_handle_value(Handle, occpr of prob, NAct), 2839*/ 2840 consider_status(Result, Handle, ObjVal). 2841 2842 2843set_lp_handle_value(Handle, ArgPos, New) :- 2844 arg(ArgPos, Handle, Old), 2845 ( var(Old) -> Old = New 2846 ; setarg(ArgPos, Handle, New)). 2847 2848 % Note: redundant cuts here because of compiler indexing problem 2849 :- mode consider_status(++,+,?). 2850 consider_status(2, Handle, ObjVal) :- !, 2851 Handle = prob{cplex_handle:CPH,obj:ObjConst}, 2852 ObjVal is ObjConst + cplex_get_objval(CPH), % DESCR_SOLVED_SOL 2853 set_lp_handle_value(Handle, cost of prob, ObjVal), 2854 % Schedule variable suspensions 2855 schedule_suspensions(change_suspensions of prob, Handle), 2856 wake. 2857 2858 consider_status(3, Handle, _) :- !, % DESCR_SOLVED_NOSOL 2859 Handle = prob{infeash:G,caller_module:Caller}, 2860 set_lp_handle_value(Handle, cost of prob, _), % not known! 2861 (nonvar(G) -> 2862 call(G)@Caller 2863 ; 2864 error(eplex_infeasible, lp_solve(Handle, _ObjVal)) 2865 ). 2866 2867 consider_status(4, Handle, ObjVal) :- !, % DESCR_ABORTED_SOL 2868 Handle = prob{cplex_handle:CPH,obj:ObjConst, 2869 subopth:G,caller_module:Caller}, 2870 ObjVal is ObjConst + cplex_get_objval(CPH), 2871 % set the cost etc. in the handle *before* the handler G is called 2872 % so that the handler can get at the cost, best/worst bounds etc. 2873 set_lp_handle_value(Handle, cost of prob, ObjVal), 2874 schedule_suspensions(change_suspensions of prob, Handle), 2875 (nonvar(G) -> 2876 call(G)@Caller 2877 ; 2878 error(eplex_suboptimal, lp_solve(Handle, ObjVal)) 2879 ). 2880 2881 consider_status(6, Handle, ObjVal) :- !, % DESCR_UNBOUNDED_NOSOL 2882 Handle = prob{objsense:Sense,unboundh:G,caller_module:Caller}, 2883 ( cplex_objsense(min, Sense) -> ObjVal = -1.0Inf ; ObjVal = 1.0Inf ), 2884 set_lp_handle_value(Handle, cost of prob, ObjVal), 2885 (nonvar(G) -> 2886 call(G)@Caller 2887 ; 2888 error(eplex_unbounded, lp_solve(Handle, ObjVal)) 2889 ). 2890 2891 consider_status(7, Handle, ObjVal) :- !, % DESCR_UNKNOWN_NOSOL 2892 Handle = prob{unkh:G,caller_module:Caller}, 2893 set_lp_handle_value(Handle, cost of prob, _), % not known! 2894 (nonvar(G) -> 2895 call(G)@Caller 2896 ; 2897 error(eplex_unknown, lp_solve(Handle, ObjVal)) 2898 ). 2899 2900 consider_status(5, Handle, ObjVal) :- % DESCR_ABORTED_NOSOL 2901 Handle = prob{aborth:G,caller_module:Caller}, 2902 set_lp_handle_value(Handle, cost of prob, _), % not known! 2903 (nonvar(G) -> 2904 call(G)@Caller 2905 ; 2906 error(eplex_abort, lp_solve(Handle, ObjVal)) 2907 ). 2908 2909 2910% default behaviour for the unclear results 2911 2912eplex_result_handler(eplex_suboptimal, lp_solve(prob{status:Stat}, _)) :- 2913 printf(warning_output, "event(eplex_suboptimal): Suboptimal solution (optimizer status = %d)%n", [Stat]). 2914 2915eplex_result_handler(eplex_unbounded, lp_solve(prob{status:Stat}, _)) :- 2916 printf(warning_output, "event(eplex_unbounded): Problem unbounded, no solution values! (optimizer status = %d)%n", [Stat]). 2917 2918eplex_result_handler(eplex_unknown, lp_solve(prob{status:Stat}, _)) :- 2919 printf(warning_output, "event(eplex_unknown): Infeasible or unbounded - failing (optimizer status = %d)%n", [Stat]), 2920 fail. 2921 2922eplex_result_handler(eplex_abort, lp_solve(prob{status:Stat}, _)) :- 2923 printf(error, "event(eplex_abort): Optimization aborted (optimizer status = %d)%n", [Stat]), 2924 throw(abort). 2925 2926eplex_result_handler(eplex_infeasible, lp_solve(_,_)) :- 2927 fail. 2928 2929:- set_event_handler(eplex_suboptimal, eplex_result_handler/2). 2930:- set_event_handler(eplex_unbounded, eplex_result_handler/2). 2931:- set_event_handler(eplex_unknown, eplex_result_handler/2). 2932:- set_event_handler(eplex_abort, eplex_result_handler/2). 2933:- set_event_handler(eplex_infeasible, eplex_result_handler/2). 2934 2935 2936% ---------------------------------------------------------------------- 2937% Run the solver with a temporary altered problem, fail if no bound 2938% can be computed (infeasible or unbounded). 2939% 2940% The alternative solution would be to allow problem to be modified 2941% explicitly. But we couldn't allow that with a solver demon because that would 2942% make the cost non-monotonic. So it seems safer to encapsulate probing. 2943% ---------------------------------------------------------------------- 2944 2945eplex_probe(ProbeSpec, Result, Pool) :- 2946 get_pool_handle(Handle, Pool), 2947 !, 2948 lp_probe(Handle, ProbeSpec, Result). 2949eplex_probe(ProbeSpec, Result, Pool) :- 2950 printf(error, "Eplex error: instance %w has no associated" 2951 " solver:%n", [Pool]), 2952 error(5, eplex_probe(ProbeSpec, Result)). 2953 2954 2955lp_probe(Handle, ProbeSpec, Result) :- 2956 ( var(ProbeSpec) -> error(4, lp_probe(Handle, ProbeSpec, Result)) 2957 ; var(Handle) -> error(4, lp_probe(Handle, ProbeSpec, Result)) 2958 ; true 2959 ), 2960 extract_probes(ProbeSpec, Probes, Extracted), 2961 set_probes(Handle, Probes, Extracted, SetProbes), 2962 block_with_probes(lp_solve(Handle, Result), Handle, SetProbes), 2963 unset_probes(Handle, SetProbes). 2964 2965extract_probes(ProbeSpec, Probes, ExtractSorted) :- 2966 ( ProbeSpec = [_|_] -> 2967 ( foreach(Probe, ProbeSpec), param(Probes), 2968 fromto(Extracted, Extracted0,Extracted1, []) do 2969 nonvar(Probe), 2970 extract_one_probe(Probe, Probes, Extracted0, Extracted1) 2971 ) 2972 ; 2973 extract_one_probe(ProbeSpec, Probes, Extracted, []) 2974 ), !, 2975 % Extracted Probes should be done in order of their priorities 2976 sort(2, =<, Extracted, ExtractSorted). 2977extract_probes(ProbeSpec, _, _) :- 2978 printf(error, "Eplex error: incorrect probe specification(s) found" 2979 " in: %w%n", [ProbeSpec]), 2980 abort. 2981 2982 % Extracted is a list of the extracted probe types in the form 2983 % Type - Prio, where Prio is used to determine the order the 2984 % probe will be set: probes with a lower value for Prio are set 2985 % first. Currently only two priority levels are used: 1 and 3, 2986 % as the only ordering requirement is that ints probe need to 2987 % be done last, as they can change the problem to the fixed/relaxed 2988 % type that the other probes do not deal with, and also because 2989 % CPLEX does not allow a fixed problem to be changed further. 2990 extract_one_probe(ObjExpr, Probes, Extracted0, Extracted) :- 2991 cplex_objsense(ObjExpr, Sense, Expr), 2992 !, 2993 % we need to do this before the ints probe. Can change problem type 2994 Extracted0 = [obj-1,sense-1|Extracted], 2995 Probes = probes{obj:objexpr(Expr), sense:Sense}. 2996 extract_one_probe(objsense(ObjSense), Probes, Extracted0, Extracted) :- 2997 cplex_objsense(ObjSense, Sense), 2998 Extracted0 = [sense-1|Extracted], 2999 Probes = probes{sense:Sense}. 3000 extract_one_probe(objexpr(Expr), Probes, Extracted0, Extracted) :- 3001 % we need to do this before the ints probe. Can change problem type 3002 Extracted0 = [obj-1|Extracted], 3003 Probes = probes{obj:objexpr(Expr)}. 3004 extract_one_probe(perturb_obj(Deltas), Probes, Extracted0, Extracted) :- 3005 is_list_or_nil(Deltas), 3006 % linear coeffs only for now -- cannot change problem type 3007 Extracted0 = [obj-1|Extracted], 3008 Probes = probes{obj:objdeltas(Deltas)}. 3009 extract_one_probe(bounds(Bounds), Probes, Extracted0, Extracted) :- 3010 is_list_or_nil(Bounds), 3011 Extracted0 = [bounds-1|Extracted], 3012 Probes = probes{bounds:Bounds}. 3013 extract_one_probe(fixed, Probes, Extracted0, Extracted) :- 3014 Probes = probes{ints:fixed}, 3015 Extracted0 = [ints-3|Extracted]. 3016 extract_one_probe(relaxed, Probes, Extracted0, Extracted) :- 3017 Probes = probes{ints:relaxed}, 3018 Extracted0 = [ints-3|Extracted]. 3019 extract_one_probe(rhscoeffs(Rhs), Probes, Extracted0, Extracted) :- 3020 is_list_or_nil(Rhs), 3021 Probes = probes{rhs:Rhs}, 3022 Extracted0 = [rhs-1|Extracted]. 3023 3024 3025set_probes(Handle, Probes, Extracted, SetProbes) :- 3026 (foreach(ProbeType - _, Extracted), param(Probes, Handle), 3027 fromto([], Set0,Set1, SetProbes) do 3028 block_with_probes(set_one_probe(ProbeType, Handle, Probes, Set0, Set1), 3029 Handle, Set0) 3030 ). 3031 3032 3033block_with_probes(Goal, Handle, SetProbes) :- 3034 ( catch(Goal, Tag, 3035 ( unset_probes(Handle, SetProbes), 3036 throw(Tag) 3037 ) 3038 ) 3039 -> 3040 true 3041 ; 3042 unset_probes(Handle, SetProbes), 3043 fail 3044 ). 3045 3046 3047set_one_probe(obj, Handle, Probes, Set0, Set1) ?- 3048 Probes = probes{obj:Obj}, 3049 set_obj_probe(Handle, Obj, Set0, Set1). 3050set_one_probe(sense, Handle, Probes, Set0, Set1) ?- 3051 Probes = probes{sense:Sense}, 3052 set_objsense_probe(Handle, Sense, Set0, Set1). 3053set_one_probe(ints, Handle, Probes, Set0, Set1) ?- 3054 Probes = probes{ints:IntProbe}, 3055 set_ints_probe(Handle, IntProbe, Set0, Set1). 3056set_one_probe(rhs, Handle, Probes, Set0, Set1) ?- 3057 Probes = probes{rhs:Rhs}, 3058 set_rhs_probe(Handle, Rhs, Set0, Set1). 3059set_one_probe(bounds, Handle, Probes, Set0, Set1) ?- 3060 Probes = probes{bounds:Bounds}, 3061 set_bounds_probe(Handle, Bounds, Set0, Set1). 3062 3063 3064set_obj_probe(Handle, objexpr(Expr), Set0, Set1) ?- !, 3065 Handle = prob{cplex_handle:CPH, obj:OldObjConst, solver_id:SId, 3066 objcoeffs:OldLinObjCoeffs, qobjcoeffs:OldQuadObjCoeffs}, 3067 3068 quadnorm(Expr, NewObjConst, NewLinObj, NewQuadObj), 3069 3070 obj_coeffs(NewLinObj, SId, NewLinObjCoeffs), 3071 qobj_coeffs(NewQuadObj, SId, NewQuadObjCoeffs), 3072 change_objective(CPH, OldLinObjCoeffs, NewLinObjCoeffs, OldQuadObjCoeffs, NewQuadObjCoeffs), 3073 Set1 = [obj(OldObjConst, NewLinObjCoeffs, OldLinObjCoeffs, 3074 NewQuadObjCoeffs, OldQuadObjCoeffs)|Set0], 3075 setarg(obj of prob, Handle, NewObjConst). % needed by lp_solve/2 3076% lp_get(Handle, objective, TmpObj), 3077% writeln(TmpObj), 3078set_obj_probe(Handle, objdeltas(ObjDeltas), Set0, Set1) ?- !, 3079 Handle = prob{cplex_handle:CPH,solver_id:SId}, 3080 hash_create(Hash), 3081 (foreach(DSpec, ObjDeltas), param(SId,Hash) do 3082 (nonvar(DSpec), DSpec = V:Delta1, 3083 get_first_var_index(V, SId, J), number(Delta1) -> 3084 true 3085 ; 3086 printf(error, "Eplex error: incorrect probe specification(s)" 3087 " found for perturb_obj probe: %w%n", [DSpec]), 3088 abort 3089 ), 3090 (hash_get(Hash, J, Delta0) -> 3091 Delta is Delta0 + Delta1 % accumulate the deltas 3092 ; 3093 Delta = Delta1 3094 ), 3095 hash_set(Hash, J, Delta) 3096 ), 3097 hash_list(Hash, Idxs, Deltas), 3098 (foreach(J, Idxs), foreach(Delta, Deltas), param(CPH), 3099 foreach(J:NewC, NewObjs), foreach(J:OldC,OldObjs) do 3100 cplex_get_obj_coef(CPH, J, OldC), 3101 NewC is OldC + Delta 3102 ), 3103 Set1 = [objc(OldObjs)|Set0], 3104 chg_obj_coeffs(CPH, NewObjs). 3105 3106 3107set_objsense_probe(Handle, NewSense, Set0, Set1) :- 3108 Handle = prob{cplex_handle:CPH}, 3109 Set1 = [sense|Set0], 3110 cplex_change_obj_sense(CPH, NewSense). 3111 3112 3113set_bounds_probe(Handle, Bounds, Set0, [bounds(N,Js,OldLs,OldHs)|Set0]) :- 3114 Handle = prob{cplex_handle:CPH,solver_id:SId}, 3115 (foreach(BSpec, Bounds), param(SId,CPH), 3116 fromto(Js, Js0,Js1, []), fromto(0, N0,N1, N), 3117 fromto(OldLs, OldLs0,OldLs1, []), 3118 fromto(OldHs, OldHs0,OldHs1, []), 3119 fromto(NewLs, NewLs0,NewLs1, []), 3120 fromto(NewHs, NewHs0,NewHs1, []) do 3121 3122 (nonvar(BSpec), BSpec = (V $:: Range), 3123 range(Range, L, H), get_var_index(V, SId, J0) -> 3124 (foreach(J, J0), count(_, 1, NumJ0s), param(CPH,L,H), 3125 fromto(Js0, JTail0,JTail1, Js1), 3126 fromto(OldLs0, OldLTail0,OldLTail1, OldLs1), 3127 fromto(OldHs0, OldHTail0,OldHTail1, OldHs1), 3128 fromto(NewLs0, NewLTail0,NewLTail1, NewLs1), 3129 fromto(NewHs0, NewHTail0,NewHTail1, NewHs1) 3130 do 3131 JTail0 = [J|JTail1], 3132 NewLTail0 = [L|NewLTail1], 3133 NewHTail0 = [H|NewHTail1], 3134 cplex_get_col_bounds(CPH, J, OldL, OldH), 3135 OldLTail0 = [OldL|OldLTail1], 3136 OldHTail0 = [OldH|OldHTail1] 3137 ), 3138 N1 is N0 + NumJ0s 3139 ; 3140 printf(error, "Eplex error: incorrect probe specification(s)" 3141 " found for bounds probe: %w%n", [BSpec]), 3142 abort 3143 ) 3144 ), 3145 cplex_change_cols_bounds(CPH, N, Js, NewLs, NewHs). 3146 3147 3148set_rhs_probe(Handle, Rhs, Set0, [rhs(N,Is,OldRs)|Set0]) :- 3149 Handle = prob{cplex_handle: CPH}, 3150 (foreach(RSpec, Rhs), foreach(I, Is), foreach(R, Rs), 3151 foreach(OldR, OldRs), count(_, 1, N), param(CPH) do 3152 (nonvar(RSpec), RSpec = I:R, 3153 integer(I), number(R) -> 3154 true 3155 ; 3156 printf(error, "Eplex error: incorrect probe specification(s)" 3157 " found for rhscoeffs probe: %w%n", [RSpec]), 3158 abort 3159 ), 3160 cplex_get_rhs(CPH, 0, I, _, OldR) 3161 ), 3162 cplex_change_rhs(CPH, N, Is, Rs). 3163 3164 3165set_ints_probe(Handle, Probe, SetProbes0, SetProbes) :- 3166 arg(cplex_handle of prob, Handle, CPH), 3167 cplex_get_prob_param(CPH, 4, OldProbCode), 3168 SetProbes = [ints(OldProbCode)|SetProbes0], 3169 cplex_problem_code(OldProbType, OldProbCode), 3170 (ints_problem_code(OldProbType, Probe, ProbeProbCode) -> 3171 true 3172 ; 3173 printf(error, "Eplex error: cannot use %w probe with %w" 3174 " problems.%n", [Probe, OldProbType]), 3175 abort 3176 ), 3177 cplex_set_problem_type(CPH, ProbeProbCode, 0). 3178 3179 ints_problem_code(mip, ProbeType, ProbCode) ?- 3180 ( ProbeType == fixed -> 3181 cplex_problem_code(fixedlp, ProbCode) 3182 ; ProbeType == relaxed -> 3183 cplex_problem_code(relaxedlp, ProbCode) 3184 ; 3185 fail 3186 ). 3187 ints_problem_code(miqp, ProbeType, ProbCode) ?- 3188 ( ProbeType == fixed -> 3189 cplex_problem_code(fixedqp, ProbCode) 3190 ; ProbeType == relaxed -> 3191 cplex_problem_code(relaxedqp, ProbCode) 3192 ; 3193 fail 3194 ). 3195 /* for qp/lp problems, just solve as qp/lp */ 3196 ints_problem_code(lp, ProbeType, ProbCode) ?- 3197 ( ProbeType == fixed -> 3198 cplex_problem_code(lp, ProbCode) 3199 ; ProbeType == relaxed -> 3200 cplex_problem_code(lp, ProbCode) 3201 ; 3202 fail 3203 ). 3204 ints_problem_code(qp, ProbeType, ProbCode) ?- 3205 ( ProbeType == fixed -> 3206 cplex_problem_code(qp, ProbCode) 3207 ; ProbeType == relaxed -> 3208 cplex_problem_code(qp, ProbCode) 3209 ; 3210 fail 3211 ). 3212 3213unset_probes(Handle, SetProbes) :- 3214 ( foreach(Set, SetProbes), param(Handle) do 3215 unset_one_probe(Handle, Set) 3216 ). 3217 3218 3219 unset_one_probe(Handle, obj(OldObjConst, NewLinObjCoeffs, OldLinObjCoeffs, 3220 NewQuadObjCoeffs, OldQuadObjCoeffs)) :- 3221 !, 3222 arg(cplex_handle of prob, Handle, CPH), 3223 setarg(obj of prob, Handle, OldObjConst), 3224 change_objective(CPH, NewLinObjCoeffs, OldLinObjCoeffs, 3225 NewQuadObjCoeffs, OldQuadObjCoeffs). 3226 unset_one_probe(Handle, objc(OldObjsC)) :- 3227 !, 3228 arg(cplex_handle of prob, Handle, CPH), 3229 chg_obj_coeffs(CPH, OldObjsC). 3230 unset_one_probe(Handle, sense) :- 3231 !, 3232 Handle = prob{cplex_handle:CPH, objsense:OldSense}, 3233 cplex_change_obj_sense(CPH, OldSense). 3234 unset_one_probe(Handle, rhs(N,Is,OldRs)) :- 3235 !, 3236 arg(cplex_handle of prob, Handle, CPH), 3237 cplex_change_rhs(CPH, N, Is, OldRs). 3238 unset_one_probe(Handle, ints(OldType)) :- 3239 !, 3240 arg(cplex_handle of prob, Handle, CPH), 3241 cplex_set_problem_type(CPH, OldType, 1). 3242 unset_one_probe(Handle, bounds(N,Idxs,Ls,Hs)) :- 3243 arg(cplex_handle of prob, Handle, CPH), 3244 cplex_change_cols_bounds(CPH, N,Idxs, Ls, Hs). 3245 3246 change_objective(CPH, OldLinCoeffs, NewLinCoeffs, OldQuadCoeffs, NewQuadCoeffs) :- 3247 clr_obj(CPH, OldLinCoeffs), 3248 chg_obj_coeffs(CPH, NewLinCoeffs), 3249 clr_qobj(CPH, OldQuadCoeffs), 3250 % change prob. type here as CPLEX only allows changing qobj for 3251 % quadratic problems 3252 change_prob_type_if_needed(CPH, OldQuadCoeffs, NewQuadCoeffs), 3253 chg_qobj_coeffs(CPH, NewQuadCoeffs). 3254 3255change_prob_type_if_needed(CPH, [], [_|_]) ?- !, 3256 % no existing quad. coeffs -> is currently linear 3257 cplex_get_prob_param(CPH, 4, LinCode), 3258 cplex_problem_code(LinType, LinCode), 3259 linear_quadratic(LinType, QuadType), 3260 cplex_problem_code(QuadType, QuadCode), 3261 cplex_set_problem_type(CPH, QuadCode, 1). 3262change_prob_type_if_needed(CPH, [_|_], []) ?- !, 3263 cplex_get_prob_param(CPH, 4, QuadCode), 3264 cplex_problem_code(QuadType, QuadCode), 3265 linear_quadratic(LinType, QuadType), 3266 cplex_problem_code(LinType, LinCode), 3267 cplex_set_problem_type(CPH, LinCode, 1). 3268change_prob_type_if_needed(_CPH, _, _). % no change 3269 3270 3271% ---------------------------------------------------------------------- 3272% Various predicates to access the solver's state 3273% ---------------------------------------------------------------------- 3274 3275eplex_write(Format, File, Pool) :- 3276 get_pool_handle(Handle, Pool), 3277 !, 3278 lp_write(Handle, Format, File). 3279eplex_write(Format, File, Pool) :- 3280 printf(error, "Eplex error: instance %w has no associated" 3281 " solver:%n", [Pool]), 3282 error(5, eplex_write(Format, File)). 3283 3284 3285lp_write(prob{cplex_handle:CPH}, Format, File) ?- 3286 cplex_lpwrite(File, Format, CPH), 3287 !. 3288lp_write(Handle, Format, File) :- 3289 error(6, lp_write(Handle, Format, File)). 3290 3291 3292eplex_cleanup(Pool) :- 3293 get_pool_handle(Handle, Pool), 3294 !, 3295 collect_all_pool_constraints(Pool, Cstrs), % empty the pool, just in case 3296 ( Cstrs = [] -> 3297 true 3298 ; 3299 printf(warning_output, "Eplex warning: constraint pool not empty in %w%n", 3300 [eplex_cleanup(Pool)]) 3301 ), 3302 lp_cleanup(Handle). 3303eplex_cleanup(Pool) :- 3304 % pool still needs to be emptied even if there is no solver! 3305 collect_all_pool_constraints(Pool, Cstrs), % empty the pool, just in case 3306 ( Cstrs = [] -> 3307 true 3308 ; 3309 printf(warning_output, "Eplex warning: constraint pool not empty in %w%n", 3310 [eplex_cleanup(Pool)]) 3311 ). 3312 3313 3314 3315lp_cleanup(Prob) :- 3316 Prob = prob{vars:VList,suspension:Susp, 3317 solver_id:SId,aux_susps:AuxSusps,pool:Pool}, 3318 kill_suspension(Susp), % if any 3319 ( atom(Pool) -> set_pool_item(Pool, 0) ; true ), 3320 (foreach(AS, AuxSusps) do kill_suspension(AS)), 3321 cleanup_attributes(VList,SId), 3322 % delay any possible garbage of Prob until after cplex_cleanup/1 call 3323 arg(cplex_handle of prob, Prob, CPH), 3324 cplex_cleanup(CPH). 3325 3326 cleanup_attributes(Vars, SId) :- 3327 (foreach(V, Vars), param(SId) do 3328 cleanup_lp_attribute_chain(V, SId) 3329 ). 3330 3331 % Some variables may share the same attribute if they've been unified 3332 cleanup_lp_attribute_chain(V{eplex:Attr}, SId) ?- 3333 (nonvar(Attr) -> 3334 Attr = eplex{next:Next0,solver:prob{solver_id:ThisId}}, 3335 (SId == ThisId -> 3336 (compound(Next0) -> Next0 = Next ; true/*Next is var */), 3337 replace_attribute(V, Next, eplex) 3338 ; 3339 remove_lp_attribute_from_chain(Next0, Attr, SId) 3340 ) 3341 ; 3342 true % var(Attr), attr already removed 3343 ). 3344 cleanup_lp_attribute_chain(V, _) :- 3345 free(V). 3346 cleanup_lp_attribute_chain(N, _) :- 3347 number(N). 3348 3349 remove_lp_attribute_from_chain(ThisAt, PrevAt, SId) :- 3350 (compound(ThisAt) -> 3351 ThisAt = eplex{next:NextAt,solver:prob{solver_id:ThisId}}, 3352 (SId == ThisId -> 3353 setarg(next of eplex, PrevAt, NextAt) 3354 ; 3355 remove_lp_attribute_from_chain(NextAt, ThisAt, SId) 3356 ) 3357 ; 3358 true % attribute not found, already removed 3359 ). 3360 3361 3362% check that options is a proper list, remove and warn over obsolete options, 3363% and separate out options which applies to lp_demon_setup only 3364clean_options([], CO, _DOpts) ?- !, CO = []. 3365clean_options([integers(_)|Os], COs, DOpts) ?- !, 3366 writeln(warning_output, "Eplex warning: integers(...) option no longer supported (ignored)"), 3367 writeln(warning_output, " use eplex:integers(...) instead."), 3368 clean_options(Os, COs, DOpts). 3369clean_options([collect_from(none)|Os], COs, DOpts) ?- !, 3370 setarg(collect_from of demon_opts, DOpts, none), 3371 clean_options(Os, COs, DOpts). 3372clean_options([collect_from(pool(Pool))|Os], COs, DOpts) ?- !, 3373 setarg(collect_from of demon_opts, DOpts, pool(Pool)), 3374 clean_options(Os, COs, DOpts). 3375clean_options([initial_solve(YesNo)|Os], COs, DOpts) ?- 3376 (YesNo == yes ; YesNo == no), !, 3377 setarg(initial_solve of demon_opts, DOpts, YesNo), 3378 clean_options(Os, COs, DOpts). 3379clean_options([priority(N)|Os], COs, DOpts) ?- 3380 integer(N), N>=0, N =< 12, !, 3381 setarg(priority of demon_opts, DOpts, N), 3382 clean_options(Os, COs, DOpts). 3383clean_options([O|Os], Options, DOpts) ?- !, 3384 Options = [O|COs], 3385 clean_options(Os, COs, DOpts). 3386clean_options(_Options0, Options, _DOpts) :- 3387 writeln(warning_output, "Eplex warning: demon solver setup options not proper list. Ignored."), 3388 Options = []. 3389 3390 3391process_options([], _, _) ?- !, true. 3392process_options([O|Os], Handle, Temp) ?- !, 3393 process_option(O, Handle, Temp), 3394 process_options(Os, Handle, Temp). 3395process_options(_NonList, _, _) :- 3396 writeln(warning_output, "Eplex warning: solver setup options not proper list. Ignored."). 3397 3398process_option(solution(YesNo), Handle, _) ?- !, 3399 lp_set(Handle, solution, YesNo). 3400process_option(dual_solution(YesNo), Handle, _) ?- !, 3401 lp_set(Handle, dual_solution, YesNo). 3402process_option(slack(YesNo), Handle, _) ?- !, 3403 lp_set(Handle, slack, YesNo). 3404process_option(reduced_cost(YesNo), Handle, _) ?- !, 3405 lp_set(Handle, reduced_cost, YesNo). 3406process_option(keep_basis(YesNo), Handle, _) ?- !, 3407 lp_set(Handle, keep_basis, YesNo). 3408process_option(cache_iis(YesNo), Handle, _) ?- !, 3409 lp_set(Handle, cache_iis, YesNo). 3410process_option(timeout(Lim0), Handle, _) ?- !, 3411 lp_set(Handle, timeout, Lim0). 3412process_option(sync_bounds(YesNo), Handle, _) ?- !, 3413 lp_set(Handle, sync_bounds, YesNo). 3414process_option(presolve(yes), Handle, _) ?- !, 3415 arg(presolve of prob, Handle, 1). 3416process_option(presolve(no), Handle, _) ?- !, 3417 arg(presolve of prob, Handle, 0). 3418process_option(mip_use_copy(yes), _Handle, Temp) ?- !, 3419 setarg(use_copy of temp_prob, Temp, 1). 3420process_option(mip_use_copy(no), _Handle, Temp) ?- !, 3421 setarg(use_copy of temp_prob, Temp, 0). 3422process_option(integers(Ints0), Handle, _) ?- 3423 is_list_or_nil(Ints0), !, 3424 Handle = prob{cplex_handle:CPH,ints:Ints}, 3425 (foreach(X, Ints0), param(CPH) do % loop may fail, so need to cut first 3426 ( var(X) -> true 3427 ; integer(X) -> true 3428 ; number(X) -> 3429 % number: make sure it's sufficiently integral 3430 abs(round(X) - X) =< cplex_get_param(CPH, integrality) 3431 ; 3432 printf(error, "Eplex error: integer variable unified to" 3433 " a non-number: %w%n", [X]), 3434 throw(abort) 3435 3436 ) 3437 ), 3438 term_variables(Ints0, Ints). % eliminate duplicates and numbers 3439process_option(reals(Vars), _Handle, Temp) ?- 3440 (foreach(V, Vars) do 3441 ( number(V) -> true 3442 ; var(V) -> true 3443 ; 3444 printf(error, "Eplex error: problem variable unified to" 3445 " a non-number: %w%n", [V]), 3446 throw(abort) 3447 ) 3448 ), !, 3449 setarg(extra_vars of temp_prob, Temp, Vars). 3450process_option(method(M), Handle, _) ?- !, 3451 lp_set(Handle, method, M). 3452process_option(node_method(M), Handle, _) ?- !, 3453 lp_set(Handle, node_method, M). 3454process_option(demon_tolerance(RT,IT), Handle, _) ?- !, 3455 lp_set(Handle, demon_tolerance, (RT,IT)). 3456process_option(use_var_names(YesNo), Handle, _) ?- !, 3457 lp_set(Handle, use_var_names, YesNo). 3458process_option(write_before_solve(Format,File), Handle, _) ?- !, 3459 setarg(option_dump of prob, Handle, write_before_solve(Format,File)). 3460process_option(sos1(Vars), _Handle, Temp) ?- !, 3461 arg(sos of temp_prob, Temp, SosList), 3462 setarg(sos of temp_prob, Temp, [sos1(Vars)|SosList]). 3463process_option(sos2(Vars), _Handle, Temp) ?- !, 3464 arg(sos of temp_prob, Temp, SosList), 3465 setarg(sos of temp_prob, Temp, [sos2(Vars)|SosList]). 3466process_option(post_equality_when_unified(YesNo), Handle, _) ?- !, 3467 lp_set(Handle, post_equality_when_unified, YesNo). 3468process_option(suboptimal_handler(Goal), Handle, _) ?- !, 3469 lp_set(Handle, suboptimal_handler, Goal). 3470process_option(unbounded_handler(Goal), Handle, _) ?- !, 3471 lp_set(Handle, unbounded_handler, Goal). 3472process_option(unknown_handler(Goal), Handle, _) ?- !, 3473 lp_set(Handle, unknown_handler, Goal). 3474process_option(abort_handler(Goal), Handle, _) ?- !, 3475 lp_set(Handle, abort_handler, Goal). 3476process_option(infeasible_handler(Goal), Handle, _) ?- !, 3477 lp_set(Handle, infeasible_handler, Goal). 3478process_option(mipstart(MipStart), Handle, _) ?- !, 3479 lp_set(Handle, mipstart, MipStart). 3480process_option(NoOpt, _Handle, _) :- 3481 writeln(error, "Eplex error: Invalid option for setup":NoOpt), 3482 abort. 3483 3484 3485fill_in_defaults(prob{ints:Ints, method:Method, aux_method:AuxMethod, 3486 node_method:NMethod, node_aux_method:NAuxMethod, timeout:TO, 3487 sync_bounds:SyncBds, bd_trigger:BdTrigger, triggermodes:TModes, 3488 option_vnames:VNames, presolve:PreSolve, option_dump:Dump, 3489 nc_trigger:NCTrigger, post_equality:PostEq, 3490 option_mipstart:MipStartOpt, 3491 demon_tol_real:RT, demon_tol_int:IT, cp_cond_map:CPMap}) :- 3492 ( var(RT) -> RT = 0.00001 ; true ), %%% preliminary 3493 ( var(IT) -> IT = 0.5 ; true ), 3494 ( var(Ints) -> Ints = [] ; true ), 3495 ( var(CPMap) -> CPMap = "" ; true), % no solved state yet 3496 ( var(TO) -> getval(timeout_default,TO) ; true ), 3497 ( var(PreSolve) -> getval(presolve_default,PreSolve) ; true), 3498 ( var(VNames) -> VNames = no ; true), 3499 ( var(NCTrigger) -> NCTrigger = no ; true), 3500 ( var(BdTrigger) -> BdTrigger = no ; true), 3501 ( var(TModes) -> TModes = [] ; true), 3502 ( var(Method) -> cplex_method_codes(default, Method, AuxMethod) ; true ), 3503 ( var(NMethod) -> cplex_method_codes(default, NMethod, NAuxMethod) ; true ), 3504 ( var(PostEq) -> PostEq = yes ; true), 3505 ( var(Dump) -> Dump = no ; true), 3506 ( var(MipStartOpt) -> mipstart_code(none, MipStartOpt) ; true ), 3507 ( var(SyncBds) -> SyncBds = no ; true). 3508 3509 3510% Accessing external solver's parameters 3511% The external solvers organises their parameters in two ways: 3512% 1. Global to all problems (CPLEX, pre-13 XPRESS) 3513% 2. Local to each problems (XPRESS 13 onwards) 3514% In Eplex we allow the access of the parameters without specifying a 3515% problem handle (`global', lp_get/set/2) 3516% and via a problem handle (local, lp_get/set/3). 3517% 3518% A problem handle may be a C-level handle if the the problem has been 3519% setup at the external solver, or a variable if the external solver does 3520% not yet have the problem (because the problem was empty at setup time). 3521% 3522% All the accesses to the external parameters are done with a handle 3523% parameter in cplex_get/set_param/3. This handle can be in 3 states: 3524% 1. positive integer (essentially pointer to C-level representation) 3525% 2. variable (no C level problem representation) 3526% 3. 0 (`global') 3527% 3528% `global' values are handled differently by Eplex depending on if the 3529% solver's parameters are global or not: if they are, then the global 3530% values are accessed, otherwise, the `global default', the values 3531% that will be given to a new problem upon setup, will be accessed. 3532% 3533% Summary of the type of values accessed: 3534 3535% Handle Local parameters Global parameters 3536% ============================================================= 3537% positive int problem's value global 3538% 0 global default global 3539% variable global default global 3540% 3541% Note: 3542% 1. We raise an exception at the C level for *setting* local parameters 3543% if the solver has global parameters. 3544% 2. `presolve' is a special parameter that is always local to a problem, 3545% regardless of if the solver's parameters are global or local. 3546% lp_get/set/2 will set the global default value. 3547% It does not map directly onto the external solver's presolve parameter 3548% (XPRESS 13+ has more than one, and they may take multiple values; 3549% CPLEX does not have local parameters. The solver's presolve 3550% parameter(s) can be accessed directly as with other parameters. 3551 3552 3553% lp_get(+Handle, +What, -Data) ------------------------------ 3554 3555eplex_get(What, Data, Pool) :- 3556 get_pool_handle(Handle, Pool), 3557 !, 3558 lp_get(Handle, What, Data). 3559eplex_get(What, Data, Pool) :- 3560 printf(error, "Eplex error: instance %w has no associated" 3561 " solver:%n", [Pool]), 3562 error(5, eplex_get(What, Data)). 3563 3564 3565lp_get(Handle, What, Value) :- var(Handle), !, 3566 error(4, lp_get(Handle, What, Value)). 3567lp_get(Handle, What, Value) :- 3568 lp_get1(Handle, What, Value). 3569 3570lp_get1(Handle, What, Value) :- var(What), !, 3571 error(4, lp_get(Handle, What, Value)). 3572lp_get1(Handle, vars, VArr) :- !, 3573 Handle = prob{vars:Vars0}, 3574 reverse(Vars0, Vars), % Vars0 are stored in reverse order from arrays 3575 VArr =.. [''|Vars]. 3576lp_get1(Handle, ints, Ints) :- !, 3577 Handle = prob{ints:Ints}. 3578lp_get1(Handle, solution, RawArr) :- !, % undocumented 3579 Handle = prob{sols:RawArr}, 3580 array(RawArr). 3581lp_get1(Handle, cbasisarr, Arr) :- !, % undocumented 3582 Handle = prob{cbase:RawArr}, 3583 array(RawArr), 3584 decode_basis(RawArr, Arr). 3585lp_get1(Handle, cbasis, RawArr) :- !, % undocumented 3586 Handle = prob{cbase:RawArr}, 3587 array(RawArr). 3588lp_get1(Handle, rbasis, RawArr) :- !, % undocumented 3589 Handle = prob{rbase:RawArr}, 3590 array(RawArr). 3591lp_get1(Handle, typed_solution, SolArr) :- !, 3592 Handle = prob{cplex_handle:CPH, sols:RawArr}, 3593 array(RawArr), 3594 darray_size(RawArr, N), 3595 functor(SolArr, '', N), 3596 raw_to_typed_solution(CPH, N, RawArr, SolArr). 3597lp_get1(Handle, reduced_cost, Array) :- !, % undocumented 3598 Handle = prob{djs:Array}, 3599 nonvar(Array). 3600lp_get1(Handle, constraints, Constraints) :- !, 3601 lp_get1(Handle, constraints_norm, NC), 3602 denormalise_cstr(NC, Constraints). 3603lp_get1(Handle, constraints_norm, Constraints) :- !, 3604 Handle = prob{cplex_handle:CPH}, 3605 cplex_get_prob_param(CPH, 0, Rows), 3606 retrieve_constraints(Handle, Rows, Constraints). 3607lp_get1(Handle, constraints_norm(Is), Constraints) :- !, 3608 Handle = prob{cplex_handle:CPH,vars:VList}, 3609 VArr =.. [''|VList], 3610 (foreach(I,Is), param(CPH,VArr), foreach(NC,Constraints) do 3611 rawidx_cstridx(CType, RawI, I), 3612 construct_one_constraint(CPH, CType, RawI, VArr, NC) 3613 ). 3614lp_get1(Handle, constraints(Is), Constraints) :- !, 3615 lp_get1(Handle, constraints_norm(Is), NCs), 3616 denormalise_cstr(NCs, Constraints). 3617lp_get1(Handle, cutpool_info(Select,IType), Info) :- 3618 cutpool_selection_to_rawidxs(Select, Handle, RawIdxs), 3619 constraint_type_code(condcp, CType), 3620 lp_get_cutpool_info(IType, CType, RawIdxs, Handle, Info), !. 3621lp_get1(Handle, slack, List) :- !, 3622 Handle = prob{slacks:Array,mr:MRows}, 3623 (array(Array) -> 3624 darray_list(Array, MRows, List) 3625 ; 3626 var(Array), 3627 write(error, "Eplex error: information not requested at solver setup: "), 3628 error(6, lp_get(Handle, slack, List)) 3629 ). 3630lp_get1(Handle, slack(Indices), List) :- 3631 is_list_or_nil(Indices), 3632 !, 3633 Handle = prob{slacks:Array}, 3634 (array(Array) -> 3635 darray_size(Array, Size), 3636 ( 3637 foreach(Idx, Indices), 3638 foreach(Pi, List), 3639 param(Array, Handle, Size) 3640 do 3641 convert_to_row_index(Idx, Handle, RIdx), 3642 RIdx < Size, 3643 get_darray_element(Array, RIdx, Pi) 3644 ) 3645 ; 3646 var(Array), 3647 write(error, "Eplex error: information not requested at solver setup: "), 3648 error(6, lp_get(Handle, slack(Indices), List)) 3649 ). 3650lp_get1(Handle, dual_solution, List) :- !, 3651 Handle = prob{pis:Array,mr:MRows}, 3652 (array(Array) -> 3653 darray_list(Array, MRows, List) 3654 ; 3655 var(Array), 3656 write(error, "Eplex error: information not requested at solver setup: "), 3657 error(6, lp_get(Handle, dual_solution, List)) 3658 ). 3659lp_get1(Handle, dual_solution(Indices), List) :- 3660 is_list_or_nil(Indices), 3661 !, 3662 Handle = prob{pis:Array}, 3663 (array(Array) -> 3664 darray_size(Array, Size), 3665 ( 3666 foreach(Idx, Indices), 3667 foreach(Pi, List), 3668 param(Array, Handle, Size) 3669 do 3670 convert_to_row_index(Idx, Handle, RIdx), 3671 RIdx < Size, 3672 get_darray_element(Array, RIdx, Pi) 3673 ) 3674 ; 3675 var(Array), 3676 write(error, "Eplex error: information not requested at solver setup: "), 3677 error(6, lp_get(Handle, dual_solution(Indices), List)) 3678 ). 3679lp_get1(Handle, objective, Obj) :- !, 3680 Handle = prob{obj:ObjConst, objsense:Sense}, 3681 retrieve_objective(Handle, NExpr), 3682 linrenorm([ObjConst*1|NExpr], NExpr1), 3683 delinearize(NExpr1, Expr), 3684 cplex_objsense(Obj, Sense, Expr). 3685lp_get1(Handle, norm_objective, Obj) :- !, 3686 Handle = prob{obj:ObjConst, objsense:Sense}, 3687 retrieve_objective(Handle, NExpr), 3688 cplex_objsense(Obj, Sense, [ObjConst*1|NExpr]). 3689lp_get1(Handle, sense, MinMax) :- !, % undocumented 3690 Handle = prob{objsense:Code}, 3691 cplex_objsense(MinMax, Code). 3692lp_get1(Handle, status, Stat) :- !, 3693 Handle = prob{status:Stat}. 3694lp_get1(Handle, method, M) :- !, 3695 Handle = prob{method:Code, aux_method:AuxCode}, 3696 cplex_method_codes(M, Code, AuxCode). 3697lp_get1(Handle, node_method, M) :- !, 3698 Handle = prob{node_method:Code, node_aux_method:AuxCode}, 3699 cplex_method_codes(M, Code, AuxCode). 3700lp_get1(Handle, demon_tolerance, (RT,IT)) :- !, 3701 Handle = prob{demon_tol_real:RT, demon_tol_int:IT}. 3702lp_get1(Handle, cost, C) :- !, 3703 % do not unify directly as C may be a number of different type from C0 3704 Handle = prob{cost:C0}, 3705 number(C0), 3706 (number(C) -> C =:= C0 ; C = C0). 3707lp_get1(Handle, best_bound, B) :- !, 3708 Handle = prob{bestbound:B0}, 3709 nonvar(B0), 3710 B = B0. 3711lp_get1(Handle, worst_bound, B) :- !, 3712 Handle = prob{worstbound:B0}, 3713 nonvar(B0), 3714 B = B0. 3715lp_get1(Handle, statistics, List) :- !, 3716 Handle = prob{cplex_handle:CPH}, 3717 List = [Successes,Failures,Aborts], 3718 cplex_get_prob_param(CPH, 5, Successes), 3719 cplex_get_prob_param(CPH, 6, Failures), 3720 cplex_get_prob_param(CPH, 7, Aborts). 3721lp_get1(Handle, simplex_iterations, N) :- !, 3722 Handle = prob{cplex_handle:CPH}, 3723 cplex_get_prob_param(CPH, 8, N). 3724lp_get1(Handle, node_count, N) :- !, 3725 Handle = prob{cplex_handle:CPH}, 3726 cplex_get_prob_param(CPH, 9, N). 3727lp_get1(Handle, problem_type, Value) :- !, 3728 Handle = prob{cplex_handle:CPH}, 3729 cplex_get_prob_param(CPH, 4, Code), 3730 cplex_problem_code(Value, Code). 3731lp_get1(prob{cplex_handle:CPH}, num_rows, N) :- !, 3732 cplex_get_prob_param(CPH, 0, N). 3733lp_get1(prob{cplex_handle:CPH}, num_cols, N) :- !, 3734 cplex_get_prob_param(CPH, 1, N). 3735lp_get1(prob{cplex_handle:CPH}, num_nonzeros, N) :- !, 3736 cplex_get_prob_param(CPH, 12, N). 3737lp_get1(prob{cplex_handle:CPH}, num_ints, N) :- !, 3738 cplex_get_prob_param(CPH, 13, N). 3739lp_get1(prob{cplex_handle:CPH}, num_quads, N) :- !, 3740 cplex_get_prob_param(CPH, 14, N). 3741lp_get1(prob{cplex_handle:CPH}, optimizer_param(Param), Value) ?- 3742 atom(Param), 3743 cplex_get_param(CPH, Param, Value), !. 3744lp_get1(prob{timeout:Value0}, timeout, Value) ?- !, 3745 Value = Value0. 3746lp_get1(Handle, post_equality_when_unified, Value) ?- !, 3747 Handle = prob{post_equality:Value}. 3748lp_get1(Handle, handle, Value) :- !, 3749 Value = Handle. 3750lp_get1(Handle, pool, Pool) :- !, 3751 Handle = prob{pool:Pool}, 3752 nonvar(Pool). 3753lp_get1(prob{option_mipstart:MipStartOpt}, mipstart, MipStart) :- !, 3754 mipstart_code(MipStart, MipStartOpt). 3755lp_get1(Handle, What, Value) :- 3756 error(6, lp_get(Handle, What, Value)). 3757 3758 3759% convert the index to an actual row index in the last solved matrix 3760convert_to_row_index(Idx0, Handle, RowIdx) :- % normal row index 3761 rawidx_cstridx(TypeCode, RawIdx, Idx0), 3762 constraint_type_code(CType, TypeCode), 3763 convert_rawidx_to_row_index(CType, Handle, RawIdx, RowIdx). 3764 3765 convert_rawidx_to_row_index(norm, Handle, RawIdx, Idx) ?- 3766 arg(mr of prob, Handle, MR), 3767 RawIdx =< MR, 3768 RawIdx = Idx. 3769/* 3770 convert_rawidx_to_row_index(permcp, Handle, RawIdx, Idx) ?- 3771 Handle = prob{mr:MR,ncpr:NCP}, 3772 RawIdx =< NCP, 3773 Idx is RawIdx + MR. 3774*/ 3775 convert_rawidx_to_row_index(condcp, Handle, RawIdx, Idx) ?- 3776 Handle = prob{mr:MR,cp_cond_map:Map}, 3777 iarray_size(Map, Size), 3778 RawIdx < Size, 3779 get_iarray_element(Map, RawIdx, Delta), 3780 Delta >= 0, % -ve if row was not added 3781 Idx is MR + Delta. 3782 3783 3784 3785% lp_get(+Handle, +What, +Index, -Data) ------------------------------ 3786% 3787%lp_get(Handle, solution, I, Value) :- !, 3788% Handle = prob{sols:Array}, array(Array), 3789% get_darray_element(Array, I, Value). 3790%lp_get(Handle, reduced_cost, I, Value) :- !, 3791% Handle = prob{djs:Array}, array(Array), 3792% get_darray_element(Array, I, Value). 3793%lp_get(Handle, slack, I, Value) :- !, 3794% Handle = prob{slacks:Array}, array(Array), 3795% get_darray_element(Array, I, Value). 3796%lp_get(Handle, dual_solution, I, Value) :- !, 3797% Handle = prob{pis:Array}, array(Array), 3798% get_darray_element(Array, I, Value). 3799%lp_get(Handle, What, I, Value) :- 3800% error(6, lp_get(Handle, What, I, Value)). 3801 3802 3803% lp_set(+Handle, +What, +Data) ------------------------------ 3804 3805eplex_set(What, Data, Pool) :- 3806 get_pool_handle(Handle, Pool), 3807 !, 3808 lp_set(Handle, What, Data). 3809eplex_set(What, Data, Pool) :- 3810 printf(error, "Eplex error: instance %w has no associated solver.%n", [Pool]), 3811 error(5, eplex_set(What, Data)). 3812 3813 3814lp_set(Handle, What, Value) :- 3815 var(What), !, 3816 error(4, lp_set(Handle, What, Value)). 3817lp_set(Handle, What, Value) :- 3818 lp_set1(Handle, What, Value). 3819 3820lp_set1(Handle, What, Value) :- 3821 var(Value), !, 3822 error(4, lp_set(Handle, What, Value)). 3823lp_set1(Handle, method, M) :- 3824 cplex_method_codes(M, Code, AuxCode), !, 3825 setarg(method of prob, Handle, Code), 3826 setarg(aux_method of prob, Handle, AuxCode). 3827lp_set1(Handle, node_method, M) :- 3828 cplex_method_codes(M, Code, AuxCode), !, 3829 setarg(node_method of prob, Handle, Code), 3830 setarg(node_aux_method of prob, Handle, AuxCode). 3831lp_set1(Handle, demon_tolerance, (RT,IT)) :- -?-> 3832 float(RT), float(IT), !, 3833 setarg(demon_tol_real of prob, Handle, RT), 3834 setarg(demon_tol_int of prob, Handle, IT). 3835lp_set1(Handle, slack, YesNo) :- 3836 select_result(Handle, slacks of prob, YesNo), !. 3837lp_set1(Handle, solution, YesNo) :- 3838 select_result(Handle, sols of prob, YesNo), !. 3839lp_set1(Handle, dual_solution, YesNo) :- 3840 select_result(Handle, pis of prob, YesNo), !. 3841lp_set1(Handle, reduced_cost, YesNo) :- 3842 select_result(Handle, djs of prob, YesNo), !. 3843lp_set1(Handle, keep_basis, YesNo) :- 3844 select_result(Handle, cbase of prob, YesNo), 3845 select_result(Handle, rbase of prob, YesNo), !. 3846lp_set1(Handle, cache_iis, YesNo) :- !, 3847 select_result(Handle, iis_rows of prob, YesNo), 3848 select_result(Handle, iis_cols of prob, YesNo), 3849 select_result(Handle, iis_colstats of prob, YesNo). 3850lp_set1(Handle, sync_bounds, yes) :- !, 3851 setarg(sync_bounds of prob, Handle, yes). 3852lp_set1(Handle, sync_bounds, no) :- !, 3853 setarg(sync_bounds of prob, Handle, no). 3854lp_set1(Handle, use_var_names, yes) :- !, 3855 setarg(option_vnames of prob, Handle, yes). 3856lp_set1(Handle, use_var_names, no) :- !, 3857 setarg(option_vnames of prob, Handle, no). 3858lp_set1(Handle, write_before_solve, no) ?- !, 3859 setarg(option_dump of prob, Handle, no). 3860lp_set1(Handle, write_before_solve, (Format,File)) ?- !, 3861 setarg(option_dump of prob, Handle, write_before_solve(Format,File)). 3862lp_set1(Handle, post_equality_when_unified, yes) :- !, 3863 setarg(post_equality of prob, Handle, yes). 3864lp_set1(Handle, post_equality_when_unified, no) :- !, 3865 setarg(post_equality of prob, Handle, no). 3866lp_set1(Handle, mipstart, MipStart) :- 3867 mipstart_code(MipStart, MipStartOpt), !, 3868 setarg(option_mipstart of prob, Handle, MipStartOpt). 3869lp_set1(Handle, order, SpecList) :- 3870 Handle = prob{cplex_handle:CPH,solver_id:SId}, 3871 make_order_list(SpecList, SId, OrderList, 0, Length), 3872 !, 3873 cplex_loadorder(CPH, Length, OrderList). 3874lp_set1(Handle, cbasis, RawArr) :- % undocumented 3875 array(RawArr), !, 3876 ( arg(cbase of prob, Handle, RawArr) -> true 3877 ; setarg(cbase of prob, Handle, RawArr) ). 3878lp_set1(Handle, rbasis, RawArr) :- % undocumented 3879 array(RawArr), !, 3880 ( arg(rbase of prob, Handle, RawArr) -> true 3881 ; setarg(rbase of prob, Handle, RawArr) ). 3882lp_set1(Handle, suboptimal_handler, Spec) :- !, 3883 lp_set_state_handler(Handle, subopth of prob, Spec). 3884lp_set1(Handle, unbounded_handler, Spec) :- !, 3885 lp_set_state_handler(Handle, unboundh of prob, Spec). 3886lp_set1(Handle, unknown_handler, Spec) :- !, 3887 lp_set_state_handler(Handle, unkh of prob, Spec). 3888lp_set1(Handle, abort_handler, Spec) :- !, 3889 lp_set_state_handler(Handle, aborth of prob, Spec). 3890lp_set1(Handle, infeasible_handler, Spec) :- !, 3891 lp_set_state_handler(Handle, infeash of prob, Spec). 3892lp_set1(Handle, timeout, Value0) :- 3893 number(Value0), 3894 Value is float(Value0), 3895 Value >= 0, 3896 !, 3897 setarg(timeout of prob, Handle, Value). 3898lp_set1(Handle, optimizer_param(Param), Value) :- 3899 Handle = prob{cplex_handle:CPH}, 3900 atom(Param), !, 3901 (cplex_set_param(CPH, Param, Value) -> 3902 true 3903 ; 3904 printf(warning_output, "Eplex warning: unknown parameter, setting ignored in %w%n", 3905 [lp_set(Handle, optimizer_param(Param), Value)]) 3906 ). 3907lp_set1(Handle, cutpool_option(Idx,Opt), Value) :- 3908 nonvar(Idx), nonvar(Value), nonvar(Opt), 3909 lp_set_cp_option(Opt, Handle, Idx, Value), !. 3910lp_set1(Handle, cutpool_name, Name) :- 3911 atom(Name), 3912 arg(cplex_handle of prob, Handle, CPH), !, 3913 % create cutpool name if new 3914 cplex_get_named_cp_index(CPH, Name, 1, _). 3915lp_set1(Handle, Param, Value) :- 3916 error(6, lp_set(Handle, Param, Value)). 3917 3918 select_result(Handle, Arg, yes) :- !, 3919 ( arg(Arg, Handle, []) -> true ; true ). 3920 select_result(Handle, Arg, clear) :- !, 3921 ( arg(Arg, Handle, []) -> true ; setarg(Arg, Handle, []) ). 3922 select_result(Handle, Arg, no) :- !, 3923 arg(Arg, Handle, Old), 3924 ( nonvar(Old) -> setarg(Arg, Handle, _) ; true ). 3925 3926 clear_result(Handle, Arg) :- 3927 arg(Arg, Handle, Arr), 3928 ( var(Arr) -> true ; Arr = [] -> true ; setarg(Arg, Handle, []) ). 3929 3930 make_order_list([], _, [], N, N). 3931 make_order_list([order(Vars,Prio,Dir)|In], SId, OutList, N0, N) :- 3932 integer(Prio), integer(Dir), 3933 vars_to_colnos(Vars, SId, Prio, Dir, OutList, OutList0, N0, N1), 3934 make_order_list(In, SId, OutList0, N1, N). 3935 3936 :- mode vars_to_colnos(+,+,+,+,+,-,+,-). 3937 vars_to_colnos([], _, _, _, L, L, N, N). 3938 vars_to_colnos([V|Vs], SId, Prio, Dir, OutList, OutList0, N0, N) :- 3939 ( var(V) -> 3940 get_first_var_index(V, SId, Index), 3941 OutList = [order(Index,Prio,Dir)|OutList1], 3942 N1 is N0+1, 3943 vars_to_colnos(Vs, SId, Prio, Dir, OutList1, OutList0, N1, N) 3944 ; 3945 vars_to_colnos(Vs, SId, Prio, Dir, OutList, OutList0, N0, N) 3946 ). 3947 3948lp_set_state_handler(Handle, Pos, Goal) :- 3949 ( Goal == default -> 3950 arg(Pos, Handle, S), 3951 ( var(S) -> true ; setarg(Pos, Handle, _)) 3952 ; 3953 setarg(Pos, Handle, Goal) 3954 ). 3955 3956 3957% lp_set(+ParameterName, +Value) ------------------------------ 3958 3959lp_set(Param, Value) :- var(Param), !, 3960 error(4, lp_set(Param, Value)). 3961lp_set(result_channel, S) :- !, lp_set_channel(0, S). 3962lp_set(error_channel, S) :- !, lp_set_channel(1, S). 3963lp_set(warning_channel, S) :- !, lp_set_channel(2, S). 3964lp_set(log_channel, S) :- !, lp_set_channel(3, S). 3965lp_set(presolve, YesNo) :- !, 3966 ((YesNo == 1 ; YesNo == 0) -> 3967 setval(presolve_default, YesNo) 3968 ; 3969 error(6, lp_set(presolve, YesNo)) 3970 ). 3971lp_set(timeout, Value0) :- 3972 number(Value0), 3973 Value is float(Value0), 3974 Value >= 0, 3975 !, 3976 setval(timeout_default, Value). 3977lp_set(optimizer_param(Param), Value) :- 3978 atom(Param), !, 3979 (cplex_set_param(0, Param, Value) -> 3980 true 3981 ; 3982 printf(warning_output, "Eplex warning: unknown parameter, setting ignored in %w%n", 3983 [lp_set(optimizer_param(Param), Value)]) 3984 ). 3985lp_set(Param, Value) :- 3986 error(5, lp_set(Param, Value)). 3987 3988 lp_set_channel(Ch, +(S)) ?- !, 3989 get_stream(S, SNr), 3990 cplex_output_stream(Ch, 1, SNr). 3991 lp_set_channel(Ch, -(S)) ?- !, 3992 get_stream(S, SNr), 3993 cplex_output_stream(Ch, 0, SNr). 3994 lp_set_channel(Ch, S) :- 3995 get_stream(S, SNr), 3996 cplex_output_stream(Ch, 1, SNr). 3997 3998 3999% lp_get(+ParameterName, -Value) ------------------------------ 4000 4001lp_get(optimizer, Value) ?- !, cplex_get_param(0, -1, Value). 4002lp_get(optimizer_version, Value) ?- !, cplex_get_param(0, -2, Value). 4003lp_get(has_qp, Value) ?- !, cplex_get_param(0, -3, Value). 4004lp_get(has_miqp, Value) ?- !, cplex_get_param(0, -4, Value). 4005lp_get(has_indicator_constraints, Value) ?- !, cplex_get_param(0, -5, Value). 4006lp_get(standalone, Value) ?- !, Value = yes. 4007lp_get(presolve, Value) ?- !, getval(presolve_default, Value). 4008lp_get(timeout, Value) ?- !, getval(timeout_default, Value). 4009lp_get(optimizer_param(Param), Value) ?- 4010 atom(Param), 4011 cplex_get_param(0, Param, Value), !. 4012lp_get(Param, Value) :- 4013 error(6, lp_get(Param, Value)). 4014 4015 4016% ---------------------------------------------------------------------- 4017% Code for reading problems from files 4018% ---------------------------------------------------------------------- 4019 4020:- tool(eplex_read/3, eplex_read_body/4). 4021 4022eplex_read_body(Format, File, Pool, Caller) :- 4023 \+ get_pool_handle(_, Pool), !, 4024 lp_read_body(File, Format, Handle, Caller), 4025 lp_pool_associate_solver(Pool, Handle). 4026eplex_read_body(Format, File, Pool, _Caller) :- 4027 printf(error, "Eplex error: instance %w already has an associated solver.%n", 4028 [Pool]), 4029 error(5, eplex_read(Format, File)). 4030 4031:- tool(lp_read/3, lp_read_body/4). 4032 4033lp_read_body(File, Format, Handle, Caller) :- 4034 var(Handle), 4035 getval(presolve_default, PreSolve), 4036 4037 % fill in fields that are different/not filled in by 4038 % fill_in_defaults/1 4039 Handle = prob{vars:VList, ints:Ints, sols:[], 4040 objsense:ObjSense, obj:0.0, objcoeffs:ObjCoeffs, 4041 solver_id:SId, 4042 presolve:PreSolve, % fill in as we have it anyway 4043 % linobj,quadobj only used during setup 4044 qobjcoeffs:[], % incorrect for quadratic problems! (b435) 4045 caller_module:Caller 4046 % pool: set by eplex_read/2 4047 % subopth:_,unboundh:_,unkh:_,aborth:_, 4048 % suspension:_,status:_,cost:_, 4049 % pis:_,slacks:_,djs:_,cbase:_,rbase:_ 4050 }, 4051 new_solver_id(SId), 4052 init_suspension_list(aux_susps of prob, Handle), 4053 init_suspension_list(change_suspensions of prob, Handle), 4054 cplex_lpread(File, Format, PreSolve, Handle), 4055 4056 arg(cplex_handle of prob, Handle, CPH), 4057 cplex_get_prob_param(CPH, 1, NCols), 4058 cplex_matrix_base(Base), 4059 set_var_indices(VList, Handle, Base, NCols, _Cols), 4060 retrieve_ints(CPH, SId, VList, Ints), 4061 4062 fill_in_defaults(Handle), % needs to be after Ints filled in 4063 cplex_get_prob_param(CPH, 3, ObjSense), 4064 retrieve_objective(Handle, ObjNorm), 4065 obj_coeffs(ObjNorm, SId, ObjCoeffs). 4066 4067 4068retrieve_constraints(_Handle, 0, []) :- !. 4069retrieve_constraints(Handle, Rows, Constraints) :- 4070 Handle = prob{cplex_handle:CPH,vars:VList}, 4071 VArr =.. [''|VList], % need random access to variables 4072 cplex_matrix_base(Base), 4073 MaxRow is Rows - cplex_matrix_offset, 4074 constraint_type_code(norm, CType), 4075 (for(I,Base,MaxRow), param(VArr,CPH,CType), 4076 foreach(C, Constraints) do 4077 construct_one_constraint(CPH, CType, I, VArr, C) 4078 ). 4079 4080 4081construct_one_constraint(CPH, CType, I, VArr, Cstr) :- 4082 cplex_get_row(CPH, CType, I, Delta), 4083 retrieve_one_constraint(CPH, CType, Delta, VArr, Lhs), 4084 cplex_get_rhs(CPH, CType, I, Sense, Rhs), 4085 Const is -Rhs, 4086 Cstr = Sense: [Const*1|Lhs]. 4087 4088 retrieve_one_constraint(CPH, CType, Base, VArr, Term) :- 4089 ( cplex_get_col_coef(CPH, CType, Base, J, C) -> 4090 arg(J, VArr, X), Term = [C*X|Term0], 4091 retrieve_one_constraint(CPH, CType, Base, VArr, Term0) 4092 ; 4093 Term = [] 4094 ). 4095 4096retrieve_objective(Handle, Term) :- 4097 Handle = prob{cplex_handle:CPH,vars:VList}, 4098 warn_if_quadratic(CPH), 4099 MaxIdx is cplex_get_prob_param(CPH, 1) - 1, 4100 (foreach(X,VList), fromto(MaxIdx, Idx0, Idx1, _), 4101 % don't get Idx directly from X as X may be instantiated 4102 fromto([], Term0,Term1, Term), param(CPH) do 4103 cplex_get_obj_coef(CPH, Idx0, C), 4104 Idx1 is Idx0 - 1, 4105 ( C = 0.0 -> Term1 = Term0 ; Term1 = [C*X|Term0] ) 4106 ). 4107 4108% retrieve integer variables from a newly read-in problem from lp_read 4109retrieve_ints(CPH, SId, VList, Ints) :- 4110 (foreach(X, VList), fromto([], Ints0,Ints1, Ints), param(CPH,SId) do 4111 get_unique_var_index(X, SId, J), % these are new vars => no merged cols 4112 cplex_get_col_type(CPH, J, Tcode), 4113 cplex_type_code(Type, Tcode), 4114 ( Type = integer -> Ints1 = [X|Ints0] ; Ints1 = Ints0 ) 4115 ). 4116 4117 warn_if_quadratic(CPH) :- 4118 cplex_get_prob_param(CPH, 4, Code), 4119 cplex_problem_code(Type, Code), 4120 (problem_is_quadratic(Type) -> 4121 writeln(warning_output, "Eplex warning: the quadratic component of the objective is not retrieved.") 4122 ; 4123 true 4124 ). 4125 4126 4127% ---------------------------------------------------------------------- 4128% Extras 4129% ---------------------------------------------------------------------- 4130 4131:- export reduced_cost_pruning/2. 4132reduced_cost_pruning(Handle, IpCost) :- 4133 call_priority(reduced_cost_pruning1(Handle, IpCost), 2). 4134 4135% called under priority to make bound updates atomic 4136reduced_cost_pruning1(Handle, IpCost) :- 4137% writeln(reduced_cost_pruning(IpCost)), 4138 Handle = prob{ 4139% cplex_handle:CPH, 4140 objsense:Sense, % min:1, max:-1 4141 djs:Djs, 4142 vars:VList}, 4143 get_var_bounds(IpCost, IpCostL, IpCostH), 4144 lp_get(Handle, cost, LpCost), 4145 % The gap size is rounded up by FeasibilityTol (a bit arbitrary). 4146 % When the reduced cost/objective function gradient is very shallow, 4147 % small rounding errors can have a large effect on the bound pruning. 4148 % By increasing the gap, we also allow the more uncertainty the 4149 % shallower the gradient is, which should be sensible. 4150 lp_get(Handle, optimizer_param(feasibility_tol), FeasibilityTol), 4151 ( Sense > 0 -> % minimizing 4152 Gap is IpCostH-LpCost+FeasibilityTol 4153 ; % maximizing 4154 Gap is LpCost-IpCostL+FeasibilityTol 4155 ), 4156 ( Gap < FeasibilityTol -> 4157 % Gap should be reasonably big to do this 4158 true 4159 ; 4160 ( nonvar(Djs) -> % we have the reduced costs anyway 4161 MFeasibilityTol is -FeasibilityTol, 4162 (% loop through the variable list 4163 foreach(Var, VList), 4164 param(FeasibilityTol,MFeasibilityTol,Gap,Handle) 4165 do 4166 lp_var_get(Handle, Var, reduced_cost, RC), 4167 ( RC > FeasibilityTol -> % at lower bound 4168 % var_range(Var, L, H), 4169 lp_var_get_bounds(Handle, Var, L, H), 4170 NewH is L + Gap/RC, 4171 ( NewH >= H -> 4172 true 4173 ; NewH >= L -> 4174 % writeln(log_output, (x(I):(L..H),sol=Sol,rc=RC,obj=ObjC)), 4175 % writeln(log_output, update_possible:(H->NewH)), 4176 lp_var_set_bounds(Handle, Var, L, NewH) 4177 ; 4178 writeln(warning_output, "Eplex warning: reduced_cost_pruning would cause failure"), 4179 writeln(warning_output, (Var:(L..H)->(L..NewH),gap=Gap,rc=RC)) 4180 ) 4181 ; RC < MFeasibilityTol -> % at upper bound 4182 % var_range(Var, L, H), 4183 lp_var_get_bounds(Handle, Var, L, H), 4184 NewL is H + Gap/RC, 4185 ( NewL =< L -> 4186 true 4187 ; NewL =< H -> 4188 % writeln(log_output, (x(I):(L..H)->(NewL..H),sol=Sol,rc=RC,obj=ObjC)), 4189 % writeln(log_output, update_possible:(L->NewL)), 4190 lp_var_set_bounds(Handle, Var, NewL, H) 4191 ; 4192 writeln(warning_output, "Eplex warning: reduced_cost_pruning would cause failure"), 4193 writeln(warning_output, (Var:(L..H)->(NewL..H),gap=Gap,rc=RC)) 4194 ) 4195 ; 4196 true 4197 ) 4198 ) 4199 ; 4200 writeln(warning_output, "Eplex warning: Reduced costs not available; cannot do reduced_cost_pruning...") 4201 ) 4202 ). 4203 4204eplex_verify_solution(VCs, VVs, Pool) :- 4205 get_pool_handle(Handle, Pool), !, 4206 lp_verify_solution(Handle, VCs, VVs). 4207eplex_verify_solution(VCs, VVs, Pool) :- 4208 printf(error, "Eplex error: instance %w has no associated" 4209 " solver:%n", [Pool]), 4210 error(5, eplex_verify(VCs, VVs, Pool)). 4211 4212 4213lp_verify_solution(Handle, VCs, VVs) :- 4214 Handle = prob{cplex_handle:CPH,vars:VList,sols:SolArr}, 4215 cplex_get_param(CPH, feasibility_tol, Tol), 4216 cplex_get_param(CPH, integrality, IntTol), 4217 cplex_get_prob_param(CPH, 0, Rows), 4218 VArr =.. [''|VList], % need random access to variables 4219 cplex_matrix_base(Base), 4220 MaxRow is Rows - cplex_matrix_offset, 4221 ( for(I,Base,MaxRow), param(VArr,CPH,Tol,Handle), 4222 fromto(VCs, VC0,VC1, VCT1) 4223 do 4224 construct_and_verify_one_constraint(I,VArr,CPH,norm,Tol,Handle,VC0,VC1) 4225 ), 4226 get_last_solved_rawidxs(Handle, CPIdxs, _, _), 4227 ( foreach(I, CPIdxs), param(VArr,CPH,Tol,Handle), 4228 fromto(VCT1, VC0,VC1, []) 4229 do 4230 construct_and_verify_one_constraint(I,VArr,CPH,condcp,Tol,Handle,VC0,VC1) 4231 ), 4232 cplex_get_prob_param(CPH, 1, Cols), 4233 ( foreacharg(V, VArr, I), param(CPH, Cols, Base, Tol, IntTol, SolArr), 4234 fromto(VVs, VV0,VV1, []) 4235 do 4236 VIdx is Cols - I + Base, %Vars are in reverse column order 4237 cplex_get_col_bounds(CPH, VIdx, Lo, Hi), 4238 get_darray_element(SolArr, VIdx, Val), 4239 (Val >= Lo - Tol, Val =< Hi + Tol -> 4240 cplex_get_col_type(CPH, VIdx, TypeCode), 4241 cplex_type_code(T, TypeCode), 4242 (T == integer -> 4243 Diff is abs(round(Val) - Val), 4244 (Diff > IntTol -> VV0 = [vio(int,Diff,VIdx,V)|VV1] ; VV1 = VV0) 4245 ; 4246 VV0 = VV1 4247 ) 4248 ; 4249 (Val < Lo - Tol -> VioBound = lower ; VioBound = upper), 4250 (Val < Lo -> Diff is Lo - Val ; Diff is Val - Hi), 4251 VV0 = [vio(VioBound,Diff,VIdx,V)|VV1] 4252 ) 4253 ). 4254 4255 construct_and_verify_one_constraint(I, VArr, CPH, Type, Tol, Handle, VC0, VC1) :- 4256 constraint_type_code(Type, TypeCode), 4257 construct_one_constraint(CPH, TypeCode, I, VArr, C), 4258 term_variables(C, CVs), 4259 copy_term((C,CVs), (CCopy,CVsCopy), _), % omit attributes! 4260 ( foreach(V, CVs), foreach(VCopy, CVsCopy), 4261 param(Handle) do 4262 lp_var_solution(Handle, V, VCopy) 4263 ), 4264 verify_one_constraint(CCopy, Tol, Diff), 4265 (Diff == satisfied -> 4266 VC0 = VC1 4267 ; 4268 convert_rawidx_to_row_index(Type, Handle, I, RowIdx), 4269 VC0 = [vio(Type,Diff,RowIdx,C)|VC1] 4270 ). 4271 4272 verify_one_constraint(Sense:[Cst*1|Lhs], Tol, Diff) :- 4273 Rhs is -Cst, 4274 LhsSum is sum(Lhs), 4275 Expr =.. [Sense,LhsSum,Rhs], 4276 (call(Expr) -> 4277 Diff = satisfied 4278 ; 4279 Diff0 is abs(LhsSum - Rhs), 4280 (Diff0 > Tol -> Diff = Diff0 ; Diff = satisfied) 4281 4282 ). 4283 4284% ---------------------------------------------------------------------- 4285% Interface to the C procedures 4286% ---------------------------------------------------------------------- 4287 4288cplex_objsense(min(Expr), 1, Expr). 4289cplex_objsense(max(Expr), -1, Expr). 4290 4291cplex_objsense(min, 1). 4292cplex_objsense(max, -1). 4293 4294% V <Op> Bound 4295cplex_bound_code((=<), 1). 4296cplex_bound_code((=:=), 0). 4297cplex_bound_code((>=), -1). 4298 4299cplex_problem_code(lp, 0). 4300cplex_problem_code(mip, 1). 4301cplex_problem_code(qp, 2). 4302cplex_problem_code(miqp, 3). 4303cplex_problem_code(fixedlp, 4). 4304cplex_problem_code(fixedqp, 5). 4305cplex_problem_code(relaxedlp, 6). 4306cplex_problem_code(relaxedqp, 7). 4307 4308cplex_mip_code(1). % mip 4309cplex_mip_code(3). % miqp 4310 4311% correspondance between linear and quad. problems 4312linear_quadratic(lp, qp). 4313linear_quadratic(mip, miqp). 4314linear_quadratic(fixedlp, fixedqp). 4315linear_quadratic(relaxedlp, relaxedqp). 4316 4317% quadratic problem types 4318problem_is_quadratic(qp). 4319problem_is_quadratic(miqp). 4320problem_is_quadratic(fixedqp). 4321problem_is_quadratic(relaxedqp). 4322 4323 4324% Superset of possible methods (i.e. supported by at least one solver) 4325% cplex_method_codes(+Name, -MethCode, -AuxMethCode) 4326% cplex_method_codes(-Name, +MethCode, +AuxMethCode) 4327% Code must correspond to METHOD_XXX definitions in C 4328cplex_method_codes(default, -1, -1) :- !. 4329cplex_method_codes(auto, 0, -1) :- !. 4330cplex_method_codes(primal, 1, -1) :- !. 4331cplex_method_codes(dual, 2, -1) :- !. 4332cplex_method_codes(net, 3, -1) :- !. 4333cplex_method_codes(net(default), 3, -1) :- !. 4334cplex_method_codes(net(auto), 3, 0) :- !. 4335cplex_method_codes(net(primal), 3, 1) :- !. 4336cplex_method_codes(net(dual), 3, 2) :- !. 4337cplex_method_codes(net_primal, 3, 1) :- !. % backward compatbility 4338cplex_method_codes(net_dual, 3, 2) :- !. % backward compatbility 4339cplex_method_codes(barrier, 4, -1) :- !. 4340cplex_method_codes(barrier(default), 4, -1) :- !. 4341cplex_method_codes(barrier(auto), 4, 0) :- !. 4342cplex_method_codes(barrier(primal), 4, 1) :- !. 4343cplex_method_codes(barrier(dual), 4, 2) :- !. 4344cplex_method_codes(barrier(none), 4, 8) :- !. 4345cplex_method_codes(barrier_primal, 4, 1) :- !. % backward compatbility 4346cplex_method_codes(barrier_dual, 4, 2) :- !. % backward compatbility 4347cplex_method_codes(sifting, 5, -1) :- !. 4348cplex_method_codes(sifting(default), 5, -1) :- !. 4349cplex_method_codes(sifting(auto), 5, 0) :- !. 4350cplex_method_codes(sifting(primal), 5, 1) :- !. 4351cplex_method_codes(sifting(dual), 5, 2) :- !. 4352cplex_method_codes(sifting(net), 5, 3) :- !. 4353cplex_method_codes(sifting(barrier), 5, 4) :- !. 4354cplex_method_codes(concurrent, 6, -1) :- !. 4355cplex_method_codes(concurrent_det, 7, -1) :- !. 4356 4357 4358:- mode cplex_type_code(-, ++). 4359cplex_type_code(integer, 0'B). 4360cplex_type_code(integer, 0'I). 4361cplex_type_code(real, 0'C). 4362 4363:- mode type_to_cplex_type(?,++,++,-). 4364type_to_cplex_type(T, _, _, 0'C) :- var(T), !. 4365type_to_cplex_type(integer, Lo, Hi, T) :- 4366 ( Lo=0.0, Hi=1.0 -> 4367 T = 0'B 4368 ; 4369 T = 0'I 4370 ). 4371type_to_cplex_type(real, _, _, 0'C). 4372 4373 4374constraint_type_code(norm, 0). % normal problem constraint 4375constraint_type_code(permcp, 1). % unconditional cutpool constraint 4376constraint_type_code(condcp, 2). % conditional cutpool constraint 4377 4378% status code for cutpool constraints -- must correspond to the CSTR_STATE_* 4379% macros in the C code. These apply to cutpool constraints that have not 4380% been added to the problem. 4381cp_cstr_state_code(violated, -1). 4382cp_cstr_state_code(satisfied, -2). 4383cp_cstr_state_code(binding, -3). 4384cp_cstr_state_code(invalid, -4). 4385cp_cstr_state_code(inactive, -5). 4386 4387% cutpool constraint conditions that can be set. Code (second arg) 4388% must correspond to C code in cplex_set_cpcstr_cond() 4389cp_cond_code(active, 1). 4390cp_cond_code(add_initially, 2). 4391 4392mipstart_code(none, 0). 4393mipstart_code(all, 1). 4394mipstart_code(integers, 2). 4395 4396 4397:- mode set_qobj_coeffs(+,++). 4398set_qobj_coeffs(CPH, QObjCoeffs0) :- 4399 (lp_get(optimizer, osi) -> 4400 % sort for OSI, as quadratic terms need to be in sparse matrix form 4401 sort(1, =<, QObjCoeffs0, QObjCoeffs) 4402 ; 4403 QObjCoeffs0 = QObjCoeffs 4404 ), 4405 set_qobj_coeffs_r(CPH, QObjCoeffs). 4406 4407 4408:- mode set_qobj_coeffs(+,++). 4409set_qobj_coeffs_r(_CPH, []). 4410set_qobj_coeffs_r(CPH, [q(I,J,C)|CXs]) :- 4411 cplex_set_qobj_coeff(CPH, I, J, C), 4412 set_qobj_coeffs_r(CPH, CXs). 4413 4414:- mode obj_coeffs(+,+,-). 4415obj_coeffs([], _,[]). 4416obj_coeffs([C*X|CXs], SId, [J:C|JCs]) :- 4417 % need to place new obj. coeffs to one column only 4418 (get_first_var_index(X, SId, J) -> 4419 true 4420 ; 4421 printf(error, "Eplex error: a non-problem variable %w occurs" 4422 " in the objective.%n", [X]), 4423 flush(error), 4424 abort 4425 ), 4426 obj_coeffs(CXs, SId, JCs). 4427 4428:- mode set_obj_coeffs(+,++). 4429set_obj_coeffs(_, []). 4430set_obj_coeffs(CPH, [J:C|JCs]) :- 4431 cplex_set_obj_coeff(CPH, J, C), 4432 set_obj_coeffs(CPH, JCs). 4433 4434:- mode chg_obj_coeffs(+,++). 4435chg_obj_coeffs(CPH, []) :- 4436 cplex_flush_obj(CPH). 4437chg_obj_coeffs(CPH, [J:C|JCs]) :- 4438 cplex_new_obj_coeff(CPH, J, C), 4439 chg_obj_coeffs(CPH, JCs). 4440 4441:- mode clr_obj(+,++). 4442clr_obj(CPH, []) :- 4443 cplex_flush_obj(CPH). 4444clr_obj(CPH, [J:_C|JCs]) :- 4445 cplex_new_obj_coeff(CPH, J, 0), 4446 clr_obj(CPH, JCs). 4447 4448:- mode qobj_coeffs(+,+,-). 4449qobj_coeffs([], _, []). 4450qobj_coeffs([[C,X,Y]|CXs], SId, [q(I,J,C)|JCs]) :- 4451 % qobj coeffs added to one pair of cols only 4452 (get_first_var_index(X, SId, I), 4453 get_first_var_index(Y, SId, J) -> 4454 qobj_coeffs(CXs, SId, JCs) 4455 ; 4456 printf(error, "Eplex error: a non-problem variable %w or %w occurs" 4457 " in the quadratic objective.%n", [X,Y]), 4458 flush(error), 4459 abort 4460 ). 4461 4462:- mode chg_qobj_coeffs(+,++). 4463chg_qobj_coeffs(_CPH, []). 4464chg_qobj_coeffs(CPH, [q(I,J,C)|JCs]) :- 4465 cplex_new_qobj_coeff(CPH, I, J, C), 4466 chg_qobj_coeffs(CPH, JCs). 4467 4468:- mode clr_qobj(+,++). 4469clr_qobj(_CPH, []). 4470clr_qobj(CPH, [q(I,J,_C)|JCs]) :- 4471 cplex_new_qobj_coeff(CPH, I, J, 0), 4472 clr_qobj(CPH, JCs). 4473 4474 4475set_rhs(_, [], _). 4476set_rhs(CPH, [Sense:Val|Cs], I) :- 4477 I1 is I+1, 4478 cplex_set_rhs_coeff(CPH, I, Sense, Val), 4479 set_rhs(CPH, Cs, I1). 4480 4481% initialise the type of a new column to an integer type 4482set_type_integer(_, _, []). 4483set_type_integer(CPH, SId, [X|Xs]) :- 4484 % new var: no merged cols 4485 ( get_unique_var_index(X, SId, J) -> 4486 cplex_get_col_bounds(CPH, J, Lo, Hi), 4487 type_to_cplex_type(integer, Lo, Hi, TypeCode), 4488 cplex_init_type(CPH, J, TypeCode) 4489 ; var(X) -> 4490 printf(warning_output, "Eplex warning: integer variable not a problem variable (ignored): %mVw%n", [X]) 4491 ; integer(X) -> 4492 true 4493 ; number(X) -> 4494 % nonvar: make sure it's sufficiently integral 4495 abs(round(X) - X) =< cplex_get_param(CPH, integrality) 4496 ; 4497 printf(error, "Eplex error: integer variable unified to" 4498 " a non-number:.%w%n", [X]), 4499 throw(abort) 4500 ), 4501 set_type_integer(CPH, SId, Xs). 4502 4503% Set initial bounds for new variables from one-variable constraints 4504set_initial_bounds(_, _, []). 4505set_initial_bounds(CPH, SId, [Sense:[Cst*_,C*X]|BdCstrs]) ?- 4506 Bound is float(-Cst/C), 4507 swap_sense(C, Sense, Sense1), 4508 get_unique_var_index(X, SId, J), 4509 cplex_init_bound(CPH, J, Sense1, Bound), 4510 set_initial_bounds(CPH, SId, BdCstrs). 4511 4512% Update bounds for old variables from one-variable constraints. 4513% Return list of changed columns. 4514update_bounds(_, [], []). 4515update_bounds(Handle, [Sense:[Cst*_,C*X]|BdCstrs], CCs) ?- 4516 Bound is float(-Cst/C), 4517 swap_sense(C, Sense, Sense1), 4518 get_lp_attr(X, Handle, Attr), 4519 Attr = eplex{idx: [I|_]}, %%% enough? 4520 impose_col_bounds(Handle, Attr, I, Bound, Changed, Sense1), 4521 ( Changed==1 -> CCs = [I|CCs1] ; CCs=CCs1 ), 4522 update_bounds(Handle, BdCstrs, CCs1). 4523 4524% synchronise bounds if requested 4525sync_bounds_mat(yes, Vars, Handle, CPH) :- 4526 cplex_get_prob_param(CPH, 1, Max), 4527 (foreach(V,Vars), fromto(Max, I0,I, _), param(Handle) do 4528 I is I0 - 1, 4529 (number(V) -> 4530 % if V is a number, no need to do anything here 4531 % (bounds for column imposed by eplex unify handler) 4532 true 4533 ; 4534 get_var_bounds(V, Lo, Hi), 4535 % no need to check if bounds changed or not; as we are 4536 % are in the process of invoking the solver here. 4537 get_lp_attr(V, Handle, Attr), 4538 cplex_impose_col_bounds(Handle, Attr, I, 1, Lo, Hi, _) 4539 ) 4540 ). 4541sync_bounds_mat(no, _, _, _). 4542 4543 4544set_mat(CPH, Cols, K, J, Jmax) :- 4545 ( J >= Jmax -> 4546 true 4547 ; 4548 J1 is J+1, 4549 arg(J1, Cols, Col), 4550 set_mat_col(CPH, Col, K, K1), % move to set_bounds_mat 4551 cplex_set_matbeg(CPH, J, K, K1), % 4552 set_mat(CPH, Cols, K1, J1, Jmax) 4553 ). 4554 4555set_mat_col(_, T, K, K) :- var(T), !. 4556set_mat_col(_, [], K, K). 4557set_mat_col(CPH, [I:CIJ|More], K0, K) :- 4558 cplex_set_matval(CPH, K0, I, CIJ), 4559 K1 is K0+1, 4560 set_mat_col(CPH, More, K1, K). 4561 4562 4563set_sos(prob{cplex_handle:CPH,solver_id:SId}, SosList) :- 4564 set_sos_list(CPH, SId, SosList). 4565 4566 set_sos_list(_CPH, _, []). 4567 set_sos_list(CPH, SId, [Sos|SosList]) :- 4568 ( Sos = sos1(Vars), clean_sos1(Vars, PureVars) -> 4569 vars_to_cols(PureVars, SId, Cols, 0, N), 4570 cplex_add_new_sos(CPH, 1, N, Cols) 4571 ; Sos = sos2(Vars), clean_sos2(Vars, PureVars) -> 4572 vars_to_cols(PureVars, SId, Cols, 0, N), 4573 cplex_add_new_sos(CPH, 2, N, Cols) 4574 ; 4575 printf(error, "Eplex error: error in SOS setup: %w%n", [Sos]), 4576 abort 4577 ), 4578 set_sos_list(CPH, SId, SosList). 4579 4580 vars_to_cols([], _, [], N, N). 4581 vars_to_cols([X|Xs], SId, [J|Js], N0, N) :- 4582 ( get_first_var_index(X, SId, J) -> 4583 N1 is N0+1, 4584 vars_to_cols(Xs, SId, Js, N1, N) 4585 ; var(X) -> 4586 writeln(error, "Eplex error: SOS contains non-problem variable during setup"), 4587 abort 4588 ; 4589 writeln(error, "Eplex error: SOS contains non-variable during setup"), 4590 abort 4591 ). 4592 4593 % Preprocess an SOS1: 4594 % - drop zeros, keep only variables 4595 % - single nonzero: set all others to zero 4596 % - several nonzeros: fail 4597 % 4598 % we could do something similar for SOS2, but much more tricky: 4599 % - X=0: drop the 0, make sos2 + sos1 with left/right neighbour 4600 % - X=1: make sos1 with left/right neighbour, others 0 4601 4602 clean_sos1(ElemsColl, NewElems) :- 4603 collection_to_list(ElemsColl, Elems), 4604 ( 4605 foreach(E,Elems), 4606 fromto(Vars,Vars1,Vars0,[]), 4607 param(Nonzero) 4608 do 4609 ( var(E) -> 4610 Vars1 = [E|Vars0] 4611 ; 4612 X is E, % evaluate subscripts etc 4613 ( var(X) -> 4614 Vars1 = [X|Vars0] 4615 ; X =:= 0 -> 4616 Vars1 = Vars0 % drop zeros 4617 ; 4618 var(Nonzero), % else fail (more than one nonzero) 4619 Nonzero = X, 4620 Vars1 = Vars0 4621 ) 4622 ) 4623 ), 4624 ( var(Nonzero) -> 4625 NewElems = Vars 4626 ; 4627 NewElems = [], 4628 ( foreach(V,Vars) do V = 0 ) 4629 ). 4630 4631 % preliminary 4632 clean_sos2(ElemsColl, Vars) :- 4633 collection_to_list(ElemsColl, Elems), 4634 ( 4635 foreach(E,Elems), 4636 fromto(Vars,Vars1,Vars0,[]) 4637 do 4638 ( var(E) -> 4639 Vars1 = [E|Vars0] 4640 ; 4641 X is E, % evaluate subscripts etc 4642 Vars1 = [X|Vars0] 4643 ) 4644 ). 4645 4646 4647raw_to_typed_solution(CPH, ArrSize, RawArr, SolArr) :- 4648 % SolArr: structure in column order from 1..ArrSize 4649 cplex_matrix_offset(OffSet), 4650 (for(I, 1, ArrSize), 4651 param(CPH,RawArr,SolArr,OffSet) do 4652 ColIdx is I - OffSet, 4653 get_typed_solution_for_col(CPH, ColIdx, RawArr, TVal), 4654 arg(I, SolArr, TVal) 4655 ). 4656 4657 4658 4659% ---------------------------------------------------------------------- 4660% Variable names 4661%----------------------------------------------------------------------- 4662 4663load_varnames(yes, NAdded, CPH, SId, Vars) ?- 4664 (count(_, 1, NAdded), fromto(Vars, [Var|Vars0],Vars0, _), 4665 param(CPH, SId) do 4666 (get_unique_var_index(Var, SId, ColJ), % new var 4667 var_name:get_var_name(Var, Name) -> 4668 cplex_load_varname(CPH, ColJ, Name) 4669 ; 4670 true 4671 ) 4672 ). 4673load_varnames(no, _, _, _, _). 4674 4675 4676% ---------------------------------------------------------------------- 4677% Expression simplifier (using lib(linearize)) 4678% 4679% A linear expression is normalised into a list (sum) of the form 4680% [C0*1, C1*X1, C2*X2, ...] 4681% where Ci are numbers and Xi are distinct variables. 4682% The first (constant) term is always present, Ci (i>=1) are nonzero. 4683% The expression must be built from variables, numbers, +/2, */2, -/2, -/1. 4684% The simplifier fails if the expression is not linear. 4685% 4686% renormalise/2 renormalises a normal form expression after variable 4687% bindings, unifications. 4688% 4689% A normalised constraint has the form 4690% Sense:NormExpr 4691% where Sense is one of the atoms =:=, >= or =< and NormExpr is a 4692% normalised expression as above. E.g. (>=):[-5*1,3*X] encodes 4693% the constraint -5 + 3*X >= 0. 4694% ---------------------------------------------------------------------- 4695 4696% Fails for var, unknown, and nonlinear constraints 4697normalise_cstr(Cstr, _) :- var(Cstr), !, 4698 fail. 4699normalise_cstr(Cstr, (=:=):Norm) :- 4700 Cstr = (E1 =:= E2), 4701 linearize(E1-E2, Norm, Residue), 4702 warn_nonlinear(Residue, Cstr). 4703normalise_cstr(Cstr, (>=):Norm) :- 4704 Cstr = (E1 >= E2), 4705 linearize(E1-E2, Norm, Residue), 4706 warn_nonlinear(Residue, Cstr). 4707normalise_cstr(Cstr, (=<):Norm) :- 4708 Cstr = (E1 =< E2), 4709 linearize(E1-E2, Norm, Residue), 4710 warn_nonlinear(Residue, Cstr). 4711normalise_cstr(Cstr, (=:=):Norm) :- 4712 Cstr = (E1 $= E2), 4713 linearize(E1-E2, Norm, Residue), 4714 warn_nonlinear(Residue, Cstr). 4715normalise_cstr(Cstr, (>=):Norm) :- 4716 Cstr = (E1 $>= E2), 4717 linearize(E1-E2, Norm, Residue), 4718 warn_nonlinear(Residue, Cstr). 4719normalise_cstr(Cstr, (=<):Norm) :- 4720 Cstr = (E1 $=< E2), 4721 linearize(E1-E2, Norm, Residue), 4722 warn_nonlinear(Residue, Cstr). 4723 4724 4725normalise_cstrs(Cs, _, _) :- var(Cs), !, 4726 fail. 4727normalise_cstrs([], [], []). 4728normalise_cstrs([C|Cs], NormLins, NonLins) :- 4729 ( normalise_cstr(C, Cnorm) -> 4730 NormLins = [Cnorm|NormLins1], 4731 normalise_cstrs(Cs, NormLins1, NonLins) 4732 ; 4733 NonLins = [C|NonLins1], 4734 normalise_cstrs(Cs, NormLins, NonLins1) 4735 ). 4736 4737renormalise_cstr(Sense:Denorm, Sense:Norm) :- 4738 linrenorm(Denorm, Norm). 4739 4740renormalise_cstrs([], []). 4741renormalise_cstrs([C|Cs], [N|Ns]) :- 4742 renormalise_cstr(C, N), 4743 renormalise_cstrs(Cs, Ns). 4744 4745 4746 warn_nonlinear(Residue, Cstr) :- 4747 (Residue = [] -> 4748 true 4749 ; 4750 printf(warning_output, "Eplex warning: Unable to linearise %w%n", [Cstr]), 4751 writeln(warning_output, "Constraint is either non-linear, or has incorrect syntax (missing brackets?)"), 4752 fail 4753 ). 4754 4755 4756% Normalise indicator constraint, fail if invalid 4757% idc(Complemented:0..1, Bool:UncheckedExpression, LinNorm:NormConstraint), 4758normalise_idc(Indicator=>Lin, Norm) ?- 4759 Norm = idc(Complemented, Bool, LinNorm), 4760 ( nonvar(Indicator), Indicator=neg(Bool) -> Complemented=1 4761 ; Bool=Indicator, Complemented=0 4762 ), 4763 normalise_cstr(Lin, LinNorm). 4764 4765 4766% ---------------------------------------------------------------------- 4767% Normal form -> standard expressions 4768% ---------------------------------------------------------------------- 4769 4770denormalise_cstr([], []). 4771denormalise_cstr([Norm|Norms], [Cstr|Cstrs]) :- 4772 denormalise_cstr(Norm, Cstr), 4773 denormalise_cstr(Norms, Cstrs). 4774denormalise_cstr(Sense:SimpEx0, Cstr) :- 4775 linrenorm(SimpEx0, SimpEx1), 4776 SimpEx1 = [Cst*_|Lhs], 4777 delinearize(Lhs, LhsExpr), 4778 Rhs is -Cst, 4779 Cstr =.. [Sense, LhsExpr, Rhs]. 4780 4781 4782% ---------------------------------------------------------------------- 4783% Interface to the polynomial simplifier 4784% ---------------------------------------------------------------------- 4785 4786 % Call polynomial simplifier and return separately: 4787 % - constant 4788 % - linear part in [C1*X1|...] format as defined above 4789 % - quadratic part 4790 % fails if not quadratic 4791quadnorm(Expr, Const, Lin, Quad) :- 4792 quadnorm(Expr, Const, LinNew, Quad, [], []), 4793 ( foreach([C,X], LinNew), foreach(C*X, Lin) do true ). 4794 4795 4796%----------------------------------------------------------------------- 4797% Change variable support 4798%----------------------------------------------------------------------- 4799lp_suspend_on_change(Handle, _Var, Susp):- 4800 nonvar(Handle), Handle = prob{}, 4801 suspend_on_change_handle(Handle, Susp). 4802suspend_on_change(_Var, Susp, Pool):- 4803 get_pool_handle(Handle, Pool), 4804 suspend_on_change_handle(Handle, Susp). 4805 4806 suspend_on_change_handle(Handle, Susp):- 4807 enter_suspension_list(change_suspensions of prob, Handle, Susp). 4808 4809lp_get_changeable_value(Handle, Var, Val):- 4810 nonvar(Handle), Handle = prob{}, 4811 get_changeable_value_handle(Handle, Var, Val). 4812get_changeable_value(Var, Val, Pool):- 4813 get_pool_handle(Handle, Pool),!, 4814 get_changeable_value_handle(Handle, Var, Val). 4815get_changeable_value_handle(Handle, Var, Val):- 4816 (catch(lp_var_get(Handle, Var, typed_solution, Val),abort,true)-> 4817 true 4818 ; 4819 true 4820 ). 4821 4822%----------------------------------------------------------------------- 4823% Infeasible analysis 4824%----------------------------------------------------------------------- 4825 4826eplex_get_iis(NCRows, NCCols, CIdxs, CVs, Pool) :- 4827 get_pool_handle(Handle, Pool), 4828 !, 4829 lp_get_iis(Handle, NCRows, NCCols, CIdxs, CVs). 4830eplex_get_iis(NCRows, NCCols, CIdxs, CVs, Pool) :- 4831 printf(error, "Eplex error: instance %w has no associated" 4832 " solver:%n", [Pool]), 4833 error(5, eplex_get_iis(NCRows, NCCols, CIdxs, CVs, Pool)). 4834 4835lp_get_iis(Handle, NCRows, NCCols, CstrIdxs, CVs) :- 4836 Handle = prob{mr:MR,cp_cond_map:Map,iis_rows:CRowIdxs,iis_cols:CColIdxs,iis_colstats:CColStatus}, 4837 ( array(CRowIdxs) -> 4838 % IIS computed eagerly on failure and associated with the IIS arrays 4839 iarray_size(CRowIdxs, NCRows), 4840 iarray_size(CColIdxs, NCCols), 4841 iarray_list(CRowIdxs, CRowIdxLst), 4842 ( foreach(RIdx, CRowIdxLst), param(Map,MR), 4843 foreach(CIdx, CstrIdxs) do 4844 matidx_cstridx(RIdx, Map, MR, CIdx) 4845 ), 4846 4847 % lp_get1(Handle, constraints_norm(CRowIdxLst), Cstrs), 4848 iarray_list(CColIdxs, CColIdxLst), 4849 (CColIdxLst \== [] -> 4850 lp_get1(Handle, vars, VArr), 4851 ( foreach(ColIdx, CColIdxLst), param(VArr,CColStatus), 4852 foreach(V:StatusAtom, CVs), count(I, 1,_) do 4853 string_code(CColStatus, I, StatusCode), 4854 char_code(StatusAtom, StatusCode), 4855 Pos is ColIdx + 1, 4856 arg(Pos, VArr, V) 4857 ) 4858 ; 4859 CVs = [] 4860 ) 4861 ; CRowIdxs == [] -> 4862 NCRows = 0, 4863 NCCols = 0, 4864 CstrIdxs = [], 4865 CVs = [], 4866 writeln(warning_output, 4867 "Eplex warning: no IIS information is available." 4868 " This is either because 1) the current solve did" 4869 " not fail, or 2) the solver does not support IIS.") 4870 ; 4871 writeln(error, "Eplex error: iis must be requested via" 4872 " cache_iis option before solving."), 4873 error(6, lp_get_iis(Handle, NCRows, NCCols, CstrIdxs, CVs)) 4874 ). 4875 4876%----------------------------------------------------------------------- 4877% cutpool support 4878%----------------------------------------------------------------------- 4879 4880% rawidx_cstridx(+CType, +RawIdx, -CstrIdx) 4881% rawidx_cstridx(-CType, -RawIdx, ++CstrIdx) 4882% mapping between constraint index to the `raw' index (i.e. index into 4883% the correct constraint type as specified by CType) 4884rawidx_cstridx(0, Idx, Idx) :- integer(Idx), !. 4885rawidx_cstridx(1, Idx, g(1,Idx)) :- !, integer(Idx). 4886rawidx_cstridx(2, Idx, g(2,Idx)) :- integer(Idx). 4887 4888matidx_cstridx(MatIdx, Map, MR, CIdx) :- 4889 ( MatIdx >= MR -> 4890 Idx is MatIdx - MR, 4891 % find each pool cstr independently -- not efficient if need 4892 % to find many 4893 find_cstridx(Idx, Map, 0, CIdx) 4894 ; 4895 CIdx = MatIdx 4896 ). 4897 4898find_cstridx(Idx, Map, RIdx0, CIdx) :- 4899 get_iarray_element(Map, RIdx0, Delta), 4900 ( Idx =:= Delta -> 4901 constraint_type_code(condcp, CType), 4902 rawidx_cstridx(CType, RIdx0, CIdx) 4903 ; 4904 RIdx1 is RIdx0 + 1, 4905 find_cstridx(Idx, Map, RIdx1, CIdx) 4906 ). 4907/* 4908matidx_cstridx(Idx, CIdx, Map) :- 4909 cplex_get_prob_param(CPH, 0, NRows), 4910 NCPRows is NRows - MC, 4911 functor(MCMap, '', NCPRows), 4912 iarray_size(Map, MSize), 4913 Last is MSize - 1, 4914 (for(J,0,Last), param(Map, MCMap) do 4915 get_iarray_element(Map, J, Delta), 4916 ( Delta >= 0 -> 4917 MIdx is Delta + 1, 4918 arg(MIdx, MCMap, J) 4919 ; 4920 true 4921 ) 4922 ) 4923*/ 4924 4925get_named_cp_index(Handle, Name, Idx) :- 4926 atom(Name), 4927 arg(cplex_handle of prob, Handle, CPH), 4928 cplex_get_named_cp_index(CPH, Name, 0, Idx). 4929 4930 4931cutpool_selection_to_rawidxs(cstr(Idx0), _Handle, Idxs) ?- 4932 rawidx_cstridx(_CType, RIdx, Idx0), 4933 Idxs = [RIdx]. 4934cutpool_selection_to_rawidxs(group(Name), Handle, Idxs) ?- 4935 arg(cplex_handle of prob, Handle, CPH), 4936 cplex_get_named_cp_index(CPH, Name, 0, PIdx), 4937 cplex_get_named_cpcstr_indices(CPH, PIdx, Idxs). 4938cutpool_selection_to_rawidxs(last_added, Handle, Idxs) ?- 4939 get_last_solved_rawidxs(Handle, Idxs, _, _). 4940cutpool_selection_to_rawidxs(last_notadded, Handle, Idxs) ?- 4941 get_last_solved_rawidxs(Handle, _, Idxs, _). 4942cutpool_selection_to_rawidxs(last_inactive, Handle, Idxs) ?- 4943 get_last_solved_rawidxs(Handle, _, _, Idxs). 4944 4945 4946% Added Index, Unadded Index, Inactive Index 4947get_last_solved_rawidxs(Handle, AIdxs, UIdxs, IIdxs) ?- 4948 arg(cp_cond_map of prob, Handle, Map), 4949 iarray_size(Map, Size), 4950 Last is Size - 1, 4951 (for(J,0,Last), param(Map), 4952 fromto([], AIdxs0,AIdxs1, AIdxs), 4953 fromto([], IIdxs0,IIdxs1, IIdxs), 4954 fromto([], UIdxs0,UIdxs1, UIdxs) do 4955 get_iarray_element(Map, J, Delta), 4956 ( Delta >= 0 -> % active, added 4957 AIdxs1 = [J|AIdxs0], 4958 UIdxs0 = UIdxs1, 4959 IIdxs0 = IIdxs1 4960 ; 4961 % unadded -- can be active or inactive 4962 cp_cstr_state_code(State, Delta), 4963 (State == inactive -> 4964 IIdxs1 = [J|IIdxs0], 4965 AIdxs0 = AIdxs1, 4966 UIdxs0 = UIdxs1 4967 ; 4968 % active, unadded 4969 UIdxs1 = [J|UIdxs0], 4970 AIdxs0 = AIdxs1, 4971 IIdxs0 = IIdxs1 4972 ) 4973 ) 4974 ). 4975 4976 get_cp_cstrs_info(IType, CType, RawIdxs, Handle, Info) :- 4977 arg(cplex_handle of prob, Handle, CPH), 4978 Info = Idxs-Is, 4979 cp_cond_code(IType, ICode), 4980 (foreach(RI,RawIdxs), param(ICode,CType,CPH), 4981 foreach(Idx,Idxs), foreach(I, Is) do 4982 rawidx_cstridx(CType, RI, Idx), 4983 cplex_get_cpcstr_info(CPH, RI, ICode, I) 4984 ). 4985 4986lp_get_cutpool_info(index, CType, RawIdxs, _Handle, Idxs) ?- 4987 (foreach(RI, RawIdxs), param(CType), foreach(Idx, Idxs) do 4988 rawidx_cstridx(CType, RI, Idx) 4989 ). 4990lp_get_cutpool_info(add_initially, CType, RawIdxs, Handle, Info) ?- 4991 get_cp_cstrs_info(add_initially, CType, RawIdxs, Handle, Info). 4992lp_get_cutpool_info(active, CType, RawIdxs, Handle, Info) ?- 4993 get_cp_cstrs_info(active, CType, RawIdxs, Handle, Info). 4994lp_get_cutpool_info(binding_state, CType, RawIdxs, Handle, Info) ?- 4995 Handle = prob{cplex_handle:CPH,cp_cond_map:Map,slacks:Slacks,mr:MR}, 4996 (var(Slacks) -> 4997 writeln(error, "Eplex error: Slack values required to get" 4998 " binding state information for cutpool constraints."), 4999 abort 5000 ; 5001 true 5002 ), 5003 cplex_get_param(CPH, feasibility_tol, Tol), 5004 Info = Idxs-States, 5005 (foreach(RI,RawIdxs),param(Map,Slacks,MR,Tol,CType), 5006 foreach(Idx,Idxs), foreach(BS, States) do 5007 rawidx_cstridx(CType, RI, Idx), 5008 get_iarray_element(Map, RI, D), 5009 ( D >= 0 -> 5010 /* constraint was added - check its slack value */ 5011 RowI is MR + D, 5012 get_darray_element(Slacks, RowI, S), 5013 (abs(S) =< Tol -> BS = binding ; BS = satisfied) 5014 ; 5015 /* constraint was not added */ 5016 cp_cstr_state_code(BS, D) 5017 ) 5018 ). 5019lp_get_cutpool_info(constraints_norm, CType, RawIdxs, Handle, Info) ?- 5020 Handle = prob{cplex_handle:CPH,vars:VList}, 5021 Info = Idxs-NCs, 5022 VArr =.. [''|VList], % need random access to variables 5023 (foreach(RI, RawIdxs), param(CType,VArr,CPH), 5024 foreach(Idx, Idxs), foreach(NC, NCs) do 5025 rawidx_cstridx(CType, RI, Idx), 5026 construct_one_constraint(CPH, CType, RI, VArr, NC) 5027 ). 5028lp_get_cutpool_info(constraints, CType, RawIdxs, Handle, Info) ?- 5029 lp_get_cutpool_info(constraints_norm, CType, RawIdxs, Handle, 5030 Idxs-NCs), 5031 Info = Idxs-Cs, 5032 denormalise_cstr(NCs, Cs). 5033 5034% currently allows only setting of states, may allow more complex 5035% conditions in the future 5036lp_set_cp_option(Option, Handle, Idx, Value) ?- 5037 rawidx_cstridx(CType, RIdx, Idx), 5038 constraint_type_code(condcp, CType), 5039 valid_cp_optval(Option, Value, Handle, ActVal), 5040 cp_cond_code(Option, OType), 5041 arg(cplex_handle of prob, Handle, CPH), 5042 cplex_set_cpcstr_cond(CPH, RIdx, OType, ActVal). 5043 5044 5045%----------------------------------------------------------------------- 5046% utility predicates 5047%----------------------------------------------------------------------- 5048 5049is_list_or_nil([_|_]) ?- true. 5050is_list_or_nil([]) ?- true. 5051 5052%----------------------------------------------------------------------- 5053% Pools 5054%----------------------------------------------------------------------- 5055 5056:- local record(lp_pools). % list of lp pool names 5057 5058create_eplex_pool(Pool) :- 5059 create_constraint_pool(Pool, property(arity) of constraint_type, [ 5060 (=:=)/2 -> lp_eq/3, 5061 (>=)/2 -> lp_ge/3, 5062 (=<)/2 -> lp_le/3, 5063 ($=)/2 -> lp_eq/3, 5064 ($>=)/2 -> lp_ge/3, 5065 ($=<)/2 -> lp_le/3, 5066 ($::)/2 -> lp_interval/3, 5067 (::)/2 -> lp_interval/3, 5068 integers/1 -> integers/2, 5069 reals/1 -> reals/2, 5070 sos1/1 -> sos1/2, 5071 sos2/1 -> sos2/2, 5072 (=>)/2 -> indicator_constraint/3, 5073 piecewise_linear_hull/3 -> piecewise_linear_hull/4, 5074 suspend_on_change/2 -> suspend_on_change/3, 5075 get_changeable_value/2 -> get_changeable_value/3, 5076 eplex_solver_setup/1 -> eplex_solver_setup/2, 5077 eplex_solver_setup/4 -> eplex_solver_setup_cbody/5, 5078 eplex_solver_setup/5 -> eplex_solver_setup_cbody/6, % obsolete 5079 eplex_probe/2 -> eplex_probe/3, 5080 eplex_solve/1 -> eplex_solve/2, 5081 eplex_get/2 -> eplex_get/3, 5082 eplex_set/2 -> eplex_set/3, 5083 eplex_var_get/3 -> eplex_var_get/4, 5084 eplex_var_get_bounds/3 -> eplex_var_get_bounds/4, 5085 eplex_add_constraints/2 -> eplex_add_constraints/3, 5086 eplex_read/2 -> eplex_read/3, 5087 eplex_write/2 -> eplex_write/3, 5088 eplex_get_iis/4 -> eplex_get_iis/5, 5089 eplex_verify_solution/2 -> eplex_verify_solution/3, 5090 eplex_cleanup/0 -> eplex_cleanup/1 5091 ]). 5092 5093 5094eplex_instance(PoolName) :- 5095 ( is_constraint_pool(PoolName), 5096 recorded(lp_pools, PoolName) % is a lp pool 5097 -> 5098 % if pool exists, check if it is currently empty 5099 ( pool_is_empty(PoolName), 5100 get_pool_item(PoolName, 0) % has no associated solver 5101 -> 5102 true 5103 ; 5104 printf(error, "Eplex error: instance still in use in %w%n", [eplex_instance(PoolName)]), 5105 abort 5106 ) 5107 ; 5108 5109 (recorded(lp_pools, PoolName) -> 5110 printf(error, "Eplex error: cannot create the eplex instance in %w as it may" 5111 " have been erased earlier.%n", [eplex_instance(PoolName)]), 5112 abort 5113 ; record(lp_pools, PoolName) 5114 ), 5115 create_eplex_pool(PoolName) 5116 ). 5117 5118 5119lp_pool_associate_solver(PoolName, Handle) :- 5120 get_pool_item(PoolName, 0), % does not already have a solver 5121 set_pool_item(PoolName, Handle), 5122 Handle = prob{pool:PoolName}. 5123 5124 5125get_pool_handle(Handle, Pool) :- 5126 get_pool_item(Pool, Handle), 5127 Handle = prob{}. 5128 5129 5130pool_has_no_solver(Pool) :- 5131 ( is_constraint_pool(Pool), 5132 recorded(lp_pools, Pool) -> 5133 ( get_pool_item(Pool, 0) -> true 5134 ; 5135 printf(error, "Eplex error: Attempting to associate a" 5136 " solver with eplex instance %w, which already has" 5137 " an associated solver.%n", [Pool]), 5138 abort 5139 ) 5140 ; 5141 printf("Eplex error: Invalid eplex instance %w specified" 5142 " during set up.%n", [Pool]), 5143 abort 5144 ). 5145 5146 5147 % Dummy predicate for forwarding piecewise_linear_hull/3 to the 5148 % appropriate solver. It would be nice if create_constraint_pool/3 5149 % allowed module qualification in the spec list, so that this extra 5150 % indirection were not needed... We could just import the piecewise 5151 % module, but then it would always be loaded, rather than only when it's 5152 % actually used. 5153piecewise_linear_hull(X, Points, Y, Pool) :- 5154 eplex_relax:piecewise_linear_hull(X, Points, Y, Pool). 5155 5156 5157%----------------------------------------------------------------------- 5158% Compatibility: solver's idea of integer tolerance 5159%----------------------------------------------------------------------- 5160int_tolerance(Tol) :- 5161 cplex_get_param(0, integrality, Tol). 5162 5163 5164% ---------------------------------------------------------------------- 5165% Try to grab a licence 5166% ---------------------------------------------------------------------- 5167 5168?- ( is_predicate(lp_get_license/0), lp_get_license -> true ; true). 5169 5170 5171