Project

General

Profile

Statistics
| Branch: | Revision:

cool / src / lib / glpk_stub.c @ b75e5a66

History | View | Annotate | Download (11 KB)

1
/*
2
 * ocaml-glpk - OCaml bindings to glpk
3
 * Copyright (C) 2004 Samuel Mimram, 2014 Dominik Paulus
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
extern "C" {
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
#include <stdio.h>
37

    
38
static void raise_on_error(int ret) {
39
        switch(ret) {
40
                case 0: return;
41
                                /*
42
                case glp_prob_E_OK:
43
                        return;
44

45
                case glp_prob_E_FAULT:
46
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_fault"));
47

48
                case glp_prob_E_OBJLL:
49
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_objll"));
50

51
                case glp_prob_E_OBJUL:
52
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_objul"));
53

54
                case glp_prob_E_NOPFS:
55
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_nopfs"));
56

57
                case glp_prob_E_NODFS:
58
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_nodfs"));
59

60
                case glp_prob_E_ITLIM:
61
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_itlim"));
62

63
                case glp_prob_E_TMLIM:
64
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_tmlim"));
65

66
                case glp_prob_E_SING:
67
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_sing"));
68

69
                case glp_prob_E_EMPTY:
70
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_empty"));
71

72
                case glp_prob_E_BADB:
73
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_badb"));
74

75
                case glp_prob_E_NOCONV:
76
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_noconv"));
77
                        */
78

    
79
                default:
80
                        caml_raise_constant(*caml_named_value("ocaml_glpk_exn_unknown"));
81
        }
82
        assert(0); /* TODO */
83
}
84

    
85
#define Glp_val(v) (*((glp_prob**)Data_custom_val(v)))
86

    
87
static void finalize_glp(value block) {
88
        glp_delete_prob(Glp_val(block));
89
}
90

    
91
static struct custom_operations glp_ops = {
92
        (char*) "ocaml_glpk_prob",
93
        finalize_glp,
94
        custom_compare_default,
95
        custom_hash_default,
96
        custom_serialize_default,
97
        custom_deserialize_default
98
};
99

    
100
static value box_problem(glp_prob *lp) {
101
        value block = caml_alloc_custom(&glp_ops, sizeof(glp_prob*), 0, 1);
102
        Glp_val(block) = lp;
103
        return block;
104
}
105

    
106
CAMLprim value ocaml_glpk_new_prob(value unit) {
107
        glp_prob *lp = glp_create_prob();
108
        return box_problem(lp);
109
}
110

    
111
CAMLprim value ocaml_glpk_set_prob_name(value blp, value name) {
112
        glp_prob *lp = Glp_val(blp);
113
        glp_set_prob_name(lp, String_val(name));
114
        return Val_unit;
115
}
116

    
117
CAMLprim value ocaml_glpk_get_prob_name(value blp) {
118
        CAMLparam1(blp);
119
        glp_prob *lp = Glp_val(blp);
120
        CAMLreturn(caml_copy_string(glp_get_prob_name(lp)));
121
}
122

    
123
CAMLprim value ocaml_glpk_set_obj_name(value blp, value name) {
124
        glp_prob *lp = Glp_val(blp);
125
        glp_set_obj_name(lp, String_val(name));
126
        return Val_unit;
127
}
128

    
129
CAMLprim value ocaml_glpk_get_obj_name(value blp) {
130
        CAMLparam1(blp);
131
        glp_prob *lp = Glp_val(blp);
132
        CAMLreturn(caml_copy_string(glp_get_obj_name(lp)));
133
}
134

    
135
static int direction_table[] = {GLP_MIN, GLP_MAX};
136

    
137
CAMLprim value ocaml_glpk_set_direction(value blp, value direction) {
138
        glp_prob *lp = Glp_val(blp);
139
        glp_set_obj_dir(lp, direction_table[Int_val(direction)]);
140
        return Val_unit;
141
}
142

    
143
CAMLprim value ocaml_glpk_get_direction(value blp) {
144
        glp_prob *lp = Glp_val(blp);
145
        switch(glp_get_obj_dir(lp)) {
146
                case GLP_MIN: return Val_int(0);
147
                case GLP_MAX: return Val_int(1);
148
                default: assert(0);
149
        }
150
}
151

    
152
CAMLprim value ocaml_glpk_add_rows(value blp, value n) {
153
        glp_prob *lp = Glp_val(blp);
154
        glp_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
        glp_prob *lp = Glp_val(blp);
160
        glp_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
        glp_prob *lp = Glp_val(blp);
167
        CAMLreturn(caml_copy_string(glp_get_row_name(lp, Int_val(n) + 1)));
168
}
169

    
170
static int auxvartype_table[] = {
171
        GLP_FR, /* Unbound variable */
172
        GLP_LO, /* Lower bound */
173
        GLP_UP, /* Upper bound */
174
        GLP_DB, /* Lower and upper bound */
175
        GLP_FX  /* Fixed value */ };
