Project

General

Profile

Statistics
| Branch: | Revision:

cool / src / lib / glpk_stub.c @ 21b7f7bc

History | View | Annotate | Download (11.6 KB)

1
/*
2
 * ocaml-glpk - OCaml bindings to glpk
3
 * Copyright (C) 2004 Samuel Mimram
4
 *
5
 * This program is free software; you can redistribute it and/or modify
6
 * it under the terms of the GNU General Public License as published by
7
 * the Free Software Foundation; either version 2 of the License, or
8
 * (at your option) any later version.
9
 *
10
 * This program is distributed in the hope that it will be useful,
11
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13
 * GNU General Public License for more details.
14
 *
15
 * You should have received a copy of the GNU General Public License
16
 * along with this program; if not, write to the Free Software
17
 * Foundation, Inc., 59 Temple Place - Suite 330,
18
 * Boston, MA 02111-1307, USA.
19
 */
20

    
21
/* $Id$ */
22

    
23
#include <caml/alloc.h>
24
#include <caml/callback.h>
25
#include <caml/custom.h>
26
#include <caml/fail.h>
27
#include <caml/memory.h>
28
#include <caml/misc.h>
29
#include <caml/mlvalues.h>
30
#include <caml/signals.h>
31

    
32
#include <assert.h>
33

    
34
#include <glpk.h>
35

    
36
static void raise_on_error(int ret) {
37
        switch(ret) {
38
                case LPX_E_OK:
39
                        return;
40

    
41
                case LPX_E_FAULT:
42
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_fault"));
43

    
44
                case LPX_E_OBJLL:
45
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_objll"));
46

    
47
                case LPX_E_OBJUL:
48
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_objul"));
49

    
50
                case LPX_E_NOPFS:
51
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_nopfs"));
52

    
53
                case LPX_E_NODFS:
54
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_nodfs"));
55

    
56
                case LPX_E_ITLIM:
57
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_itlim"));
58

    
59
                case LPX_E_TMLIM:
60
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_tmlim"));
61

    
62
                case LPX_E_SING:
63
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_sing"));
64

    
65
                case LPX_E_EMPTY:
66
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_empty"));
67

    
68
                case LPX_E_BADB:
69
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_badb"));
70

    
71
                case LPX_E_NOCONV:
72
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_noconv"));
73

    
74
                default:
75
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_unknown"));
76
        }
77
        assert(0); /* TODO */
78
}
79

    
80
#define Lpx_val(v) (*((LPX**)Data_custom_val(v)))
81

    
82
static void finalize_lpx(value block) {
83
        lpx_delete_prob(Lpx_val(block));
84
}
85

    
86
static struct custom_operations lpx_ops = {
87
        "ocaml_glpk_lpx",
88
        finalize_lpx,
89
        custom_compare_default,
90
        custom_hash_default,
91
        custom_serialize_default,
92
        custom_deserialize_default
93
};
94

    
95
static value new_blp(LPX *lp) {
96
        value block = caml_alloc_custom(&lpx_ops, sizeof(LPX *), 0, 1);
97
        Lpx_val(block) = lp;
98
        return block;
99
}
100

    
101
CAMLprim value ocaml_glpk_new_prob(value unit) {
102
        LPX *lp = lpx_create_prob();
103
        return new_blp(lp);
104
}
105

    
106
CAMLprim value ocaml_glpk_set_prob_name(value blp, value name) {
107
        LPX *lp = Lpx_val(blp);
108
        lpx_set_prob_name(lp, String_val(name));
109
        return Val_unit;
110
}
111

    
112
CAMLprim value ocaml_glpk_get_prob_name(value blp) {
113
        CAMLparam1(blp);
114
        LPX *lp = Lpx_val(blp);
115
        CAMLreturn(caml_copy_string(lpx_get_prob_name(lp)));
116
}
117

    
118
CAMLprim value ocaml_glpk_set_obj_name(value blp, value name) {
119
        LPX *lp = Lpx_val(blp);
120
        lpx_set_obj_name(lp, String_val(name));
121
        return Val_unit;
122
}
123

    
124
CAMLprim value ocaml_glpk_get_obj_name(value blp) {
125
        CAMLparam1(blp);
126
        LPX *lp = Lpx_val(blp);
127
        CAMLreturn(caml_copy_string(lpx_get_obj_name(lp)));
128
}
129

    
130
static int direction_table[] = {LPX_MIN, LPX_MAX};
131

    
132
CAMLprim value ocaml_glpk_set_direction(value blp, value direction) {
133
        LPX *lp = Lpx_val(blp);
134
        lpx_set_obj_dir(lp, direction_table[Int_val(direction)]);
135
        return Val_unit;
136
}
137

    
138
CAMLprim value ocaml_glpk_get_direction(value blp) {
139
        LPX *lp = Lpx_val(blp);
140
        switch(lpx_get_obj_dir(lp)) {
141
                case LPX_MIN:
142
                        return Val_int(0);
143

    
144
                case LPX_MAX:
145
                        return Val_int(1);
146

    
147
                default:
148
                        assert(0);
149
        }
150
}
151

    
152
CAMLprim value ocaml_glpk_add_rows(value blp, value n) {
153
        LPX *lp = Lpx_val(blp);
154
        lpx_add_rows(lp, Int_val(n));
155
        return Val_unit;
156
}
157

    
158
CAMLprim value ocaml_glpk_set_row_name(value blp, value n, value name) {
159
        LPX *lp = Lpx_val(blp);
160
        lpx_set_row_name(lp, Int_val(n) + 1, String_val(name));
161
        return Val_unit;
162
}
163

    
164
CAMLprim value ocaml_glpk_get_row_name(value blp, value n) {
165
        CAMLparam1(blp);
166
        LPX *lp = Lpx_val(blp);
167
        CAMLreturn(caml_copy_string(lpx_get_row_name(lp, Int_val(n) + 1)));
168
}
169

    
170
static int auxvartype_table[] = {LPX_FR, LPX_LO, LPX_UP, LPX_DB, LPX_FX};
171

    
172
CAMLprim value ocaml_glpk_set_row_bounds(value blp, value n, value type, value lb, value ub) {
173
        LPX *lp = Lpx_val(blp);
174
        lpx_set_row_bnds(lp, Int_val(n) + 1, auxvartype_table[Int_val(type)], Double_val(lb), Double_val(ub));
175
        return Val_unit;
176
}
177

    
178
CAMLprim value ocaml_glpk_add_cols(value blp, value n) {
179
        LPX *lp = Lpx_val(blp);
180
        lpx_add_cols(lp, Int_val(n));
181
        return Val_unit;
182
}
183

    
184
CAMLprim value ocaml_glpk_set_col_name(value blp, value n, value name) {
185
        LPX *lp = Lpx_val(blp);
186
        lpx_set_col_name(lp, Int_val(n) + 1, String_val(name));
187
        return Val_unit;
188
}
189

    
190
CAMLprim value ocaml_glpk_get_col_name(value blp, value n) {
191
        CAMLparam1(blp);
192
        LPX *lp = Lpx_val(blp);
193
        CAMLreturn(caml_copy_string(lpx_get_col_name(lp, Int_val(n) + 1)));
194
}
195

    
196
CAMLprim value ocaml_glpk_set_col_bounds(value blp, value n, value type, value lb, value ub) {
197
        LPX *lp = Lpx_val(blp);
198
        lpx_set_col_bnds(lp, Int_val(n) + 1, auxvartype_table[Int_val(type)], Double_val(lb), Double_val(ub));
199
        return Val_unit;
200
}
201

    
202
CAMLprim value ocaml_glpk_set_obj_coef(value blp, value n, value coef) {
203
        LPX *lp = Lpx_val(blp);
204
        lpx_set_obj_coef(lp, Int_val(n) + 1, Double_val(coef));
205
        return Val_unit;
206
}
207

    
208
CAMLprim value ocaml_glpk_load_matrix(value blp, value matrix) {
209
        LPX *lp = Lpx_val(blp);
210
        int i_dim = Wosize_val(matrix), j_dim;
211
        int *ia, *ja;
212
        double *ar;
213
        double x;
214
        int i, j, n;
215

    
216
        if(i_dim <= 0)
217
                return Val_unit;
218

    
219
        j_dim = Wosize_val(Field(matrix, 0)) / Double_wosize;
220
        ia = (int *)malloc((i_dim * j_dim + 1) * sizeof(int));
221
        ja = (int *)malloc((i_dim * j_dim + 1) * sizeof(int));
222
        ar = (double *)malloc((i_dim * j_dim + 1) * sizeof(double));
223
        n = 1;
224

    
225
        for(i = 0; i < i_dim; i++) {
226
                /* TODO: raise an error */
227
                assert(Wosize_val(Field(matrix, i)) / Double_wosize == j_dim);
228
                for(j = 0; j < j_dim; j++) {
229
                        x = Double_field(Field(matrix, i), j);
230
                        /* We only want non null elements. */
231
                        if(x != 0) {
232
                                ia[n] = i + 1;
233
                                ja[n] = j + 1;
234
                                ar[n] = x;
235
                                n++;
236
                        }
237
                }
238
        }
239
        lpx_load_matrix(lp, n - 1, ia, ja, ar);
240

    
241
        free(ia);
242
        free(ja);
243
        free(ar);
244

    
245
        return Val_unit;
246
}
247

    
248
CAMLprim value ocaml_glpk_load_sparse_matrix(value blp, value matrix) {
249
        LPX *lp = Lpx_val(blp);
250
        int len = Wosize_val(matrix);
251
        int *ia, *ja;
252
        double *ar;
253
        int i;
254
        value e;
255

    
256
        ia = (int *)malloc((len + 1) * sizeof(int));
257
        ja = (int *)malloc((len + 1) * sizeof(int));
258
        ar = (double *)malloc((len + 1) * sizeof(double));
259

    
260
        for(i = 0; i < len; i++) {
261
                e = Field(matrix, i);
262
                ia[i + 1] = Int_val(Field(Field(e, 0), 0)) + 1;
263
                ja[i + 1] = Int_val(Field(Field(e, 0), 1)) + 1;
264
                ar[i + 1] = Double_val(Field(e, 1));
265
        }
266
        lpx_load_matrix(lp, len, ia, ja, ar);
267

    
268
        free(ia);
269
        free(ja);
270
        free(ar);
271

    
272
        return Val_unit;
273
}
274

    
275
CAMLprim value ocaml_glpk_simplex(value blp) {
276
        CAMLparam1(blp);
277
        LPX *lp = Lpx_val(blp);
278
        int ret;
279

    
280
        caml_enter_blocking_section();
281
        ret = lpx_simplex(lp);
282
        caml_leave_blocking_section();
283

    
284
        raise_on_error(ret);
285
        CAMLreturn(Val_unit);
286
}
287

    
288
CAMLprim value ocaml_glpk_get_obj_val(value blp) {
289
        LPX *lp = Lpx_val(blp);
290
        double ans;
291
        if(lpx_get_class(lp) == LPX_MIP)
292
                ans = lpx_mip_obj_val(lp);
293
        else
294
                ans = lpx_get_obj_val(lp);
295
        return caml_copy_double(ans);
296
}
297

    
298
CAMLprim value ocaml_glpk_get_col_prim(value blp, value n) {
299
        LPX *lp = Lpx_val(blp);
300
        double ans;
301
        /* TODO: is it the right thing to do? */
302
        if(lpx_get_class(lp) == LPX_MIP)
303
                ans = lpx_mip_col_val(lp, Int_val(n) + 1);
304
        else
305
                ans = lpx_get_col_prim(lp, Int_val(n) + 1);
306
        return caml_copy_double(ans);
307
}
308

    
309
CAMLprim value ocaml_glpk_get_row_prim(value blp, value n) {
310
        LPX *lp = Lpx_val(blp);
311
        return caml_copy_double(lpx_get_row_prim(lp, Int_val(n) + 1));
312
}
313

    
314
CAMLprim value ocaml_glpk_get_row_dual(value blp, value n) {
315
        LPX *lp = Lpx_val(blp);
316
        return caml_copy_double(lpx_get_row_dual(lp, Int_val(n) + 1));
317
}
318

    
319
CAMLprim value ocaml_glpk_get_num_rows(value blp) {
320
        LPX *lp = Lpx_val(blp);
321
        return Val_int(lpx_get_num_rows(lp));
322
}
323

    
324
CAMLprim value ocaml_glpk_get_num_cols(value blp) {
325
        LPX *lp = Lpx_val(blp);
326
        return Val_int(lpx_get_num_cols(lp));
327
}
328

    
329
CAMLprim value ocaml_glpk_scale_problem(value blp) {
330
        LPX *lp = Lpx_val(blp);
331
        lpx_scale_prob(lp);
332
        return Val_unit;
333
}
334

    
335
CAMLprim value ocaml_glpk_unscale_problem(value blp) {
336
        LPX *lp = Lpx_val(blp);
337
        lpx_unscale_prob(lp);
338
        return Val_unit;
339
}
340

    
341
/* TODO */
342
/*
343
CAMLprim value ocaml_glpk_check_kkt(value blp, value scaled, value vkkt)
344
{
345

346
}
347
*/
348

    
349
CAMLprim value ocaml_glpk_interior(value blp) {
350
        CAMLparam1(blp);
351
        LPX *lp = Lpx_val(blp);
352
        int ret;
353

    
354
        caml_enter_blocking_section();
355
        ret = lpx_interior(lp);
356
        caml_leave_blocking_section();
357

    
358
        raise_on_error(ret);
359
        CAMLreturn(Val_unit);
360
}
361

    
362
static int class_table[] = {LPX_LP, LPX_MIP};
363

    
364
CAMLprim value ocaml_glpk_set_class(value blp, value class) {
365
        LPX *lp = Lpx_val(blp);
366
        lpx_set_class(lp, class_table[Int_val(class)]);
367
        return Val_unit;
368
}
369

    
370
CAMLprim value ocaml_glpk_get_class(value blp) {
371
        LPX *lp = Lpx_val(blp);
372
        switch(lpx_get_class(lp)) {
373
                case LPX_LP:
374
                        return Val_int(0);
375

    
376
                case LPX_MIP:
377
                        return Val_int(1);
378

    
379
                default:
380
                        assert(0);
381
        }
382
}
383

    
384
static int kind_table[] = {LPX_CV, LPX_IV};
385

    
386
CAMLprim value ocaml_glpk_set_col_kind(value blp, value n, value kind) {
387
        LPX *lp = Lpx_val(blp);
388
        lpx_set_col_kind(lp, Int_val(n) + 1, kind_table[Int_val(kind)]);
389
        return Val_unit;
390
}
391

    
392
CAMLprim value ocaml_glpk_integer(value blp) {
393
        CAMLparam1(blp);
394
        LPX *lp = Lpx_val(blp);
395
        int ret;
396

    
397
        caml_enter_blocking_section();
398
        ret = lpx_integer(lp);
399
        caml_leave_blocking_section();
400

    
401
        raise_on_error(ret);
402
        CAMLreturn(Val_unit);
403
}
404

    
405
CAMLprim value ocaml_glpk_intopt(value blp) {
406
        CAMLparam1(blp);
407
        LPX *lp = Lpx_val(blp);
408
        int ret;
409

    
410
        caml_enter_blocking_section();
411
        ret = lpx_intopt(lp);
412
        caml_leave_blocking_section();
413

    
414
        raise_on_error(ret);
415
        CAMLreturn(Val_unit);
416
}
417

    
418
CAMLprim value ocaml_glpk_warm_up(value blp) {
419
        LPX *lp = Lpx_val(blp);
420
        raise_on_error(lpx_warm_up(lp));
421
        return Val_unit;
422
}
423

    
424
#define BIND_INT_PARAM(name, param) \
425
        CAMLprim value ocaml_glpk_get_##name(value blp) \
