Mercurial > octave-nkf

comparison libinterp/dldfcn/__glpk__.cc @ 15195:2fc554ffbc28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
split libinterp from src * libinterp: New directory. Move all files from src directory here except Makefile.am, main.cc, main-cli.cc, mkoctfile.in.cc, mkoctfilr.in.sh, octave-config.in.cc, octave-config.in.sh. * libinterp/Makefile.am: New file, extracted from src/Makefile.am. * src/Makefile.am: Delete everything except targets and definitions needed to build and link main and utility programs. * Makefile.am (SUBDIRS): Include libinterp in the list. * autogen.sh: Run config-module.sh in libinterp/dldfcn directory, not src/dldfcn directory. * configure.ac (AC_CONFIG_SRCDIR): Use libinterp/octave.cc, not src/octave.cc. (DL_LDFLAGS, LIBOCTINTERP): Use libinterp, not src. (AC_CONFIG_FILES): Include libinterp/Makefile in the list. * find-docstring-files.sh: Look in libinterp, not src. * gui/src/Makefile.am (liboctgui_la_CPPFLAGS): Find header files in libinterp, not src.
author John W. Eaton <jwe@octave.org>
date Sat, 18 Aug 2012 16:23:39 -0400
parents src/dldfcn/__glpk__.cc@000587f92082
children 336f42406671
comparison
equal deleted inserted replaced
15194:0f0b795044c3 15195:2fc554ffbc28
1 /*
2
3 Copyright (C) 2005-2012 Nicolo' Giorgetti
4
5 This file is part of Octave.
6
7 Octave is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 3 of the License, or (at your
10 option) any later version.
11
12 Octave is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with Octave; see the file COPYING. If not, see
19 <http://www.gnu.org/licenses/>.
20
21 */
22
23 #ifdef HAVE_CONFIG_H
24 #include <config.h>
25 #endif
26
27 #include <cfloat>
28 #include <csetjmp>
29 #include <ctime>
30
31 #include "lo-ieee.h"
32
33 #include "defun-dld.h"
34 #include "error.h"
35 #include "gripes.h"
36 #include "oct-map.h"
37 #include "oct-obj.h"
38 #include "pager.h"
39
40 #if defined (HAVE_GLPK)
41
42 extern "C"
43 {
44 #if defined (HAVE_GLPK_GLPK_H)
45 #include <glpk/glpk.h>
46 #else
47 #include <glpk.h>
48 #endif
49
50 #if 0
51 #ifdef GLPK_PRE_4_14
52
53 #ifndef _GLPLIB_H
54 #include <glplib.h>
55 #endif
56 #ifndef lib_set_fault_hook
57 #define lib_set_fault_hook lib_fault_hook
58 #endif
59 #ifndef lib_set_print_hook
60 #define lib_set_print_hook lib_print_hook
61 #endif
62
63 #else
64
65 void _glp_lib_print_hook (int (*func)(void *info, char *buf), void *info);
66 void _glp_lib_fault_hook (int (*func)(void *info, char *buf), void *info);
67
68 #endif
69 #endif
70 }
71
72 #define NIntP 17
73 #define NRealP 10
74
75 int lpxIntParam[NIntP] = {
76 0,
77 1,
78 0,
79 1,
80 0,
81 -1,
82 0,
83 200,
84 1,
85 2,
86 0,
87 1,
88 0,
89 0,
90 2,
91 2,
92 1
93 };
94
95 int IParam[NIntP] = {
96 LPX_K_MSGLEV,
97 LPX_K_SCALE,
98 LPX_K_DUAL,
99 LPX_K_PRICE,
100 LPX_K_ROUND,
101 LPX_K_ITLIM,
102 LPX_K_ITCNT,
103 LPX_K_OUTFRQ,
104 LPX_K_MPSINFO,
105 LPX_K_MPSOBJ,
106 LPX_K_MPSORIG,
107 LPX_K_MPSWIDE,
108 LPX_K_MPSFREE,
109 LPX_K_MPSSKIP,
110 LPX_K_BRANCH,
111 LPX_K_BTRACK,
112 LPX_K_PRESOL
113 };
114
115
116 double lpxRealParam[NRealP] = {
117 0.07,
118 1e-7,
119 1e-7,
120 1e-9,
121 -DBL_MAX,
122 DBL_MAX,
123 -1.0,
124 0.0,
125 1e-6,
126 1e-7
127 };
128
129 int RParam[NRealP] = {
130 LPX_K_RELAX,
131 LPX_K_TOLBND,
132 LPX_K_TOLDJ,
133 LPX_K_TOLPIV,
134 LPX_K_OBJLL,
135 LPX_K_OBJUL,
136 LPX_K_TMLIM,
137 LPX_K_OUTDLY,
138 LPX_K_TOLINT,
139 LPX_K_TOLOBJ
140 };
141
142 static jmp_buf mark; //-- Address for long jump to jump to
143
144 #if 0
145 int
146 glpk_fault_hook (void * /* info */, char *msg)
147 {
148 error ("CRITICAL ERROR in GLPK: %s", msg);
149 longjmp (mark, -1);
150 }
151
152 int
153 glpk_print_hook (void * /* info */, char *msg)
154 {
155 message (0, "%s", msg);
156 return 1;
157 }
158 #endif
159
160 int
161 glpk (int sense, int n, int m, double *c, int nz, int *rn, int *cn,
162 double *a, double *b, char *ctype, int *freeLB, double *lb,
163 int *freeUB, double *ub, int *vartype, int isMIP, int lpsolver,
164 int save_pb, double *xmin, double *fmin, double *status,
165 double *lambda, double *redcosts, double *time, double *mem)
166 {
167 int errnum;
168 int typx = 0;
169 int method;
170
171 clock_t t_start = clock ();
172
173 #if 0
174 #ifdef GLPK_PRE_4_14
175 lib_set_fault_hook (0, glpk_fault_hook);
176 #else
177 _glp_lib_fault_hook (glpk_fault_hook, 0);
178 #endif
179
180 if (lpxIntParam[0] > 1)
181 #ifdef GLPK_PRE_4_14
182 lib_set_print_hook (0, glpk_print_hook);
183 #else
184 _glp_lib_print_hook (glpk_print_hook, 0);
185 #endif
186 #endif
187
188 LPX *lp = lpx_create_prob ();
189
190
191 //-- Set the sense of optimization
192 if (sense == 1)
193 lpx_set_obj_dir (lp, LPX_MIN);
194 else
195 lpx_set_obj_dir (lp, LPX_MAX);
196
197 //-- If the problem has integer structural variables switch to MIP
198 if (isMIP)
199 lpx_set_class (lp, LPX_MIP);
200
201 lpx_add_cols (lp, n);
202 for (int i = 0; i < n; i++)
203 {
204 //-- Define type of the structural variables
205 if (! freeLB[i] && ! freeUB[i])
206 {
207 if (lb[i] != ub[i])
208 lpx_set_col_bnds (lp, i+1, LPX_DB, lb[i], ub[i]);
209 else
210 lpx_set_col_bnds (lp, i+1, LPX_FX, lb[i], ub[i]);
211 }
212 else
213 {
214 if (! freeLB[i] && freeUB[i])
215 lpx_set_col_bnds (lp, i+1, LPX_LO, lb[i], ub[i]);
216 else
217 {
218 if (freeLB[i] && ! freeUB[i])
219 lpx_set_col_bnds (lp, i+1, LPX_UP, lb[i], ub[i]);
220 else
221 lpx_set_col_bnds (lp, i+1, LPX_FR, lb[i], ub[i]);
222 }
223 }
224
225 // -- Set the objective coefficient of the corresponding
226 // -- structural variable. No constant term is assumed.
227 lpx_set_obj_coef(lp,i+1,c[i]);
228
229 if (isMIP)
230 lpx_set_col_kind (lp, i+1, vartype[i]);
231 }
232
233 lpx_add_rows (lp, m);
234
235 for (int i = 0; i < m; i++)
236 {
237 /* If the i-th row has no lower bound (types F,U), the
238 corrispondent parameter will be ignored.
239 If the i-th row has no upper bound (types F,L), the corrispondent
240 parameter will be ignored.
241 If the i-th row is of S type, the i-th LB is used, but
242 the i-th UB is ignored.
243 */
244
245 switch (ctype[i])
246 {
247 case 'F':
248 typx = LPX_FR;
249 break;
250
251 case 'U':
252 typx = LPX_UP;
253 break;
254
255 case 'L':
256 typx = LPX_LO;
257 break;
258
259 case 'S':
260 typx = LPX_FX;
261 break;
262
263 case 'D':
264 typx = LPX_DB;
265 break;
266 }
267
268 lpx_set_row_bnds (lp, i+1, typx, b[i], b[i]);
269
270 }
271
272 lpx_load_matrix (lp, nz, rn, cn, a);
273
274 if (save_pb)
275 {
276 static char tmp[] = "outpb.lp";
277 if (lpx_write_cpxlp (lp, tmp) != 0)
278 {
279 error ("__glpk__: unable to write problem");
280 longjmp (mark, -1);
281 }
282 }
283
284 //-- scale the problem data (if required)
285 //-- if (scale && (!presol || method == 1)) lpx_scale_prob (lp);
286 //-- LPX_K_SCALE=IParam[1] LPX_K_PRESOL=IParam[16]
287 if (lpxIntParam[1] && (! lpxIntParam[16] || lpsolver != 1))
288 lpx_scale_prob (lp);
289
290 //-- build advanced initial basis (if required)
291 if (lpsolver == 1 && ! lpxIntParam[16])
292 lpx_adv_basis (lp);
293
294 for (int i = 0; i < NIntP; i++)
295 lpx_set_int_parm (lp, IParam[i], lpxIntParam[i]);
296
297 for (int i = 0; i < NRealP; i++)
298 lpx_set_real_parm (lp, RParam[i], lpxRealParam[i]);
299
300 if (lpsolver == 1)
301 method = 'S';
302 else
303 method = 'T';
304
305 switch (method)
306 {
307 case 'S':
308 {
309 if (isMIP)
310 {
311 method = 'I';
312 errnum = lpx_simplex (lp);
313 errnum = lpx_integer (lp);
314 }
315 else
316 errnum = lpx_simplex (lp);
317 }
318 break;
319
320 case 'T':
321 errnum = lpx_interior (lp);
322 break;
323
324 default:
325 break;
326 #if 0
327 #ifdef GLPK_PRE_4_14
328 insist (method != method);
329 #else
330 static char tmp[] = "method != method";
331 glpk_fault_hook (0, tmp);
332 #endif
333 #endif
334 }
335
336 /* errnum assumes the following results:
337 errnum = 0 <=> No errors
338 errnum = 1 <=> Iteration limit exceeded.
339 errnum = 2 <=> Numerical problems with basis matrix.
340 */
341 if (errnum == LPX_E_OK)
342 {
343 if (isMIP)
344 {
345 *status = lpx_mip_status (lp);
346 *fmin = lpx_mip_obj_val (lp);
347 }
348 else
349 {
350 if (lpsolver == 1)
351 {
352 *status = lpx_get_status (lp);
353 *fmin = lpx_get_obj_val (lp);
354 }
355 else
356 {
357 *status = lpx_ipt_status (lp);
358 *fmin = lpx_ipt_obj_val (lp);
359 }
360 }
361
362 if (isMIP)
363 {
364 for (int i = 0; i < n; i++)
365 xmin[i] = lpx_mip_col_val (lp, i+1);
366 }
367 else
368 {
369 /* Primal values */
370 for (int i = 0; i < n; i++)
371 {
372 if (lpsolver == 1)
373 xmin[i] = lpx_get_col_prim (lp, i+1);
374 else
375 xmin[i] = lpx_ipt_col_prim (lp, i+1);
376 }
377
378 /* Dual values */
379 for (int i = 0; i < m; i++)
380 {
381 if (lpsolver == 1)
382 lambda[i] = lpx_get_row_dual (lp, i+1);
383 else
384 lambda[i] = lpx_ipt_row_dual (lp, i+1);
385 }
386
387 /* Reduced costs */
388 for (int i = 0; i < lpx_get_num_cols (lp); i++)
389 {
390 if (lpsolver == 1)
391 redcosts[i] = lpx_get_col_dual (lp, i+1);
392 else
393 redcosts[i] = lpx_ipt_col_dual (lp, i+1);
394 }
395 }
396
397 *time = (clock () - t_start) / CLOCKS_PER_SEC;
398
399 #ifdef GLPK_PRE_4_14
400 *mem = (lib_env_ptr () -> mem_tpeak);
401 #else
402 *mem = 0;
403 #endif
404
405 lpx_delete_prob (lp);
406 return 0;
407 }
408
409 lpx_delete_prob (lp);
410
411 *status = errnum;
412
413 return errnum;
414 }
415
416 #endif
417
418 #define OCTAVE_GLPK_GET_REAL_PARAM(NAME, IDX) \
419 do \
420 { \
421 octave_value tmp = PARAM.getfield (NAME); \
422 \
423 if (tmp.is_defined ()) \
424 { \
425 if (! tmp.is_empty ()) \
426 { \
427 lpxRealParam[IDX] = tmp.scalar_value (); \
428 \
429 if (error_state) \
430 { \
431 error ("glpk: invalid value in PARAM." NAME); \
432 return retval; \
433 } \
434 } \
435 else \
436 { \
437 error ("glpk: invalid value in PARAM." NAME); \
438 return retval; \
439 } \
440 } \
441 } \
442 while (0)
443
444 #define OCTAVE_GLPK_GET_INT_PARAM(NAME, VAL) \
445 do \
446 { \
447 octave_value tmp = PARAM.getfield (NAME); \
448 \
449 if (tmp.is_defined ()) \
450 { \
451 if (! tmp.is_empty ()) \
452 { \
453 VAL = tmp.int_value (); \
454 \
455 if (error_state) \
456 { \
457 error ("glpk: invalid value in PARAM." NAME); \
458 return retval; \
459 } \
460 } \
461 else \
462 { \
463 error ("glpk: invalid value in PARAM." NAME); \
464 return retval; \
465 } \
466 } \
467 } \
468 while (0)
469
470 DEFUN_DLD (__glpk__, args, ,
471 "-*- texinfo -*-\n\
472 @deftypefn {Loadable Function} {[@var{values}] =} __glpk__ (@var{args})\n\
473 Undocumented internal function.\n\
474 @end deftypefn")
475 {
476 // The list of values to return. See the declaration in oct-obj.h
477 octave_value_list retval;
478
479 #if defined (HAVE_GLPK)
480
481 int nrhs = args.length ();
482
483 if (nrhs != 9)
484 {
485 print_usage ();
486 return retval;
487 }
488
489 //-- 1nd Input. A column array containing the objective function
490 //-- coefficients.
491 volatile int mrowsc = args(0).rows ();
492
493 Matrix C (args(0).matrix_value ());
494
495 if (error_state)
496 {
497 error ("__glpk__: invalid value of C");
498 return retval;
499 }
500
501 double *c = C.fortran_vec ();
502 Array<int> rn;
503 Array<int> cn;
504 ColumnVector a;
505 volatile int mrowsA;
506 volatile int nz = 0;
507
508 //-- 2nd Input. A matrix containing the constraints coefficients.
509 // If matrix A is NOT a sparse matrix
510 if (args(1).is_sparse_type ())
511 {
512 SparseMatrix A = args(1).sparse_matrix_value (); // get the sparse matrix
513
514 if (error_state)
515 {
516 error ("__glpk__: invalid value of A");
517 return retval;
518 }
519
520 mrowsA = A.rows ();
521 octave_idx_type Anc = A.cols ();
522 octave_idx_type Anz = A.nnz ();
523 rn.resize (dim_vector (Anz+1, 1));
524 cn.resize (dim_vector (Anz+1, 1));
525 a.resize (Anz+1, 0.0);
526
527 if (Anc != mrowsc)
528 {
529 error ("__glpk__: invalid value of A");
530 return retval;
531 }
532
533 for (octave_idx_type j = 0; j < Anc; j++)
534 for (octave_idx_type i = A.cidx (j); i < A.cidx (j+1); i++)
535 {
536 nz++;
537 rn(nz) = A.ridx (i) + 1;
538 cn(nz) = j + 1;
539 a(nz) = A.data(i);
540 }
541 }
542 else
543 {
544 Matrix A (args(1).matrix_value ()); // get the matrix
545
546 if (error_state)
547 {
548 error ("__glpk__: invalid value of A");
549 return retval;
550 }
551
552 mrowsA = A.rows ();
553 rn.resize (dim_vector (mrowsA*mrowsc+1, 1));
554 cn.resize (dim_vector (mrowsA*mrowsc+1, 1));
555 a.resize (mrowsA*mrowsc+1, 0.0);
556
557 for (int i = 0; i < mrowsA; i++)
558 {
559 for (int j = 0; j < mrowsc; j++)
560 {
561 if (A(i,j) != 0)
562 {
563 nz++;
564 rn(nz) = i + 1;
565 cn(nz) = j + 1;
566 a(nz) = A(i,j);
567 }
568 }
569 }
570
571 }
572
573 //-- 3rd Input. A column array containing the right-hand side value
574 // for each constraint in the constraint matrix.
575 Matrix B (args(2).matrix_value ());
576
577 if (error_state)
578 {
579 error ("__glpk__: invalid value of B");
580 return retval;
581 }
582
583 double *b = B.fortran_vec ();
584
585 //-- 4th Input. An array of length mrowsc containing the lower
586 //-- bound on each of the variables.
587 Matrix LB (args(3).matrix_value ());
588
589 if (error_state || LB.length () < mrowsc)
590 {
591 error ("__glpk__: invalid value of LB");
592 return retval;
593 }
594
595 double *lb = LB.fortran_vec ();
596
597 //-- LB argument, default: Free
598 Array<int> freeLB (dim_vector (mrowsc, 1));
599 for (int i = 0; i < mrowsc; i++)
600 {
601 if (xisinf (lb[i]))
602 {
603 freeLB(i) = 1;
604 lb[i] = -octave_Inf;
605 }
606 else
607 freeLB(i) = 0;
608 }
609
610 //-- 5th Input. An array of at least length numcols containing the upper
611 //-- bound on each of the variables.
612 Matrix UB (args(4).matrix_value ());
613
614 if (error_state || UB.length () < mrowsc)
615 {
616 error ("__glpk__: invalid value of UB");
617 return retval;
618 }
619
620 double *ub = UB.fortran_vec ();
621
622 Array<int> freeUB (dim_vector (mrowsc, 1));
623 for (int i = 0; i < mrowsc; i++)
624 {
625 if (xisinf (ub[i]))
626 {
627 freeUB(i) = 1;
628 ub[i] = octave_Inf;
629 }
630 else
631 freeUB(i) = 0;
632 }
633
634 //-- 6th Input. A column array containing the sense of each constraint
635 //-- in the constraint matrix.
636 charMatrix CTYPE (args(5).char_matrix_value ());
637
638 if (error_state)
639 {
640 error ("__glpk__: invalid value of CTYPE");
641 return retval;
642 }
643
644 char *ctype = CTYPE.fortran_vec ();
645
646 //-- 7th Input. A column array containing the types of the variables.
647 charMatrix VTYPE (args(6).char_matrix_value ());
648
649 if (error_state)
650 {
651 error ("__glpk__: invalid value of VARTYPE");
652 return retval;
653 }
654
655 Array<int> vartype (dim_vector (mrowsc, 1));
656 volatile int isMIP = 0;
657 for (int i = 0; i < mrowsc ; i++)
658 {
659 if (VTYPE(i,0) == 'I')
660 {
661 isMIP = 1;
662 vartype(i) = LPX_IV;
663 }
664 else
665 vartype(i) = LPX_CV;
666 }
667
668 //-- 8th Input. Sense of optimization.
669 volatile int sense;
670 double SENSE = args(7).scalar_value ();
671
672 if (error_state)
673 {
674 error ("__glpk__: invalid value of SENSE");
675 return retval;
676 }
677
678 if (SENSE >= 0)
679 sense = 1;
680 else
681 sense = -1;
682
683 //-- 9th Input. A structure containing the control parameters.
684 octave_scalar_map PARAM = args(8).scalar_map_value ();
685
686 if (error_state)
687 {
688 error ("__glpk__: invalid value of PARAM");
689 return retval;
690 }
691
692 //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
693 //-- Integer parameters
694 //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
695
696 //-- Level of messages output by the solver
697 OCTAVE_GLPK_GET_INT_PARAM ("msglev", lpxIntParam[0]);
698 if (lpxIntParam[0] < 0 || lpxIntParam[0] > 3)
699 {
700 error ("__glpk__: PARAM.msglev must be 0 (no output [default]) or 1 (error messages only) or 2 (normal output) or 3 (full output)");
701 return retval;
702 }
703
704 //-- scaling option
705 OCTAVE_GLPK_GET_INT_PARAM ("scale", lpxIntParam[1]);
706 if (lpxIntParam[1] < 0 || lpxIntParam[1] > 2)
707 {
708 error ("__glpk__: PARAM.scale must be 0 (no scaling) or 1 (equilibration scaling [default]) or 2 (geometric mean scaling)");
709 return retval;
710 }
711
712 //-- Dual dimplex option
713 OCTAVE_GLPK_GET_INT_PARAM ("dual", lpxIntParam[2]);
714 if (lpxIntParam[2] < 0 || lpxIntParam[2] > 1)
715 {
716 error ("__glpk__: PARAM.dual must be 0 (do NOT use dual simplex [default]) or 1 (use dual simplex)");
717 return retval;
718 }
719
720 //-- Pricing option
721 OCTAVE_GLPK_GET_INT_PARAM ("price", lpxIntParam[3]);
722 if (lpxIntParam[3] < 0 || lpxIntParam[3] > 1)
723 {
724 error ("__glpk__: PARAM.price must be 0 (textbook pricing) or 1 (steepest edge pricing [default])");
725 return retval;
726 }
727
728 //-- Solution rounding option
729 OCTAVE_GLPK_GET_INT_PARAM ("round", lpxIntParam[4]);
730 if (lpxIntParam[4] < 0 || lpxIntParam[4] > 1)
731 {
732 error ("__glpk__: PARAM.round must be 0 (report all primal and dual values [default]) or 1 (replace tiny primal and dual values by exact zero)");
733 return retval;
734 }
735
736 //-- Simplex iterations limit
737 OCTAVE_GLPK_GET_INT_PARAM ("itlim", lpxIntParam[5]);
738
739 //-- Simplex iterations count
740 OCTAVE_GLPK_GET_INT_PARAM ("itcnt", lpxIntParam[6]);
741
742 //-- Output frequency, in iterations
743 OCTAVE_GLPK_GET_INT_PARAM ("outfrq", lpxIntParam[7]);
744
745 //-- Branching heuristic option
746 OCTAVE_GLPK_GET_INT_PARAM ("branch", lpxIntParam[14]);
747 if (lpxIntParam[14] < 0 || lpxIntParam[14] > 2)
748 {
749 error ("__glpk__: PARAM.branch must be (MIP only) 0 (branch on first variable) or 1 (branch on last variable) or 2 (branch using a heuristic by Driebeck and Tomlin [default]");
750 return retval;
751 }
752
753 //-- Backtracking heuristic option
754 OCTAVE_GLPK_GET_INT_PARAM ("btrack", lpxIntParam[15]);
755 if (lpxIntParam[15] < 0 || lpxIntParam[15] > 2)
756 {
757 error ("__glpk__: PARAM.btrack must be (MIP only) 0 (depth first search) or 1 (breadth first search) or 2 (backtrack using the best projection heuristic [default]");
758 return retval;
759 }
760
761 //-- Presolver option
762 OCTAVE_GLPK_GET_INT_PARAM ("presol", lpxIntParam[16]);
763 if (lpxIntParam[16] < 0 || lpxIntParam[16] > 1)
764 {
765 error ("__glpk__: PARAM.presol must be 0 (do NOT use LP presolver) or 1 (use LP presolver [default])");
766 return retval;
767 }
768
769 //-- LPsolver option
770 volatile int lpsolver = 1;
771 OCTAVE_GLPK_GET_INT_PARAM ("lpsolver", lpsolver);
772 if (lpsolver < 1 || lpsolver > 2)
773 {
774 error ("__glpk__: PARAM.lpsolver must be 1 (simplex method) or 2 (interior point method)");
775 return retval;
776 }
777
778 //-- Save option
779 volatile int save_pb = 0;
780 OCTAVE_GLPK_GET_INT_PARAM ("save", save_pb);
781 save_pb = save_pb != 0;
782
783 //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
784 //-- Real parameters
785 //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
786
787 //-- Ratio test option
788 OCTAVE_GLPK_GET_REAL_PARAM ("relax", 0);
789
790 //-- Relative tolerance used to check if the current basic solution
791 //-- is primal feasible
792 OCTAVE_GLPK_GET_REAL_PARAM ("tolbnd", 1);
793
794 //-- Absolute tolerance used to check if the current basic solution
795 //-- is dual feasible
796 OCTAVE_GLPK_GET_REAL_PARAM ("toldj", 2);
797
798 //-- Relative tolerance used to choose eligible pivotal elements of
799 //-- the simplex table in the ratio test
800 OCTAVE_GLPK_GET_REAL_PARAM ("tolpiv", 3);
801
802 OCTAVE_GLPK_GET_REAL_PARAM ("objll", 4);
803
804 OCTAVE_GLPK_GET_REAL_PARAM ("objul", 5);
805
806 OCTAVE_GLPK_GET_REAL_PARAM ("tmlim", 6);
807
808 OCTAVE_GLPK_GET_REAL_PARAM ("outdly", 7);
809
810 OCTAVE_GLPK_GET_REAL_PARAM ("tolint", 8);
811
812 OCTAVE_GLPK_GET_REAL_PARAM ("tolobj", 9);
813
814 //-- Assign pointers to the output parameters
815 ColumnVector xmin (mrowsc, octave_NA);
816 double fmin = octave_NA;
817 double status;
818 ColumnVector lambda (mrowsA, octave_NA);
819 ColumnVector redcosts (mrowsc, octave_NA);
820 double time;
821 double mem;
822
823 int jmpret = setjmp (mark);
824
825 if (jmpret == 0)
826 glpk (sense, mrowsc, mrowsA, c, nz, rn.fortran_vec (),
827 cn.fortran_vec (), a.fortran_vec (), b, ctype,
828 freeLB.fortran_vec (), lb, freeUB.fortran_vec (), ub,
829 vartype.fortran_vec (), isMIP, lpsolver, save_pb,
830 xmin.fortran_vec (), &fmin, &status, lambda.fortran_vec (),
831 redcosts.fortran_vec (), &time, &mem);
832
833 octave_scalar_map extra;
834
835 if (! isMIP)
836 {
837 extra.assign ("lambda", lambda);
838 extra.assign ("redcosts", redcosts);
839 }
840
841 extra.assign ("time", time);
842 extra.assign ("mem", mem);
843
844 retval(3) = extra;
845 retval(2) = status;
846 retval(1) = fmin;
847 retval(0) = xmin;
848
849 #else
850
851 gripe_not_supported ("glpk");
852
853 #endif
854
855 return retval;
856 }
857
858 /*
859 ## No test needed for internal helper function.
860 %!assert (1)
861 */