Source file binning.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
type spec =
  { iwidth : float;  (** inverse width *)
    origin : float;  (** start of the first cell *)
    truncate_mode : (float * float) option
  }

let regular ~origin ~width ~truncate =
  if width <=. 0.0 then invalid_arg "spec" ;
  (match truncate with
  | Some (l, r) when l >=. r -> invalid_arg "regular"
  | _ -> ()) ;
  { iwidth = 1. /. width; origin; truncate_mode = truncate }

let map_to_bin origin iwidth x =
  let shifted_reduced = floor @@ ((x -. origin) *. iwidth) in
  truncate shifted_reduced
  [@@inline]

let map_to_bin { iwidth; origin; truncate_mode } x =
  match truncate_mode with
  | None -> Some (map_to_bin origin iwidth x)
  | Some (l, r) ->
      if x <. l || x >. r then None else Some (map_to_bin origin iwidth x)

let map_from_bin { iwidth; origin; truncate_mode } index =
  let x = origin +. (float_of_int index /. iwidth) in
  match truncate_mode with
  | None -> Some x
  | Some (l, r) -> if x <. l || x >. r then None else Some x

(* TODO tests *)
let from_measure spec (M { fn; total_mass = _ } : float Fin.Float.mes) :
    int Fin.Float.mes =
  let (Vec.Vec (iter, f)) = fn in
  let bins = Helpers.Int_table.create 100 in
  iter (fun x ->
      match map_to_bin spec x with
      | None -> ()
      | Some bin -> (
          match Helpers.Int_table.find_opt bins bin with
          | None -> Helpers.Int_table.add bins bin (f x)
          | Some count -> Helpers.Int_table.replace bins bin (count +. f x))) ;
  let finfn =
    let iterator f = Helpers.Int_table.iter (fun k _ -> f k) bins in
    Vec.Vec
      ( iterator,
        fun k -> try Helpers.Int_table.find bins k with Not_found -> 0.0 )
  in
  Fin.Float.(measure finfn)

let from_empirical spec (mu : float array) : int Fin.Float.mes =
  let bins = Helpers.Int_table.create 100 in
  Array.iter
    (fun x ->
      match map_to_bin spec x with
      | None -> ()
      | Some bin -> (
          match Helpers.Int_table.find_opt bins bin with
          | None -> Helpers.Int_table.add bins bin 1.0
          | Some count -> Helpers.Int_table.replace bins bin (count +. 1.)))
    mu ;
  let finfn =
    let iterator f = Helpers.Int_table.iter (fun k _ -> f k) bins in
    Vec.Vec
      ( iterator,
        fun k -> try Helpers.Int_table.find bins k with Not_found -> 0.0 )
  in
  Fin.Float.(measure finfn)