Project

General

Profile

Statistics
| Branch: | Revision:

cool / src / lib / glpk_stub.c @ de84f40d

History | View | Annotate | Download (10.7 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
#include <caml/alloc.h>
22
#include <caml/callback.h>
23
#include <caml/custom.h>
24
#include <caml/fail.h>
25
#include <caml/memory.h>
26
#include <caml/misc.h>
27
#include <caml/mlvalues.h>
28
#include <caml/signals.h>
29

    
30
#include <assert.h>
31

    
32
#include <glpk.h>
33

    
34
static void raise_on_error(int ret) {
35
        /* TODO: Do we want this semantics? */
36
#if 0
37
        switch(ret) {
38
                case glp_prob_E_OK:
39
                        return;
40

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

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

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

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

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

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

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

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

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

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

71
                case glp_prob_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
#endif
79
}
80

    
81
#define Glp_val(v) (*((glp_prob**)Data_custom_val(v)))
82

    
83
static void finalize_glp(value block) {
84
        glp_delete_prob(Glp_val(block));
85
}
86

    
87
static struct custom_operations glp_ops = {
88
        (char*) "ocaml_glpk_prob",
89
        finalize_glp,
90
        custom_compare_default,
91
        custom_hash_default,
92
        custom_serialize_default,
93
        custom_deserialize_default
94
};
95

    
96
static value box_problem(glp_prob *lp) {
97
        value block = caml_alloc_custom(&glp_ops, sizeof(glp_prob*), 0, 1);
98
        Glp_val(block) = lp;
99
        return block;
100
}
101

    
102
CAMLprim value ocaml_glpk_new_prob(value unit) {
103
        glp_prob *lp = glp_create_prob();
104
        return box_problem(lp);
105
}
106

    
107
CAMLprim value ocaml_glpk_set_prob_name(value blp, value name) {
108
        glp_prob *lp = Glp_val(blp);
109
        glp_set_prob_name(lp, String_val(name));
110
        return Val_unit;
111
}
112

    
113
CAMLprim value ocaml_glpk_get_prob_name(value blp) {
114
        CAMLparam1(blp);
115
        glp_prob *lp = Glp_val(blp);
116
        CAMLreturn(caml_copy_string(glp_get_prob_name(lp)));
117
}
118

    
119
CAMLprim value ocaml_glpk_set_obj_name(value blp, value name) {
120
        glp_prob *lp = Glp_val(blp);
121
        glp_set_obj_name(lp, String_val(name));
122
        return Val_unit;
123
}
124

    
125
CAMLprim value ocaml_glpk_get_obj_name(value blp) {
126
        CAMLparam1(blp);
127
        glp_prob *lp = Glp_val(blp);
128
        CAMLreturn(caml_copy_string(glp_get_obj_name(lp)));
129
}
130

    
131
static int direction_table[] = {GLP_MIN, GLP_MAX};
132

    
133
CAMLprim value ocaml_glpk_set_direction(value blp, value direction) {
134
        glp_prob *lp = Glp_val(blp);
135
        glp_set_obj_dir(lp, direction_table[Int_val(direction)]);
136
        return Val_unit;
137
}
138

    
139
CAMLprim value ocaml_glpk_get_direction(value blp) {
140
        glp_prob *lp = Glp_val(blp);
141
        switch(glp_get_obj_dir(lp)) {
142
                case GLP_MIN: return Val_int(0);
143
                case GLP_MAX: return Val_int(1);
144
                default: assert(0);
145
        }
146
}
147

    
148
CAMLprim value ocaml_glpk_add_rows(value blp, value n) {
149
        glp_prob *lp = Glp_val(blp);
150
        glp_add_rows(lp, Int_val(n));
151
        return Val_unit;
152
}
153

    
154
CAMLprim value ocaml_glpk_set_row_name(value blp, value n, value name) {
155
        glp_prob *lp = Glp_val(blp);
156
        glp_set_row_name(lp, Int_val(n) + 1, String_val(name));
157
        return Val_unit;
158
}
159

    
160
CAMLprim value ocaml_glpk_get_row_name(value blp, value n) {
161
        CAMLparam1(blp);
162
        glp_prob *lp = Glp_val(blp);
163
        CAMLreturn(caml_copy_string(glp_get_row_name(lp, Int_val(n) + 1)));
164
}
165

    
166
static int auxvartype_table[] = {
167
        GLP_FR, /* Unbound variable */
168
        GLP_LO, /* Lower bound */
169
        GLP_UP, /* Upper bound */
170
        GLP_DB, /* Lower and upper bound */
171
        GLP_FX  /* Fixed value */ };
172

    
173
CAMLprim value ocaml_glpk_set_row_bounds(value blp, value n, value type, value lb, value ub) {
174
        glp_prob *lp = Glp_val(blp);
175
        glp_set_row_bnds(lp, Int_val(n) + 1, auxvartype_table[Int_val(type)], Double_val(lb), Double_val(ub));
176
        return Val_unit;
177
}
178

    
179
CAMLprim value ocaml_glpk_add_cols(value blp, value n) {
180
        glp_prob *lp = Glp_val(blp);
181
        glp_add_cols(lp, Int_val(n));
182
        return Val_unit;
183
}
184

    
185
CAMLprim value ocaml_glpk_set_col_name(value blp, value n, value name) {
186
        glp_prob *lp = Glp_val(blp);
187
        glp_set_col_name(lp, Int_val(n) + 1, String_val(name));
188
        return Val_unit;
189
}
190

    
191
CAMLprim value ocaml_glpk_get_col_name(value blp, value n) {
192
        CAMLparam1(blp);
193
        glp_prob *lp = Glp_val(blp);
194
        CAMLreturn(caml_copy_string(glp_get_col_name(lp, Int_val(n) + 1)));
195
}
196

    
197
CAMLprim value ocaml_glpk_set_col_bounds(value blp, value n, value type, value lb, value ub) {
198
        glp_prob *lp = Glp_val(blp);
199
        glp_set_col_bnds(lp, Int_val(n) + 1, auxvartype_table[Int_val(type)], Double_val(lb), Double_val(ub));
200
        return Val_unit;
201
}
202

    
203
CAMLprim value ocaml_glpk_set_obj_coef(value blp, value n, value coef) {
204
        glp_prob *lp = Glp_val(blp);
205
        glp_set_obj_coef(lp, Int_val(n) + 1, Double_val(coef));
206
        return Val_unit;
207
}
208

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

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

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

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

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

    
246
        return Val_unit;
247
}
248

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

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

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

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

    
273
        return Val_unit;
274
}
275

    
276
CAMLprim value ocaml_glpk_simplex(value blp) {
277
        CAMLparam1(blp);
278
        glp_prob *lp = Glp_val(blp);
279
        int ret;
280

    
281
        caml_enter_blocking_section();
282
        ret = glp_simplex(lp, NULL);
283
        caml_leave_blocking_section();
284

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

    
289
CAMLprim value ocaml_glpk_get_obj_val(value blp) {
290
        glp_prob *lp = Glp_val(blp);
291
        double ans;
292
        ans = glp_get_obj_val(lp);
293
        return caml_copy_double(ans);
294
}
295

    
296
CAMLprim value ocaml_glpk_get_col_prim(value blp, value n) {
297
        glp_prob *lp = Glp_val(blp);
298
        double ans;
299
        ans = glp_get_col_prim(lp, Int_val(n) + 1);
300
        return caml_copy_double(ans);
301
}
302

    
303
CAMLprim value ocaml_glpk_get_row_prim(value blp, value n) {
304
        glp_prob *lp = Glp_val(blp);
305
        return caml_copy_double(glp_get_row_prim(lp, Int_val(n) + 1));
306
}
307

    
308
CAMLprim value ocaml_glpk_get_row_dual(value blp, value n) {
309
        glp_prob *lp = Glp_val(blp);
310
        return caml_copy_double(glp_get_row_dual(lp, Int_val(n) + 1));
311
}
312

    
313
CAMLprim value ocaml_glpk_get_num_rows(value blp) {
314
        glp_prob *lp = Glp_val(blp);
315
        return Val_int(glp_get_num_rows(lp));
316
}
317

    
318
CAMLprim value ocaml_glpk_get_num_cols(value blp) {
319
        glp_prob *lp = Glp_val(blp);
320
        return Val_int(glp_get_num_cols(lp));
321
}
322

    
323
CAMLprim value ocaml_glpk_scale_problem(value blp) {
324
        glp_prob *lp = Glp_val(blp);
325
        glp_scale_prob(lp, GLP_SF_AUTO); /* TODO! */
326
        return Val_unit;
327
}
328

    
329
CAMLprim value ocaml_glpk_unscale_problem(value blp) {
330
        glp_prob *lp = Glp_val(blp);
331
        glp_unscale_prob(lp);
332
        return Val_unit;
333
}
334

    
335
CAMLprim value ocaml_glpk_interior(value blp) {
336
        CAMLparam1(blp);
337
        glp_prob *lp = Glp_val(blp);
338
        int ret;
339

    
340
        caml_enter_blocking_section();
341
        ret = glp_interior(lp, NULL); /* TODO! */
342
        caml_leave_blocking_section();
343

    
344
        raise_on_error(ret);
345
        CAMLreturn(Val_unit);
346
}
347

    
348
static int kind_table[] = {GLP_CV, GLP_IV};
349

    
350
CAMLprim value ocaml_glpk_set_col_kind(value blp, value n, value kind) {
351
        glp_prob *lp = Glp_val(blp);
352
        glp_set_col_kind(lp, Int_val(n) + 1, kind_table[Int_val(kind)]);
353
        return Val_unit;
354
}
355

    
356
CAMLprim value ocaml_glpk_warm_up(value blp) {
357
        glp_prob *lp = Glp_val(blp);
358
        raise_on_error(glp_warm_up(lp));
359
        return Val_unit;
360
}
361

    
362
#if 0
363

364
/* TODO! */
365

366
#define BIND_INT_PARAM(name, param) \
367
        CAMLprim value ocaml_glpk_get_##name(value blp) \
368
        { \
369
                glp_prob *lp = Glp_val(blp); \
370
                return Val_int(lpx_get_int_parm(lp, param)); \
371
        } \
372
        CAMLprim value ocaml_glpk_set_##name(value blp, value n) \
373
        { \
374
                glp_prob *lp = Glp_val(blp); \
375
                glp_set_int_parm(lp, param, Int_val(n)); \
376
                return Val_unit; \
377
        }
378

379
#define BIND_REAL_PARAM(name, param) \
380
        CAMLprim value ocaml_glpk_get_##name(value blp) \
381
        { \
382
                glp_prob *lp = Glp_val(blp); \
383
                double ans = lpx_get_real_parm(lp, param); \
384
                return caml_copy_double(ans); \
385
        } \
386
        CAMLprim value ocaml_glpk_set_##name(value blp, value n) \
387
        { \
388
                glp_prob *lp = Glp_val(blp); \
389
                glp_set_real_parm(lp, param, Double_val(n)); \
390
                return Val_unit; \
391
        }
392

393
BIND_INT_PARAM(message_level, glp_prob_K_MSGLEV);
394
BIND_INT_PARAM(scaling, glp_prob_K_SCALE);
395
BIND_INT_PARAM(use_dual_simplex, glp_prob_K_DUAL);
396
BIND_INT_PARAM(pricing, glp_prob_K_PRICE);
397
BIND_REAL_PARAM(relaxation, glp_prob_K_RELAX);
398
/*
399
BIND_REAL_PARAM(relative_tolerance, glp_prob_K_TOLBND);
400
BIND_REAL_PARAM(absolute_tolerance, glp_prob_K_TOLDJ);
401
*/
402
BIND_INT_PARAM(solution_rounding, glp_prob_K_ROUND);
403
BIND_INT_PARAM(iteration_limit, glp_prob_K_ITLIM);
404
BIND_INT_PARAM(iteration_count, glp_prob_K_ITCNT);
405
BIND_REAL_PARAM(time_limit, glp_prob_K_TMLIM);
406
BIND_INT_PARAM(branching_heuristic, glp_prob_K_BRANCH);
407
BIND_INT_PARAM(backtracking_heuristic, glp_prob_K_BTRACK);
408
BIND_INT_PARAM(use_presolver, glp_prob_K_PRESOL);
409

410
#endif
411