## 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" |