Project

General

Profile

Statistics
| Branch: | Revision:

cool / src / lib / glpk_stub.c @ df7f16dc

History | View | Annotate | Download (12 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
{
38
  switch(ret)
39
  {
40
    case LPX_E_OK:
41
      return;
42

    
43
    case LPX_E_FAULT:
44
      caml_raise_constant(*caml_named_value("ocaml_glpk_exn_fault"));
45

    
46
    case LPX_E_OBJLL:
47
      caml_raise_constant(*caml_named_value("ocaml_glpk_exn_objll"));
48

    
49
    case LPX_E_OBJUL:
50
      caml_raise_constant(*caml_named_value("ocaml_glpk_exn_objul"));
51

    
52
    case LPX_E_NOPFS:
53
      caml_raise_constant(*caml_named_value("ocaml_glpk_exn_nopfs"));
54

    
55
    case LPX_E_NODFS:
56
      caml_raise_constant(*caml_named_value("ocaml_glpk_exn_nodfs"));
57

    
58
    case LPX_E_ITLIM:
59
      caml_raise_constant(*caml_named_value("ocaml_glpk_exn_itlim"));
60

    
61
    case LPX_E_TMLIM:
62
      caml_raise_constant(*caml_named_value("ocaml_glpk_exn_tmlim"));
63

    
64
    case LPX_E_SING:
65
      caml_raise_constant(*caml_named_value("ocaml_glpk_exn_sing"));
66

    
67
    case LPX_E_EMPTY:
68
      caml_raise_constant(*caml_named_value("ocaml_glpk_exn_empty"));
69

    
70
    case LPX_E_BADB:
71
      caml_raise_constant(*caml_named_value("ocaml_glpk_exn_badb"));
72

    
73
    case LPX_E_NOCONV:
74
      caml_raise_constant(*caml_named_value("ocaml_glpk_exn_noconv"));
75

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

    
82
#define Lpx_val(v) (*((LPX**)Data_custom_val(v)))
83

    
84
static void finalize_lpx(value block)
85
{
86
  lpx_delete_prob(Lpx_val(block));
87
}
88

    
89
static struct custom_operations lpx_ops =
90
{
91
  "ocaml_glpk_lpx",
92
  finalize_lpx,
93
  custom_compare_default,
94
  custom_hash_default,
95
  custom_serialize_default,
96
  custom_deserialize_default
97
};
98

    
99
static value new_blp(LPX* lp)
100
{
101
  value block = caml_alloc_custom(&lpx_ops, sizeof(LPX*), 0, 1);
102
  Lpx_val(block) = lp;
103
  return block;
104
}
105

    
106
CAMLprim value ocaml_glpk_new_prob(value unit)
107
{
108
  LPX *lp = lpx_create_prob();
109
  return new_blp(lp);
110
}
111

    
112
CAMLprim value ocaml_glpk_set_prob_name(value blp, value name)
113
{
114
  LPX *lp = Lpx_val(blp);
115
  lpx_set_prob_name(lp, String_val(name));
116
  return Val_unit;
117
}
118

    
119
CAMLprim value ocaml_glpk_get_prob_name(value blp)
120
{
121
  CAMLparam1(blp);
122
  LPX *lp = Lpx_val(blp);
123
  CAMLreturn(caml_copy_string(lpx_get_prob_name(lp)));
124
}
125

    
126
CAMLprim value ocaml_glpk_set_obj_name(value blp, value name)
127
{
128
  LPX *lp = Lpx_val(blp);
129
  lpx_set_obj_name(lp, String_val(name));
130
  return Val_unit;
131
}
132

    
133
CAMLprim value ocaml_glpk_get_obj_name(value blp)
134
{
135
  CAMLparam1(blp);
136
  LPX *lp = Lpx_val(blp);
137
  CAMLreturn(caml_copy_string(lpx_get_obj_name(lp)));
138
}
139

    
140
static int direction_table[] = {LPX_MIN, LPX_MAX};
141

    
142
CAMLprim value ocaml_glpk_set_direction(value blp, value direction)
143
{
144
  LPX *lp = Lpx_val(blp);
145
  lpx_set_obj_dir(lp, direction_table[Int_val(direction)]);
146
  return Val_unit;
147
}
148

    
149
CAMLprim value ocaml_glpk_get_direction(value blp)
150
{
151
  LPX *lp = Lpx_val(blp);
152
  switch(lpx_get_obj_dir(lp))
153
  {
154
    case LPX_MIN:
155
      return Val_int(0);
156

    
157
    case LPX_MAX:
158
      return Val_int(1);
159

    
160
    default:
161
      assert(0);
162
  }
163
}
164

    
165
CAMLprim value ocaml_glpk_add_rows(value blp, value n)
166
{
167
  LPX *lp = Lpx_val(blp);
168
  lpx_add_rows(lp, Int_val(n));
169
  return Val_unit;
170
}
171

    
172
CAMLprim value ocaml_glpk_set_row_name(value blp, value n, value name)
173
{
174
  LPX *lp = Lpx_val(blp);
175
  lpx_set_row_name(lp, Int_val(n) + 1, String_val(name));
176
  return Val_unit;
177
}
178

    
179
CAMLprim value ocaml_glpk_get_row_name(value blp, value n)
180
{
181
  CAMLparam1(blp);
182
  LPX *lp = Lpx_val(blp);
183
  CAMLreturn(caml_copy_string(lpx_get_row_name(lp, Int_val(n) + 1)));
184
}
185

    
186
static int auxvartype_table[] = {LPX_FR, LPX_LO, LPX_UP, LPX_DB, LPX_FX};
187

    
188
CAMLprim value ocaml_glpk_set_row_bounds(value blp, value n, value type, value lb, value ub)
189
{
190
  LPX *lp = Lpx_val(blp);
191
  lpx_set_row_bnds(lp, Int_val(n) + 1, auxvartype_table[Int_val(type)], Double_val(lb), Double_val(ub));
192
  return Val_unit;
193
}
194

    
195
CAMLprim value ocaml_glpk_add_cols(value blp, value n)
196
{
197
  LPX *lp = Lpx_val(blp);
198
  lpx_add_cols(lp, Int_val(n));
199
  return Val_unit;
200
}
201

    
202
CAMLprim value ocaml_glpk_set_col_name(value blp, value n, value name)
203
{
204
  LPX *lp = Lpx_val(blp);
205
  lpx_set_col_name(lp, Int_val(n) + 1, String_val(name));
206
  return Val_unit;
207
}
208

    
209
CAMLprim value ocaml_glpk_get_col_name(value blp, value n)
210
{
211
  CAMLparam1(blp);
212
  LPX *lp = Lpx_val(blp);
213
  CAMLreturn(caml_copy_string(lpx_get_col_name(lp, Int_val(n) + 1)));
214
}
215

    
216
CAMLprim value ocaml_glpk_set_col_bounds(value blp, value n, value type, value lb, value ub)
217
{
218
  LPX *lp = Lpx_val(blp);
219
  lpx_set_col_bnds(lp, Int_val(n) + 1, auxvartype_table[Int_val(type)], Double_val(lb), Double_val(ub));
220
  return Val_unit;
221
}
222

    
223
CAMLprim value ocaml_glpk_set_obj_coef(value blp, value n, value coef)
224
{
225
  LPX *lp = Lpx_val(blp);
226
  lpx_set_obj_coef(lp, Int_val(n) + 1, Double_val(coef));
227
  return Val_unit;
228
}
229

    
230
CAMLprim value ocaml_glpk_load_matrix(value blp, value matrix)
231
{
232
  LPX *lp = Lpx_val(blp);
233
  int i_dim = Wosize_val(matrix), j_dim;
234
  int *ia, *ja;
235
  double *ar;
236
  double x;
237
  int i, j, n;
238

    
239
  if (i_dim <= 0)
240
    return Val_unit;
241

    
242
  j_dim = Wosize_val(Field(matrix, 0)) / Double_wosize;
243
  ia = (int*)malloc((i_dim * j_dim + 1) * sizeof(int));
244
  ja = (int*)malloc((i_dim * j_dim + 1) * sizeof(int));
245
  ar = (double*)malloc((i_dim * j_dim + 1) * sizeof(double));
246
  n = 1;
247

    
248
  for(i = 0; i < i_dim; i++)
249
  {
250
    /* TODO: raise an error */
251
    assert(Wosize_val(Field(matrix, i)) / Double_wosize == j_dim);
252
    for(j = 0; j < j_dim; j++)
253
    {
254
      x = Double_field(Field(matrix, i), j);
255
      /* We only want non null elements. */
256
      if (x != 0)
257
      {
258
        ia[n] = i + 1;
259
        ja[n] = j + 1;
260
        ar[n] = x;
261
        n++;
262
      }
263
    }
264
  }
265
  lpx_load_matrix(lp, n - 1, ia, ja, ar);
266

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

    
271
  return Val_unit;
272
}
273

    
274
CAMLprim value ocaml_glpk_load_sparse_matrix(value blp, value matrix)
275
{
276
  LPX *lp = Lpx_val(blp);
277
  int len = Wosize_val(matrix);
278
  int *ia, *ja;
279
  double *ar;
280
  int i;
281
  value e;
282

    
283
  ia = (int*)malloc((len + 1) * sizeof(int));
284
  ja = (int*)malloc((len + 1) * sizeof(int));
285
  ar = (double*)malloc((len + 1) * sizeof(double));
286

    
287
  for(i = 0; i < len; i++)
288
  {
289
    e = Field(matrix, i);
290
    ia[i+1] = Int_val(Field(Field(e, 0), 0)) + 1;
291
    ja[i+1] = Int_val(Field(Field(e, 0), 1)) + 1;
292
    ar[i+1] = Double_val(Field(e, 1));
293
  }
294
  lpx_load_matrix(lp, len, ia, ja, ar);
295

    
296
  free(ia);
297
  free(ja);
298
  free(ar);
299

    
300
  return Val_unit;
301
}
302

    
303
CAMLprim value ocaml_glpk_simplex(value blp)
304
{
305
  CAMLparam1(blp);
306
  LPX *lp = Lpx_val(blp);
307
  int ret;
308

    
309
  caml_enter_blocking_section();
310
  ret = lpx_simplex(lp);
311
  caml_leave_blocking_section();
312

    
313
  raise_on_error(ret);
314
  CAMLreturn(Val_unit);
315
}
316

    
317
CAMLprim value ocaml_glpk_get_obj_val(value blp)
318
{
319
  LPX *lp = Lpx_val(blp);
320
  double ans;
321
  if (lpx_get_class(lp) == LPX_MIP)
322
    ans = lpx_mip_obj_val(lp);
323
  else
324
    ans = lpx_get_obj_val(lp);
325
  return caml_copy_double(ans);
326
}
327

    
328
CAMLprim value ocaml_glpk_get_col_prim(value blp, value n)
329
{
330
  LPX *lp = Lpx_val(blp);
331
  double ans;
332
  /* TODO: is it the right thing to do? */
333
  if (lpx_get_class(lp) == LPX_MIP)
334
    ans = lpx_mip_col_val(lp, Int_val(n) + 1);
335
  else
336
    ans = lpx_get_col_prim(lp, Int_val(n) + 1);
337
  return caml_copy_double(ans);
338
}
339

    
340
CAMLprim value ocaml_glpk_get_row_prim(value blp, value n)
341
{
342
  LPX *lp = Lpx_val(blp);
343
  return caml_copy_double(lpx_get_row_prim(lp, Int_val(n) + 1));
344
}
345

    
346
CAMLprim value ocaml_glpk_get_row_dual(value blp, value n)
347
{
348
  LPX *lp = Lpx_val(blp);
349
  return caml_copy_double(lpx_get_row_dual(lp, Int_val(n) + 1));
350
}
351

    
352
CAMLprim value ocaml_glpk_get_num_rows(value blp)
353
{
354
  LPX *lp = Lpx_val(blp);
355
  return Val_int(lpx_get_num_rows(lp));
356
}
357

    
358
CAMLprim value ocaml_glpk_get_num_cols(value blp)
359
{
360
  LPX *lp = Lpx_val(blp);
361
  return Val_int(lpx_get_num_cols(lp));
362
}
363

    
364
CAMLprim value ocaml_glpk_scale_problem(value blp)
365
{
366
  LPX *lp = Lpx_val(blp);
367
  lpx_scale_prob(lp);
368
  return Val_unit;
369
}
370

    
371
CAMLprim value ocaml_glpk_unscale_problem(value blp)
372
{
373
  LPX *lp = Lpx_val(blp);
374
  lpx_unscale_prob(lp);
375
  return Val_unit;
376
}
377

    
378
/* TODO */
379
/*
380
CAMLprim value ocaml_glpk_check_kkt(value blp, value scaled, value vkkt)
381
{
382

383
}
384
*/
385

    
386
CAMLprim value ocaml_glpk_interior(value blp)
387
{
388
  CAMLparam1(blp);
389
  LPX *lp = Lpx_val(blp);
390
  int ret;
391

    
392
  caml_enter_blocking_section();
393
  ret = lpx_interior(lp);
394
  caml_leave_blocking_section();
395

    
396
  raise_on_error(ret);
397
  CAMLreturn(Val_unit);
398
}
399

    
400
static int class_table[] = {LPX_LP, LPX_MIP};
401

    
402
CAMLprim value ocaml_glpk_set_class(value blp, value class)
403
{
404
  LPX *lp = Lpx_val(blp);
405
  lpx_set_class(lp, class_table[Int_val(class)]);
406
  return Val_unit;
407
}
408

    
409
CAMLprim value ocaml_glpk_get_class(value blp)
410
{
411
  LPX *lp = Lpx_val(blp);
412
  switch(lpx_get_class(lp))
413
  {
414
    case LPX_LP:
415
      return Val_int(0);
416

    
417
    case LPX_MIP:
418
      return Val_int(1);
419

    
420
    default:
421
      assert(0);
422
  }
423
}
424

    
425
static int kind_table[] = {LPX_CV, LPX_IV};
426

    
427
CAMLprim value ocaml_glpk_set_col_kind(value blp, value n, value kind)
428
{
429
  LPX *lp = Lpx_val(blp);
430
  lpx_set_col_kind(lp, Int_val(n) + 1, kind_table[Int_val(kind)]);
431
  return Val_unit;
432
}
433

    
434
CAMLprim value ocaml_glpk_integer(value blp)
435
{
436
  CAMLparam1(blp);
437
  LPX *lp = Lpx_val(blp);
438
  int ret;
439

    
440
  caml_enter_blocking_section();
441
  ret = lpx_integer(lp);
442
  caml_leave_blocking_section();
443

    
444
  raise_on_error(ret);
445
  CAMLreturn(Val_unit);
446
}
447

    
448
CAMLprim value ocaml_glpk_intopt(value blp)
449
{
450
  CAMLparam1(blp);
451
  LPX *lp = Lpx_val(blp);
452
  int ret;
453

    
454
  caml_enter_blocking_section();
455
  ret = lpx_intopt(lp);
456
  caml_leave_blocking_section();
457

    
458
  raise_on_error(ret);
459
  CAMLreturn(Val_unit);
460
}
461

    
462
CAMLprim value ocaml_glpk_warm_up(value blp)
463
{
464
  LPX *lp = Lpx_val(blp);
465
  raise_on_error(lpx_warm_up(lp));
466
  return Val_unit;
467
}
468

    
469
#define BIND_INT_PARAM(name, param) \
470
CAMLprim value ocaml_glpk_get_##name(value blp) \
471
{ \
472
  LPX *lp = Lpx_val(blp); \
473
  return Val_int(lpx_get_int_parm(lp, param)); \
474
} \
475
CAMLprim value ocaml_glpk_set_##name(value blp, value n) \
476
{ \
477
  LPX *lp = Lpx_val(blp); \
478
  lpx_set_int_parm(lp, param, Int_val(n)); \
479
  return Val_unit; \
480
}
481

    
482
#define BIND_REAL_PARAM(name, param) \
483
CAMLprim value ocaml_glpk_get_##name(value blp) \
484
{ \
485
  LPX *lp = Lpx_val(blp); \
486
  double ans = lpx_get_real_parm(lp, param); \
487
  return caml_copy_double(ans); \
488
} \
489
CAMLprim value ocaml_glpk_set_##name(value blp, value n) \
490
{ \
491
  LPX *lp = Lpx_val(blp); \
492
  lpx_set_real_parm(lp, param, Double_val(n)); \
493
  return Val_unit; \
494
}
495

    
496
BIND_INT_PARAM(message_level, LPX_K_MSGLEV);
497
BIND_INT_PARAM(scaling, LPX_K_SCALE);
498
BIND_INT_PARAM(use_dual_simplex, LPX_K_DUAL);
499
BIND_INT_PARAM(pricing, LPX_K_PRICE);
500
BIND_REAL_PARAM(relaxation, LPX_K_RELAX);
501
/*
502
BIND_REAL_PARAM(relative_tolerance, LPX_K_TOLBND);
503
BIND_REAL_PARAM(absolute_tolerance, LPX_K_TOLDJ);
504
*/
505
BIND_INT_PARAM(solution_rounding, LPX_K_ROUND);
506
BIND_INT_PARAM(iteration_limit, LPX_K_ITLIM);
507
BIND_INT_PARAM(iteration_count, LPX_K_ITCNT);
508
BIND_REAL_PARAM(time_limit, LPX_K_TMLIM);
509
BIND_INT_PARAM(branching_heuristic, LPX_K_BRANCH);
510
BIND_INT_PARAM(backtracking_heuristic, LPX_K_BTRACK);
511
BIND_INT_PARAM(use_presolver, LPX_K_PRESOL);
512

    
513
CAMLprim value ocaml_glpk_read_cplex(value fname)
514
{
515
  LPX *lp = lpx_read_cpxlp(String_val(fname));
516
  if (!lp)
517
    caml_failwith("Error while reading data in CPLEX LP format.");
518
  return new_blp(lp);
519
}
520

    
521
CAMLprim value ocaml_glpk_write_cplex(value blp, value fname)
522
{
523
  if (lpx_write_cpxlp(Lpx_val(blp), String_val(fname)))
524
    caml_failwith("Error while writing data in CPLEX LP format.");
525
  return Val_unit;
526
}