6
6
(* todo: could take an incr/decr func in param, to make it generic
7
7
* opti: remember the min/max (optimisation to have intersect biggest x -> x)
8
* opti: avoid all those rev, and avoid the intervise
8
* opti: avoid all those rev, and avoid the intervise
9
9
* (but yes the algo are then more complex :)
10
* opti: balanced set intervalle
10
* opti: balanced set intervalle
13
13
(*****************************************************************************)
14
14
type seti = elt list (* last elements is in first pos, ordered reverse *)
15
15
and elt = Exact of int | Interv of int * int
17
(* invariant= ordered list, no incoherent interv (one elem or zero elem),
17
(* invariant= ordered list, no incoherent interv (one elem or zero elem),
18
18
* merged (intervalle are separated) *)
21
xs +> List.fold_left (fun min e ->
21
xs +> List.fold_left (fun min e ->
24
24
if i <= min then pr2 (sprintf "i = %d, min = %d" i min);
25
25
(* todo: should be even stronger, shoud be i > min+1 *)
34
ignore(aux min_int (List.rev xs));
34
ignore(aux min_int (List.rev xs));
37
let string_of_seti xs =
39
join "," (xs +> List.rev +> map (function
37
let string_of_seti xs =
39
join "," (xs +> List.rev +> map (function
40
40
| (Exact i) -> string_of_int i
41
41
| (Interv (i,j)) -> Printf.sprintf "%d - %d" i j)) ^
47
47
let pack newi j = function
48
48
| [] -> [Interv (newi,j)]
50
50
(Interv (newi, j))::(if newi =|= z then xs else (Exact z)::xs)
51
| (Interv (i', j'))::xs ->
51
| (Interv (i', j'))::xs ->
53
53
then (Interv (i', j))::xs (* merge *)
54
54
else (Interv (newi, j))::(Interv (i', j'))::xs
57
57
(* the only possible merges are when x = i-1, otherwise, the job is done before *)
58
let rec (add2: int -> seti -> seti) = fun x -> function
58
let rec (add2: int -> seti -> seti) = fun x -> function
60
60
| (Exact i)::xs when x > i+1 -> (Exact x)::(Exact i)::xs
61
61
| (Interv (i,j)::xs) when x > j+1 -> (Exact x)::(Interv (i,j))::xs
62
62
| (Interv (i,j)::xs) when x =|= j+1 -> (Interv (i,x))::xs
63
63
| (Exact i)::xs when x =|= i+1 -> (Interv (i,x))::xs
65
65
| (Exact i)::xs when i =|= x -> (Exact i)::xs
66
66
| (Interv (i,j)::xs) when x <= j && x >= i -> (Interv (i,j))::xs
68
68
(* let _ = log "Cache miss" in *)
69
69
let _ = count2 () in
71
| (Exact i)::xs when x =|= i-1 -> pack x i xs
71
| (Exact i)::xs when x =|= i-1 -> pack x i xs
72
72
| (Exact i)::xs when x < i-1 -> (Exact i)::add x xs
74
74
| (Interv (i,j)::xs) when x =|= i-1 -> pack x j xs
75
75
| (Interv (i,j)::xs) when x < i-1 -> (Interv (i,j))::add x xs
76
76
| _ -> raise Impossible
78
and add x y = let _ = count5 () in add2 x y
78
and add x y = let _ = count5 () in add2 x y
81
81
let rec tolist2 = function
83
83
| (Exact i)::xs -> i::tolist2 xs
84
| (Interv (i,j))::xs -> enum i j @ tolist2 xs
84
| (Interv (i,j))::xs -> enum i j @ tolist2 xs
85
85
let rec tolist xs = List.rev (tolist2 xs)
87
87
let rec fromlist = function xs -> List.fold_left (fun a e -> add e a) empty xs
95
95
let exactize2 x y = if x =|= y then Exact x else Interv (x,y)
98
let rec (remove: int -> seti -> seti) = fun x xs ->
98
let rec (remove: int -> seti -> seti) = fun x xs ->
100
100
| [] -> [] (* pb, not in *)
102
102
(match x <=> z with
104
104
| Sup -> xs (* pb, not in *)
105
105
| Inf -> (Exact z)::remove x zs
107
| (Interv (i,j)::zs) ->
107
| (Interv (i,j)::zs) ->
108
108
if x > j then xs (* pb not in *)
110
110
if x >= i && x <= j then
112
112
let _ = assert (j > i) in (* otherwise can lead to construct seti such as [7,6] when removing 6 from [6,6] *)
126
126
let _ = assert_equal (remove 4 [Interv (3, 4)]) [Exact (3);]
127
127
(* let _ = example (try (ignore(remove 6 [Interv (6, 6)] = []); false) with _ -> true) *)
130
130
let rec mem e = function
133
133
(match e <=> x with
136
136
| Inf -> mem e xs
138
| (Interv (i,j)::xs) ->
138
| (Interv (i,j)::xs) ->
139
139
if e > j then false
141
141
if e >= i && e <= j then true
144
let iter f xs = xs +> List.iter
144
let iter f xs = xs +> List.iter
147
147
| Interv (i, j) -> for k = i to j do f k done
150
150
let is_empty xs = xs =*= []
151
151
let choose = function
152
152
| [] -> failwith "not supposed to be called with empty set"
153
153
| (Exact i)::xs -> i
154
154
| (Interv (i,j))::xs -> i
156
156
let elements xs = tolist xs
157
157
let rec cardinal = function
159
159
| (Exact _)::xs -> 1+cardinal xs
160
160
| (Interv (i,j)::xs) -> (j-i) +1 + cardinal xs
162
162
(*****************************************************************************)
163
163
(* TODO: could return corresponding osetb ? *)
164
let rec inter xs ys =
165
let rec aux = fun xs ys ->
164
let rec inter xs ys =
165
let rec aux = fun xs ys ->
166
166
match (xs, ys) with
170
170
(match (x, y) with
171
| (Interv (i1, j1), Interv (i2, j2)) ->
171
| (Interv (i1, j1), Interv (i2, j2)) ->
172
172
(match i1 <=> i2 with
174
174
(match j1 <=> j2 with
175
175
| Equal -> (Interv (i1,j1))::aux xs ys
206
206
(* TODO avoid the rev rev, but aux good ? need order ? *)
207
207
List.rev_map exactize (aux (List.rev_map intervise xs) (List.rev_map intervise ys))
210
let rec aux = fun xs ys ->
210
let rec aux = fun xs ys ->
211
211
match (xs, ys) with
215
215
(match (x, y) with
216
| (Interv (i1, j1), Interv (i2, j2)) ->
216
| (Interv (i1, j1), Interv (i2, j2)) ->
217
217
(match i1 <=> i2 with
219
219
(match j1 <=> j2 with
220
220
| Equal -> (Interv (i1,j1))::aux xs ys
255
255
* not very strong, should return (Interv (1,4)) *)
256
256
(* let _ = Example (union [Interv (1, 4)] [Interv (1, 3)] = ([Exact 4; Interv (1,3)])) *)
259
let rec aux = fun xs ys ->
259
let rec aux = fun xs ys ->
260
260
match (xs, ys) with
264
264
(match (x, y) with
265
| (Interv (i1, j1), Interv (i2, j2)) ->
265
| (Interv (i1, j1), Interv (i2, j2)) ->
266
266
(match i1 <=> i2 with
268
268
(match j1 <=> j2 with
269
269
| Equal -> aux xs ys
327
327
(*****************************************************************************)
328
328
(* if operation return wrong result, then may later have to patch them *)
329
329
let patch1 xs = List.map exactize xs
330
let patch2 xs = xs +> List.map (fun e ->
330
let patch2 xs = xs +> List.map (fun e ->
332
| Interv (i,j) when i > j && i =|= j+1 ->
332
| Interv (i,j) when i > j && i =|= j+1 ->
333
333
let _ = pr2 (sprintf "i = %d, j = %d" i j) in
339
xs +> List.fold_left (fun (min,acc) e ->
339
xs +> List.fold_left (fun (min,acc) e ->
344
344
else (i, (Exact i)::acc)
346
346
(j, (Interv (i,j)::acc))
added
removed
commons/seti.ml
