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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
open Base
type limit = {start: int; stop: int}
type t = Natural of limit | Modified of limit * (int -> int option)
type elt = int
let no_common_area_msg = "There is no common area between the two ranges."
let get_limit_from = function Modified (r, _) -> r | Natural r -> r
let implode f p =
let r = get_limit_from p in
f r.start r.stop
let from start stop = Natural {start= min start stop; stop= max start stop}
let filter f = function
| Natural r ->
Modified (r, fun n -> Option.some_if (f n) n)
| Modified (r, f_prev) ->
Modified (r, Fn.compose (Option.filter ~f) f_prev)
let is_natural = function Natural _ -> true | Modified _ -> false
let reset r = Natural (get_limit_from r)
let rec fold_by_loop r step f acc n =
if n > r.stop then acc
else if n = r.stop then f acc n
else fold_by_loop r step f (f acc n) (min r.stop (n + step))
let fold_by step f acc = function
| Natural r ->
fold_by_loop r step f acc r.start
| Modified (r, f_filter) ->
let f_with_filter acc n =
n |> f_filter |> Option.value_map ~default:acc ~f:(f acc)
in
fold_by_loop r step f_with_filter acc r.start
let rec gen_fold_loop f_test f_next r f acc n =
if f_test n then acc
else gen_fold_loop f_test f_next r f (f acc n) (f_next n)
let fold_loop r f acc n = gen_fold_loop (( < ) r.stop) Int.succ r f acc n
let fold_right_loop r f acc n =
gen_fold_loop (( > ) r.start) Int.pred r f acc n
let fold_right f acc = function
| Natural r ->
fold_right_loop r f acc r.stop
| Modified (r, f_filter) ->
let f_agg acc n =
n |> f_filter |> Option.value_map ~default:acc ~f:(f acc)
in
fold_right_loop r f_agg acc r.stop
let fold f acc = function
| Natural r ->
fold_loop r f acc r.start
| Modified (r, f_filter) ->
let f_agg acc n =
n |> f_filter |> Option.value_map ~default:acc ~f:(f acc)
in
fold_loop r f_agg acc r.start
let to_list = fold (Fn.flip List.cons) []
let equal a b =
match (a, b) with
| Natural ra, Natural rb ->
ra.start = rb.start && ra.stop = rb.stop
| _ -> List.equal Int.( = ) (to_list a) (to_list b)
let rec iter_loop r f n =
if n > r.stop then ()
else (
f n ;
iter_loop r f (Int.succ n) )
let iter f = function
| Natural r ->
iter_loop r f r.start
| Modified (r, f_filter) ->
let f_with_filter n = n |> f_filter |> Option.value_map ~default:() ~f in
iter_loop r f_with_filter r.start
let length = implode (fun start stop -> stop - start)
let split minimal n r =
let big_enough minimal n size = n >= minimal && size > minimal in
let diff = length r in
let pack_size = Float.(of_int diff / of_int n |> round_up |> Int.of_float) in
if not (big_enough minimal pack_size diff) then [r]
else
let f acc n =
match acc with
| Some (next_start, result) ->
Some (Int.succ n, from next_start n :: result)
| None ->
Some (n, [])
in
r |> fold_by pack_size f None |> Option.value_map ~default:[] ~f:snd
let contain e = function
| Natural r ->
r.start <= e && e <= r.stop
| Modified _ as data ->
fold (fun acc n -> n = e || acc) false data
let pair_map f (a, b) = (f a, f b)
let agg_exn f a b = Option.value_exn ~message:no_common_area_msg (f a b)
let gen_agg flow fhigh a b =
let ra, rb = pair_map get_limit_from (a, b) in
if ra.stop < rb.start || rb.stop < ra.start then None
else Some (from (flow ra.start rb.start) (fhigh ra.stop rb.stop))
let cross = gen_agg max min
let cross_exn = agg_exn cross
let join = gen_agg min max
let join_exn = agg_exn join
let map f = function
| Natural r ->
Modified (r, fun n -> Some (f n))
| Modified (r, f_filter) ->
let new_f n = Option.(f_filter n >>= fun n -> f n |> some) in
Modified (r, new_f)
let limit_to_string r = Int.(to_string r.start ^ ":" ^ to_string r.stop)
let export_string r prefix = prefix ^ limit_to_string r
let to_string = function
| Natural r ->
export_string r "Nat:"
| Modified (r, _) ->
export_string r "Mod:"
let of_string s =
Option.value_exn ~message:"Unrecognized string format"
(String.split ~on:':' s |> List.tl)
|> List.map ~f:Int.of_string
|> function [start; stop] -> from start stop | _ -> assert false