Project

General

Profile

Statistics
| Branch: | Revision:

cool / src / lib / glpk.ml @ b75e5a66

History | View | Annotate | Download (5.9 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
type lp
22

    
23
type direction = Minimize | Maximize
24

    
25
type aux_var_type = Free_var | Lower_bounded_var | Upper_bounded_var | Double_bounded_var | Fixed_var
26

    
27
type var_kind = Continuous_var | Integer_var
28

    
29
exception Fault
30
exception Lower_limit
31
exception Upper_limit
32
exception No_primal_feasible_solution
33
exception No_dual_feasible_solution
34
exception Iteration_limit
35
exception Time_limit
36
exception Solver_failure
37
exception Empty
38
exception Bad_basis
39
exception No_convergence
40
exception Unknown_error
41

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

    
56
external new_problem : unit -> lp = "ocaml_glpk_new_prob"
57

    
58
external set_prob_name : lp -> string -> unit = "ocaml_glpk_set_prob_name"
59

    
60
external get_prob_name : lp -> string = "ocaml_glpk_get_prob_name"
61

    
62
external set_obj_name : lp -> string -> unit = "ocaml_glpk_set_obj_name"
63

    
64
external get_obj_name : lp -> string = "ocaml_glpk_get_obj_name"
65

    
66
external set_direction : lp -> direction -> unit = "ocaml_glpk_set_direction"
67

    
68
external get_direction : lp -> direction = "ocaml_glpk_get_direction"
69

    
70
external add_rows : lp -> int -> unit = "ocaml_glpk_add_rows"
71

    
72
external set_row_name : lp -> int -> string -> unit = "ocaml_glpk_set_row_name"
73

    
74
external get_row_name : lp -> int -> string = "ocaml_glpk_get_row_name"
75

    
76
external set_row_bounds : lp -> int -> aux_var_type -> float -> float -> unit = "ocaml_glpk_set_row_bounds"
77

    
78
external add_columns : lp -> int -> unit = "ocaml_glpk_add_cols"
79

    
80
external set_col_name : lp -> int -> string -> unit = "ocaml_glpk_set_col_name"
81

    
82
external get_col_name : lp -> int -> string = "ocaml_glpk_get_col_name"
83

    
84
external set_col_bounds : lp -> int -> aux_var_type -> float -> float -> unit = "ocaml_glpk_set_col_bounds"
85

    
86
external set_obj_coef : lp -> int -> float -> unit = "ocaml_glpk_set_obj_coef"
87

    
88
external load_matrix : lp -> float array array -> unit = "ocaml_glpk_load_matrix"
89

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

    
92
external simplex : lp -> unit = "ocaml_glpk_simplex"
93

    
94
external get_status : lp -> bool = "ocaml_glpk_get_status"
95

    
96
external get_obj_val : lp -> float = "ocaml_glpk_get_obj_val"
97

    
98
external get_col_primal : lp -> int -> float = "ocaml_glpk_get_col_prim"
99

    
100
external get_row_primal : lp -> int -> float = "ocaml_glpk_get_row_prim"
101

    
102
external get_row_dual : lp -> int -> float = "ocaml_glpk_get_row_dual"
103

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

    
129
external get_num_rows : lp -> int = "ocaml_glpk_get_num_rows"
130

    
131
external get_num_cols : lp -> int = "ocaml_glpk_get_num_cols"
132

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

    
142
external scale_problem : lp -> unit = "ocaml_glpk_scale_problem"
143

    
144
external unscale_problem : lp -> unit = "ocaml_glpk_unscale_problem"
145

    
146
external interior : lp -> unit = "ocaml_glpk_interior"
147

    
148
external set_col_kind : lp -> int -> var_kind -> unit = "ocaml_glpk_set_col_kind"
149

    
150
external warm_up : lp -> unit = "ocaml_glpk_warm_up"
151

    
152
(*
153
external _set_message_level : lp -> int -> unit = "ocaml_glpk_set_message_level"
154

    
155
let set_message_level lp n =
156
    if (n < 0 && n > 3) then
157
        raise (Invalid_argument "set_message_level");
158
    _set_message_level lp n
159
*)