1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
type t =
| Eq of string option * Poly.t * float
| Ineq of string option * Poly.t * float
let to_string ?(short = false) c =
let slist lhs rhs =
[Poly.to_string ~short lhs; Poly.to_string ~short @@ Poly.c rhs]
in
match c with
| Eq (Some name, lhs, rhs) ->
name ^ ": " ^ String.concat " = " @@ slist lhs rhs
| Eq (None, lhs, rhs) ->
String.concat " = " @@ slist lhs rhs
| Ineq (Some name, lhs, rhs) ->
name ^ ": " ^ String.concat " <= " @@ slist lhs rhs
| Ineq (None, lhs, rhs) ->
String.concat " <= " @@ slist lhs rhs
let simplify_sides ?(eps = 10. *. epsilon_float) lhs rhs =
let vl, cl = Poly.partition lhs in
let vr, cr = Poly.partition rhs in
let newl = Poly.(vl -- vr) in
let newr = Poly.(cr -- cl) in
(Poly.simplify ~eps newl, Poly.to_float @@ Poly.simplify ~eps newr)
let take_vars = function
| Eq (_, lhs, _) | Ineq (_, lhs, _) ->
Poly.take_vars lhs
let degree = function Eq (_, lhs, _) | Ineq (_, lhs, _) -> Poly.degree lhs
let constant c =
if degree c > 0 then false
else (
( match c with
| Eq (Some n, _, _) | Ineq (Some n, _, _) ->
Printf.printf "constraint %s is constant\n" n
| _ ->
print_endline "a constraint is constant" ) ;
true )
let eq ?(eps = 10. *. epsilon_float) ?(name = "") lhs rhs =
let l, r = simplify_sides ~eps lhs rhs in
if String.length name > 0 then
if Var.validate_name name then Eq (Some name, l, r)
else failwith ("Invalid name for constraint: " ^ name)
else Eq (None, l, r)
let lt ?(eps = 10. *. epsilon_float) ?(name = "") lhs rhs =
let l, r = simplify_sides ~eps lhs rhs in
if String.length name > 0 then
if Var.validate_name name then Ineq (Some name, l, r)
else failwith ("Invalid name for constraint: " ^ name)
else Ineq (None, l, r)
let gt ?(eps = 10. *. epsilon_float) ?(name = "") lhs rhs =
lt ~eps ~name rhs lhs
let ( =~ ) l r = eq l r
let ( <~ ) l r = lt l r
let ( >~ ) l r = gt l r
let lhs = function Eq (_, l, _) | Ineq (_, l, _) -> l
let rhs = function Eq (_, _, r) | Ineq (_, _, r) -> r
let sides = function Eq (_, l, r) | Ineq (_, l, r) -> (l, r)
let name = function
| Eq (Some name, _, _) | Ineq (Some name, _, _) ->
name
| _ ->
""
let is_eq = function Eq _ -> true | Ineq _ -> false
let with_bound name lb ub = function
| Eq (n, l, r) ->
let newl = Poly.with_bound name lb ub l in
Eq (n, newl, r)
| Ineq (n, l, r) ->
let newl = Poly.with_bound name lb ub l in
Ineq (n, newl, r)
let to_integer name = function
| Eq (n, l, r) ->
let newl = Poly.to_integer name l in
Eq (n, newl, r)
| Ineq (n, l, r) ->
let newl = Poly.to_integer name l in
Ineq (n, newl, r)
let to_binary name = function
| Eq (n, l, r) ->
let newl = Poly.to_binary name l in
Eq (n, newl, r)
| Ineq (n, l, r) ->
let newl = Poly.to_binary name l in
Ineq (n, newl, r)