176

    
177
CAMLprim value ocaml_glpk_set_row_bounds(value blp, value n, value type, value lb, value ub) {
178
        glp_prob *lp = Glp_val(blp);
179
        glp_set_row_bnds(lp, Int_val(n) + 1, auxvartype_table[Int_val(type)], Double_val(lb), Double_val(ub));
180
        return Val_unit;
181
}
182

    
183
CAMLprim value ocaml_glpk_add_cols(value blp, value n) {
184
        glp_prob *lp = Glp_val(blp);
185
        glp_add_cols(lp, Int_val(n));
186
        return Val_unit;
187
}
188

    
189
CAMLprim value ocaml_glpk_set_col_name(value blp, value n, value name) {
190
        glp_prob *lp = Glp_val(blp);
191
        glp_set_col_name(lp, Int_val(n) + 1, String_val(name));
192
        return Val_unit;
193
}
194

    
195
CAMLprim value ocaml_glpk_get_col_name(value blp, value n) {
196
        CAMLparam1(blp);
197
        glp_prob *lp = Glp_val(blp);
198
        CAMLreturn(caml_copy_string(glp_get_col_name(lp, Int_val(n) + 1)));
199
}
200

    
201
CAMLprim value ocaml_glpk_set_col_bounds(value blp, value n, value type, value lb, value ub) {
202
        glp_prob *lp = Glp_val(blp);
203
        glp_set_col_bnds(lp, Int_val(n) + 1, auxvartype_table[Int_val(type)], Double_val(lb), Double_val(ub));
204
        return Val_unit;
205
}
206

    
207
CAMLprim value ocaml_glpk_set_obj_coef(value blp, value n, value coef) {
208
        glp_prob *lp = Glp_val(blp);
209
        glp_set_obj_coef(lp, Int_val(n) + 1, Double_val(coef));
210
        return Val_unit;
211
}
212

    
213
CAMLprim value ocaml_glpk_load_matrix(value blp, value matrix) {
214
        glp_prob *lp = Glp_val(blp);
215
        unsigned int i_dim = Wosize_val(matrix), j_dim;
216
        int *ia, *ja;
217
        double *ar;
218
        double x;
219
        unsigned int i, j, n;
220

    
221
        if(i_dim <= 0)
222
                return Val_unit;
223

    
224
        j_dim = Wosize_val(Field(matrix, 0)) / Double_wosize;
225
        ia = (int *)malloc((i_dim * j_dim + 1) * sizeof(int));
226
        ja = (int *)malloc((i_dim * j_dim + 1) * sizeof(int));
227
        ar = (double *)malloc((i_dim * j_dim + 1) * sizeof(double));
228
        n = 1;
229

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

    
246
        free(ia);
247
        free(ja);
248
        free(ar);
249

    
250
        return Val_unit;
251
}
252

    
253
CAMLprim value ocaml_glpk_load_sparse_matrix(value blp, value matrix) {
254
        glp_prob *lp = Glp_val(blp);
255
        int len = Wosize_val(matrix);
256
        int *ia, *ja;
257
        double *ar;
258
        int i;
259
        value e;
260

    
261
        ia = (int *)malloc((len + 1) * sizeof(int));
262
        ja = (int *)malloc((len + 1) * sizeof(int));
263
        ar = (double *)malloc((len + 1) * sizeof(double));
264

    
265
        for(i = 0; i < len; i++) {
266
                e = Field(matrix, i);
267
                ia[i + 1] = Int_val(Field(Field(e, 0), 0)) + 1;
268
                ja[i + 1] = Int_val(Field(Field(e, 0), 1)) + 1;
269
                ar[i + 1] = Double_val(Field(e, 1));
270
        }
271
        glp_load_matrix(lp, len, ia, ja, ar);
272

    
273
        free(ia);
274
        free(ja);
275
        free(ar);
276

    
277
        return Val_unit;
278
}
279

    
280
CAMLprim value ocaml_glpk_simplex(value blp) {
281
        CAMLparam1(blp);
282
        glp_prob *lp = Glp_val(blp);
283
        int ret;
284

    
285
        /* XXX */
286
        glp_smcp param; /* XXX */
287
        glp_init_smcp(&param);
288
        param.msg_lev = GLP_MSG_ERR;
289

    
290
        caml_enter_blocking_section();
291
        ret = glp_simplex(lp, &param);
292
        caml_leave_blocking_section();
293

    
294
        raise_on_error(ret);
295
        CAMLreturn(Val_unit);
296
}
297

    
298
CAMLprim value ocaml_glpk_get_status(value blp) {
299
        CAMLparam1(blp);
300
        glp_prob *lp = Glp_val(blp);
301
        int ret = glp_get_status(lp);
302

    
303
        if(ret == GLP_OPT || ret == GLP_FEAS)
304
                CAMLreturn(Val_bool(true));
305
        else
306
                CAMLreturn(Val_bool(false));
307
}
308

    
309
CAMLprim value ocaml_glpk_get_obj_val(value blp) {
310
        glp_prob *lp = Glp_val(blp);
311
        double ans;
312
        ans = glp_get_obj_val(lp);
313
        return caml_copy_double(ans);
314
}
315

    
316
CAMLprim value ocaml_glpk_get_col_prim(value blp, value n) {
317
        glp_prob *lp = Glp_val(blp);
318
        double ans;
319
        ans = glp_get_col_prim(lp, Int_val(n) + 1);
320
        return caml_copy_double(ans);
321
}
322

    
323
CAMLprim value ocaml_glpk_get_row_prim(value blp, value n) {
324
        glp_prob *lp = Glp_val(blp);
325
        return caml_copy_double(glp_get_row_prim(lp, Int_val(n) + 1));
326
}
327

    
328
CAMLprim value ocaml_glpk_get_row_dual(value blp, value n) {
329
        glp_prob *lp = Glp_val(blp);
330
        return caml_copy_double(glp_get_row_dual(lp, Int_val(n) + 1));
331
}
332

    
333
CAMLprim value ocaml_glpk_get_num_rows(value blp) {
334
        glp_prob *lp = Glp_val(blp);
335
        return Val_int(glp_get_num_rows(lp));
336
}
337

    
338
CAMLprim value ocaml_glpk_get_num_cols(value blp) {
339
        glp_prob *lp = Glp_val(blp);
340
        return Val_int(glp_get_num_cols(lp));
341
}
342

    
343
CAMLprim value ocaml_glpk_scale_problem(value blp) {
344
        glp_prob *lp = Glp_val(blp);
345
        glp_scale_prob(lp, GLP_SF_AUTO); /* TODO! */
346
        return Val_unit;
347
}
348

    
349
CAMLprim value ocaml_glpk_unscale_problem(value blp) {
350
        glp_prob *lp = Glp_val(blp);
351
        glp_unscale_prob(lp);
352
        return Val_unit;
353
}
354

    
355
CAMLprim value ocaml_glpk_interior(value blp) {
356
        CAMLparam1(blp);
357
        glp_prob *lp = Glp_val(blp);
358
        int ret;
359

    
360
        caml_enter_blocking_section();
361
        ret = glp_interior(lp, NULL); /* TODO! */
362
        caml_leave_blocking_section();
363

    
364
        raise_on_error(ret);
365
        CAMLreturn(Val_unit);
366
}
367

    
368
static int kind_table[] = {GLP_CV, GLP_IV};
369

    
370
CAMLprim value ocaml_glpk_set_col_kind(value blp, value n, value kind) {
371
        glp_prob *lp = Glp_val(blp);
372
        glp_set_col_kind(lp, Int_val(n) + 1, kind_table[Int_val(kind)]);
373
        return Val_unit;
374
}
375

    
376
CAMLprim value ocaml_glpk_warm_up(value blp) {
377
        glp_prob *lp = Glp_val(blp);
378
        raise_on_error(glp_warm_up(lp));
379
        return Val_unit;
380
}
381

    
382
#define BIND_INT_PARAM(name, param) \
383
        CAMLprim value ocaml_glpk_get_##name(value blp) \
