Project

General

Profile

Statistics
| Branch: | Revision:

cool / src / lib / glpk.ml @ df7f16dc

History | View | Annotate | Download (6.94 KB)

1
(*
2
 * ocaml-glpk - OCaml bindings to glpk
3
 * Copyright (C) 2004-2006 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
(* $Id$ *)
22

    
23
type lp
24

    
25
type direction = Minimize | Maximize
26

    
27
type aux_var_type = Free_var | Lower_bounded_var | Upper_bounded_var | Double_bounded_var | Fixed_var
28

    
29
type prob_class = Linear_prog | Mixed_integer_prog
30

    
31
type var_kind = Continuous_var | Integer_var
32

    
33
exception Fault
34
exception Lower_limit
35
exception Upper_limit
36
exception No_primal_feasible_solution
37
exception No_dual_feasible_solution
38
exception Iteration_limit
39
exception Time_limit
40
exception Solver_failure
41
exception Empty
42
exception Bad_basis
43
exception No_convergence
44
exception Unknown_error
45

    
46
let _ =
47
  Callback.register_exception "ocaml_glpk_exn_fault" Fault;
48
  Callback.register_exception "ocaml_glpk_exn_objll" Lower_limit;
49
  Callback.register_exception "ocaml_glpk_exn_objul" Upper_limit;
50
  Callback.register_exception "ocaml_glpk_exn_nopfs" No_primal_feasible_solution;
51
  Callback.register_exception "ocaml_glpk_exn_nodfs" No_dual_feasible_solution;
52
  Callback.register_exception "ocaml_glpk_exn_itlim" Iteration_limit;
53
  Callback.register_exception "ocaml_glpk_exn_tmlim" Time_limit;
54
  Callback.register_exception "ocaml_glpk_exn_sing" Solver_failure;
55
  Callback.register_exception "ocaml_glpk_exn_empty" Empty;
56
  Callback.register_exception "ocaml_glpk_exn_badb" Bad_basis;
57
  Callback.register_exception "ocaml_glpk_exn_noconv" No_convergence;
58
  Callback.register_exception "ocaml_glpk_exn_unkown" Unknown_error;
59

    
60
external new_problem : unit -> lp = "ocaml_glpk_new_prob"
61

    
62
external set_prob_name : lp -> string -> unit = "ocaml_glpk_set_prob_name"
63

    
64
external get_prob_name : lp -> string = "ocaml_glpk_get_prob_name"
65

    
66
external set_obj_name : lp -> string -> unit = "ocaml_glpk_set_obj_name"
67

    
68
external get_obj_name : lp -> string = "ocaml_glpk_get_obj_name"
69

    
70
external set_direction : lp -> direction -> unit = "ocaml_glpk_set_direction"
71

    
72
external get_direction : lp -> direction = "ocaml_glpk_get_direction"
73

    
74
external add_rows : lp -> int -> unit = "ocaml_glpk_add_rows"
75

    
76
external set_row_name : lp -> int -> string -> unit = "ocaml_glpk_set_row_name"
77

    
78
external get_row_name : lp -> int -> string = "ocaml_glpk_get_row_name"
79

    
80
external set_row_bounds : lp -> int -> aux_var_type -> float -> float -> unit = "ocaml_glpk_set_row_bounds"
81

    
82
external add_columns : lp -> int -> unit = "ocaml_glpk_add_cols"
83

    
84
external set_col_name : lp -> int -> string -> unit = "ocaml_glpk_set_col_name"
85

    
86
external get_col_name : lp -> int -> string = "ocaml_glpk_get_col_name"
87

    
88
external set_col_bounds : lp -> int -> aux_var_type -> float -> float -> unit = "ocaml_glpk_set_col_bounds"
89

    
90
external set_obj_coef : lp -> int -> float -> unit = "ocaml_glpk_set_obj_coef"
91

    
92
external load_matrix : lp -> float array array -> unit = "ocaml_glpk_load_matrix"
93

    
94
external load_sparse_matrix : lp -> ((int * int) * float) array -> unit = "ocaml_glpk_load_sparse_matrix"
95

    
96
external simplex : lp -> unit = "ocaml_glpk_simplex"
97

    
98
external get_obj_val : lp -> float = "ocaml_glpk_get_obj_val"
99

    
100
external get_col_primal : lp -> int -> float = "ocaml_glpk_get_col_prim"
101

    
102
external get_row_primal : lp -> int -> float = "ocaml_glpk_get_row_prim"
103

    
104
external get_row_dual : lp -> int -> float = "ocaml_glpk_get_row_dual"
105

    
106
let make_problem dir zcoefs constr pbounds xbounds =
107
  let lp = new_problem () in
108
    set_direction lp dir;
109
    add_rows lp (Array.length pbounds);
110
    for i = 0 to (Array.length pbounds) - 1 do
111
      match pbounds.(i) with
112
        | lb, ub when lb = -.infinity && ub = infinity -> set_row_bounds lp i Free_var 0. 0.
113
        | lb, ub when ub = infinity -> set_row_bounds lp i Lower_bounded_var lb 0.
114
        | lb, ub when lb = -.infinity -> set_row_bounds lp i Upper_bounded_var 0. ub
115
        | lb, ub when lb = ub -> set_row_bounds lp i Fixed_var lb ub
116
        | lb, ub -> set_row_bounds lp i Double_bounded_var lb ub
117
    done;
118
    add_columns lp (Array.length xbounds);
119
    for i = 0 to (Array.length xbounds) - 1 do
120
      set_obj_coef lp i zcoefs.(i);
121
      match xbounds.(i) with
122
        | lb, ub when lb = -.infinity && ub = infinity -> set_col_bounds lp i Free_var 0. 0.
123
        | lb, ub when ub = infinity -> set_col_bounds lp i Lower_bounded_var lb 0.
124
        | lb, ub when lb = -.infinity -> set_col_bounds lp i Upper_bounded_var 0. ub
125
        | lb, ub when lb = ub -> set_col_bounds lp i Fixed_var lb ub
126
        | lb, ub -> set_col_bounds lp i Double_bounded_var lb ub
127
    done;
128
    load_matrix lp constr;
129
    lp
130

    
131
external get_num_rows : lp -> int = "ocaml_glpk_get_num_rows"
132

    
133
external get_num_cols : lp -> int = "ocaml_glpk_get_num_cols"
134

    
135
let get_col_primals lp =
136
  let n = get_num_cols lp in
137
  let ans = Array.make n 0. in
138
    for i = 0 to (n - 1)
139
    do
140
      ans.(i) <- get_col_primal lp i
141
    done;
142
    ans
143

    
144
external scale_problem : lp -> unit = "ocaml_glpk_scale_problem"
145

    
146
external unscale_problem : lp -> unit = "ocaml_glpk_unscale_problem"
147

    
148
external interior : lp -> unit = "ocaml_glpk_interior"
149

    
150
external set_class : lp -> prob_class -> unit = "ocaml_glpk_set_class"
151

    
152
external get_class : lp -> prob_class = "ocaml_glpk_get_class"
153

    
154
external set_col_kind : lp -> int -> var_kind -> unit = "ocaml_glpk_set_col_kind"
155

    
156
external branch_and_bound : lp -> unit = "ocaml_glpk_integer"
157

    
158
external branch_and_bound_opt : lp -> unit = "ocaml_glpk_integer"
159

    
160
external warm_up : lp -> unit = "ocaml_glpk_warm_up"
161

    
162
external use_presolver : lp -> bool -> unit = "ocaml_glpk_set_use_presolver"
163

    
164
external read_cplex : string -> lp = "ocaml_glpk_read_cplex"
165

    
166
external write_cplex : lp -> string -> unit = "ocaml_glpk_write_cplex"
167

    
168
external set_simplex_iteration_count : lp -> int -> unit = "ocaml_glpk_set_iteration_count"
169

    
170
let reset_simplex_iteration_count lp =
171
  set_simplex_iteration_count lp 0
172

    
173
external get_simplex_iteration_count : lp -> int = "ocaml_glpk_get_iteration_count"
174

    
175
external _set_message_level : lp -> int -> unit = "ocaml_glpk_set_message_level"
176

    
177
let set_message_level lp n =
178
    if (n < 0 && n > 3) then
179
        raise (Invalid_argument "set_message_level");
180
    _set_message_level lp n
181

    
182
external set_simplex_iteration_limit : lp -> int -> unit = "ocaml_glpk_set_iteration_limit"
183

    
184
external get_simplex_iteration_limit : lp -> int = "ocaml_glpk_get_iteration_limit"
185

    
186
external set_simplex_time_limit : lp -> float -> unit = "ocaml_glpk_set_time_limit"
187

    
188
external get_simplex_time_limit : lp -> float = "ocaml_glpk_get_time_limit"