## 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 |
*) |