384
        { \
385
                glp_prob *lp = Glp_val(blp); \
386
                return Val_int(lpx_get_int_parm(lp, param)); \
387
        } \
388
        CAMLprim value ocaml_glpk_set_##name(value blp, value n) \
389
        { \
390
                glp_prob *lp = Glp_val(blp); \
391
                glp_set_int_parm(lp, param, Int_val(n)); \
392
                return Val_unit; \
393
        }
394

    
395
#define BIND_REAL_PARAM(name, param) \
396
        CAMLprim value ocaml_glpk_get_##name(value blp) \
397
        { \
398
                glp_prob *lp = Glp_val(blp); \
399
                double ans = lpx_get_real_parm(lp, param); \
400
                return caml_copy_double(ans); \
401
        } \
402
        CAMLprim value ocaml_glpk_set_##name(value blp, value n) \
403
        { \
404
                glp_prob *lp = Glp_val(blp); \
405
                glp_set_real_parm(lp, param, Double_val(n)); \
406
                return Val_unit; \
407
        }
408

    
409
#if 0
410
BIND_INT_PARAM(message_level, glp_prob_K_MSGLEV);
411
BIND_INT_PARAM(message_level, glp_prob_K_MSGLEV);
412
BIND_INT_PARAM(scaling, glp_prob_K_SCALE);
413
BIND_INT_PARAM(use_dual_simplex, glp_prob_K_DUAL);
414
BIND_INT_PARAM(pricing, glp_prob_K_PRICE);
415
BIND_REAL_PARAM(relaxation, glp_prob_K_RELAX);
416
/*
417
BIND_REAL_PARAM(relative_tolerance, glp_prob_K_TOLBND);
418
BIND_REAL_PARAM(absolute_tolerance, glp_prob_K_TOLDJ);
419
*/
420
BIND_INT_PARAM(solution_rounding, glp_prob_K_ROUND);
421
BIND_INT_PARAM(iteration_limit, glp_prob_K_ITLIM);
422
BIND_INT_PARAM(iteration_count, glp_prob_K_ITCNT);
423
BIND_REAL_PARAM(time_limit, glp_prob_K_TMLIM);
424
BIND_INT_PARAM(branching_heuristic, glp_prob_K_BRANCH);
425
BIND_INT_PARAM(backtracking_heuristic, glp_prob_K_BTRACK);
426
BIND_INT_PARAM(use_presolver, glp_prob_K_PRESOL);
427
#endif
428

    
429
}