426
        { \
427
                LPX *lp = Lpx_val(blp); \
428
                return Val_int(lpx_get_int_parm(lp, param)); \
429
        } \
430
        CAMLprim value ocaml_glpk_set_##name(value blp, value n) \
431
        { \
432
                LPX *lp = Lpx_val(blp); \
433
                lpx_set_int_parm(lp, param, Int_val(n)); \
434
                return Val_unit; \
435
        }
436

    
437
#define BIND_REAL_PARAM(name, param) \
438
        CAMLprim value ocaml_glpk_get_##name(value blp) \
439
        { \
440
                LPX *lp = Lpx_val(blp); \
441
                double ans = lpx_get_real_parm(lp, param); \
442
                return caml_copy_double(ans); \
443
        } \
444
        CAMLprim value ocaml_glpk_set_##name(value blp, value n) \
445
        { \
446
                LPX *lp = Lpx_val(blp); \
447
                lpx_set_real_parm(lp, param, Double_val(n)); \
448
                return Val_unit; \
449
        }
450

    
451
BIND_INT_PARAM(message_level, LPX_K_MSGLEV);
452
BIND_INT_PARAM(scaling, LPX_K_SCALE);
453
BIND_INT_PARAM(use_dual_simplex, LPX_K_DUAL);
454
BIND_INT_PARAM(pricing, LPX_K_PRICE);
455
BIND_REAL_PARAM(relaxation, LPX_K_RELAX);
456
/*
457
BIND_REAL_PARAM(relative_tolerance, LPX_K_TOLBND);
458
BIND_REAL_PARAM(absolute_tolerance, LPX_K_TOLDJ);
459
*/
460
BIND_INT_PARAM(solution_rounding, LPX_K_ROUND);
461
BIND_INT_PARAM(iteration_limit, LPX_K_ITLIM);
462
BIND_INT_PARAM(iteration_count, LPX_K_ITCNT);
463
BIND_REAL_PARAM(time_limit, LPX_K_TMLIM);
464
BIND_INT_PARAM(branching_heuristic, LPX_K_BRANCH);
465
BIND_INT_PARAM(backtracking_heuristic, LPX_K_BTRACK);
466
BIND_INT_PARAM(use_presolver, LPX_K_PRESOL);
467

    
468
CAMLprim value ocaml_glpk_read_cplex(value fname) {
469
        LPX *lp = lpx_read_cpxlp(String_val(fname));
470
        if(!lp)
471
                caml_failwith("Error while reading data in CPLEX LP format.");
472
        return new_blp(lp);
473
}
474

    
475
CAMLprim value ocaml_glpk_write_cplex(value blp, value fname) {
476
        if(lpx_write_cpxlp(Lpx_val(blp), String_val(fname)))
477
                caml_failwith("Error while writing data in CPLEX LP format.");
478
        return Val_unit;
479
}
480