package lp

  1. Overview
  2. Docs

Source file constraint.ml

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
102
103
104
105
106
107
108
109
110
111
type t =
  | Eq of string option * Poly.t * Poly.t
  | Ineq of string option * Poly.t * Poly.t

let to_string ?(short = false) c =
  let p_string = Poly.to_string ~short in
  match c with
  | Eq (Some name, lhs, rhs) ->
      name ^ ": " ^ String.concat " = " [p_string lhs; p_string rhs]
  | Eq (None, lhs, rhs) ->
      String.concat " = " [p_string lhs; p_string rhs]
  | Ineq (Some name, lhs, rhs) ->
      name ^ ": " ^ String.concat " <= " [p_string lhs; p_string rhs]
  | Ineq (None, lhs, rhs) ->
      String.concat " <= " [p_string lhs; p_string rhs]

let simplify_sides ?(eps = 10. *. epsilon_float) lhs rhs =
  let l = Poly.partition lhs in
  let r = Poly.partition rhs in
  let newl = Poly.(fst l -- fst r) in
  let newr = Poly.(snd r -- snd l) in
  (Poly.simplify ~eps newl, Poly.simplify ~eps newr)

let simplify ?(eps = 10. *. epsilon_float) = function
  | Eq (name, lhs, rhs) ->
      let s = simplify_sides ~eps lhs rhs in
      Eq (name, fst s, snd s)
  | Ineq (name, lhs, rhs) ->
      let s = simplify_sides ~eps lhs rhs in
      Ineq (name, fst s, snd s)

let take_vars = function
  | Eq (_, lhs, rhs) | Ineq (_, lhs, rhs) ->
      Poly.take_vars lhs @ Poly.take_vars rhs

let degree = function
  | Eq (_, lhs, rhs) | Ineq (_, lhs, rhs) ->
      max (Poly.degree lhs) (Poly.degree rhs)

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 s = simplify_sides ~eps lhs rhs in
  if String.length name > 0 then
    if Var.validate_name name then Eq (Some name, fst s, snd s)
    else failwith ("Invalid name for constraint: " ^ name)
  else Eq (None, fst s, snd s)

let lt ?(eps = 10. *. epsilon_float) ?(name = "") lhs rhs =
  let s = simplify_sides ~eps lhs rhs in
  if String.length name > 0 then
    if Var.validate_name name then Ineq (Some name, fst s, snd s)
    else failwith ("Invalid name for constraint: " ^ name)
  else Ineq (None, fst s, snd s)

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 name = function
  | Eq (Some name, _, _) | Ineq (Some name, _, _) ->
      name
  | _ ->
      ""

let trans_bound name lb ub = function
  | Eq (n, l, r) ->
      let newl = Poly.trans_bound name lb ub l in
      let newr = Poly.trans_bound name lb ub r in
      Eq (n, newl, newr)
  | Ineq (n, l, r) ->
      let newl = Poly.trans_bound name lb ub l in
      let newr = Poly.trans_bound name lb ub r in
      Ineq (n, newl, newr)

let to_integer name = function
  | Eq (n, l, r) ->
      let newl = Poly.to_integer name l in
      let newr = Poly.to_integer name r in
      Eq (n, newl, newr)
  | Ineq (n, l, r) ->
      let newl = Poly.to_integer name l in
      let newr = Poly.to_integer name r in
      Ineq (n, newl, newr)

let to_binary name = function
  | Eq (n, l, r) ->
      let newl = Poly.to_binary name l in
      let newr = Poly.to_binary name r in
      Eq (n, newl, newr)
  | Ineq (n, l, r) ->
      let newl = Poly.to_binary name l in
      let newr = Poly.to_binary name r in
      Ineq (n, newl, newr)