Source file `axiom.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
112
113
114
115
116
117
118
119
120

(** {1:axiom Axioms} 
   we use a wrap type to denote extremes, ideally this is just a float
   but the challenge is we don't know they final type ahead of time (int, float,
   ast) so we
   prefigure it as we need it for some algorithms e.g djikstra. We assume that

   - {i `Inf} for positive infinity
   - {i `NegInf} for negative infinity
   - {i `Val x} for x which is a realised value
   - {i `Nan} for not a number and a substitute for "null" or least element
*)
 
(** {3:space Space}
    this is an ast mainly used when doing path finding or flow algorithms in
    the graph. It allows you to bring in your own implementation of the edge.
    Example valid structure are `Float` or `Int`.*)
module type Space = sig

  type t
  include Set.OrderedType with type t := t

  val zero : t
  val one  : t

  val add  : t -> t -> t
  val sub  : t -> t -> t

  val min  : t -> t -> t
  val max  : t -> t -> t

  val neg  : t -> t

end

(** wraps a value a for our internal use *)
type +!'a wrap = [`Inf | `NegInf | `Nan | `Val of 'a]

(** compare 2 values, if both are external values the we apply your provided
    compare function through f. example for a float value: 

    {@ocaml[
        let x = Axiom.wcompare (Float.compare) (`Val 0.) (`Val 0.) =  0;;
        let y = Axiom.wcompare (Float.compare) (`Inf)    (`Val 0.) =  1;;
        let z = Axiom.wcompare (Float.compare) (`Val 0.) (`Inf)    = -1;;
    ]}

*)
let wcompare f l r = match (l, r) with
    | (`Val l',`Val r')   ->  f l' r'
    | (`Inf,    `Inf)     ->  0
    | (`NegInf, `NegInf)  ->  0
    | (`Nan,    `Nan)     ->  0
    | (`NegInf, `Inf)     -> -1
    | (`NegInf, `Val _)   -> -1
    | (`Val _,  `Inf)     -> -1
    | (`Nan,    `Inf)     -> -1
    | (`Nan,    `NegInf)  -> -1
    | (`Nan,    `Val _)   -> -1
    | (`Inf,    `NegInf)  ->  1
    | (`Val _,  `NegInf)  ->  1
    | (`Inf,    `Val _)   ->  1
    | (`Inf,    `Nan)     ->  1
    | (`NegInf, `Nan)     ->  1
    | (`Val _,  `Nan)     ->  1
;;

(** Apply a function only to internal values, otherwise raise a not found
    exception 

    {@ocaml[
        let x = Axiom.wapply (Float.add) (`Val 1.) (`Val 1.) =  2.;;
        let y = Axiom.wapply (Float.add) (`Inf)    (`Val 0.) =  exception Not_found;;
        let z = Axiom.wapply (Float.add) (`Val 0.) (`Inf)    =  exception Not_found;;
    ]}
*)
let wapply f l = match l with
    | `Val x -> f x
    |  _     -> raise Not_found
;;

(** Similar to `Axiom.wapply` but returns a left or right value if no value is
    present 

    {@ocaml[
        let x = Axiom.wbind (Float.add) (`Val 1.) (`Val 1.) =  2.;;
        let y = Axiom.wbind (Float.add) (`Inf)    (`Val 0.) =  `Inf;;
        let z = Axiom.wbind (Float.add) (`Val 0.) (`Inf)    =  `Inf;;
    ]}
*)
let wbind f l r = match (l, r) with
    | (`Val l', `Val r') -> (`Val (f l' r'))
    | (x, `Val _) -> x
    | (`Val _, y) -> y
    | (x',      _y') -> x'
;;

(** convert to string after apply (f x) for `Val x if `Val is present *)
let string_of_wrap f v = match v with
    | `Inf     ->  "`Inf"
    | `NegInf  ->  "`NegInf"
    | `Nan     ->  "`Nan"
    | `Val x   ->  Format.sprintf ("`Val %s") (f x)
;;

(** minimum value with compare function f *)
let wmin f l r = if (wcompare f l r) = -1 then l else r
;;

(** maximum value with compare function f *)
let wmax f l r = if (wcompare f l r) =  1 then l else r
;;

(** negates a value *)
let wneg f v = match v with 
    | `Inf     ->  `NegInf
    | `NegInf  ->  `Inf
    | `Nan     ->  `Nan
    | `Val x   ->  `Val (f x)
;;