## cool / src / lib / glpk.ml @ df7f16dc

History | View | Annotate | Download (6.94 KB)

1 | df7f16dc | Dominik Paulus | (* |
---|---|---|---|

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