diff --git a/src/core/CCHeap.ml b/src/core/CCHeap.ml index 325dd09c..008646e0 100644 --- a/src/core/CCHeap.ml +++ b/src/core/CCHeap.ml @@ -10,10 +10,11 @@ type 'a ktree = unit -> [ `Nil | `Node of 'a * 'a ktree list ] let[@inline] _iter_map f xs k = xs (fun x -> k (f x)) let rec _gen_iter k g = - begin match g () with + match g () with | None -> () - | Some x -> k x; _gen_iter k g - end + | Some x -> + k x; + _gen_iter k g module type PARTIAL_ORD = sig type t @@ -356,12 +357,10 @@ module Make (E : PARTIAL_ORD) : S with type elt = E.t = struct equal to it. *) let _merge_heap_iter (hs : t iter) : t = let rec cons_and_merge h0 hs weights = - begin match hs with + match hs with | h1 :: hs' when weights land 1 = 0 -> - cons_and_merge (merge h0 h1) hs' (weights lsr 1) - | _ -> - h0 :: hs - end + cons_and_merge (merge h0 h1) hs' (weights lsr 1) + | _ -> h0 :: hs in (* the i-th heap in this list is a merger of 2^{w_i} input heaps, each having gone through w_i merge operations, where the "weights" 2^{w_i} are @@ -371,19 +370,14 @@ module Make (E : PARTIAL_ORD) : S with type elt = E.t = struct input heaps merged so far; adding a heap to the mergers works like binary incrementation: *) let count = ref 0 in - hs begin fun h -> - incr count ; - mergers := cons_and_merge h !mergers !count ; - end ; + hs (fun h -> + incr count; + mergers := cons_and_merge h !mergers !count); List.fold_left merge E !mergers (* To build a heap with n given values, instead of repeated insertions, it is more efficient to do pairwise merging, running in time O(n). *) - let of_iter xs = - xs - |> _iter_map singleton - |> _merge_heap_iter - + let of_iter xs = xs |> _iter_map singleton |> _merge_heap_iter let of_list xs = of_iter (fun k -> List.iter k xs) let of_seq xs = of_iter (fun k -> Seq.iter k xs) let of_gen xs = of_iter (fun k -> _gen_iter k xs) @@ -401,15 +395,12 @@ module Make (E : PARTIAL_ORD) : S with type elt = E.t = struct let of_iter_almost_sorted xs = let sorted_chunk = ref [] in let iter_sorted_heaps k = - xs begin fun x -> - begin match !sorted_chunk with - | (y :: _) as ys when not (E.leq y x) -> - k (_of_list_rev_sorted ys) ; - sorted_chunk := [x] - | ys -> - sorted_chunk := x :: ys - end ; - end ; + xs (fun x -> + match !sorted_chunk with + | y :: _ as ys when not (E.leq y x) -> + k (_of_list_rev_sorted ys); + sorted_chunk := [ x ] + | ys -> sorted_chunk := x :: ys); k (_of_list_rev_sorted !sorted_chunk) in _merge_heap_iter iter_sorted_heaps @@ -420,7 +411,6 @@ module Make (E : PARTIAL_ORD) : S with type elt = E.t = struct let add_iter h xs = merge h (of_iter xs) let add_seq h xs = merge h (of_seq xs) let add_gen h xs = merge h (of_gen xs) - let add_iter_almost_sorted h xs = merge h (of_iter_almost_sorted xs) (** {2 Conversions to sequences} *) @@ -494,19 +484,19 @@ module Make (E : PARTIAL_ORD) : S with type elt = E.t = struct let rec delete_one eq x0 = function | N (_, x, l, r) as h when E.leq x x0 -> - if eq x0 x then - merge l r - else begin - let l' = delete_one eq x0 l in - if CCEqual.physical l' l then - let r' = delete_one eq x0 r in - if CCEqual.physical r' r then - h - else - _make_node x l r' + if eq x0 x then + merge l r + else ( + let l' = delete_one eq x0 l in + if CCEqual.physical l' l then ( + let r' = delete_one eq x0 r in + if CCEqual.physical r' r then + h else - _make_node x l' r - end + _make_node x l r' + ) else + _make_node x l' r + ) | h -> h let delete_all eq x0 h = @@ -524,42 +514,40 @@ module Make (E : PARTIAL_ORD) : S with type elt = E.t = struct much smaller than O(n) if k is asymptotically smaller than n. *) let rec iter_subheaps eq x0 h k = - begin match h with + match h with | N (_, x, l, r) when E.leq x x0 -> - let keep_x = not (eq x0 x) in - let keep_l = iter_subheaps eq x0 l k in - let keep_r = iter_subheaps eq x0 r k in - if keep_x && keep_l && keep_r then - true - else begin - if keep_x then k (singleton x) ; - if keep_l then k l ; - if keep_r then k r ; - false - end + let keep_x = not (eq x0 x) in + let keep_l = iter_subheaps eq x0 l k in + let keep_r = iter_subheaps eq x0 r k in + if keep_x && keep_l && keep_r then + true + else ( + if keep_x then k (singleton x); + if keep_l then k l; + if keep_r then k r; + false + ) | _ -> true - end in _merge_heap_iter (fun k -> if iter_subheaps eq x0 h k then k h) let filter p h = (* similar to [delete_all] *) let rec iter_subheaps p k h = - begin match h with + match h with | E -> true | N (_, x, l, r) -> - let keep_x = p x in - let keep_l = iter_subheaps p k l in - let keep_r = iter_subheaps p k r in - if keep_x && keep_l && keep_r then - true - else begin - if keep_x then k (singleton x) ; - if keep_l then k l ; - if keep_r then k r ; - false - end - end + let keep_x = p x in + let keep_l = iter_subheaps p k l in + let keep_r = iter_subheaps p k r in + if keep_x && keep_l && keep_r then + true + else ( + if keep_x then k (singleton x); + if keep_l then k l; + if keep_r then k r; + false + ) in _merge_heap_iter (fun k -> if iter_subheaps p k h then k h) diff --git a/tests/core/reg/dune b/tests/core/reg/dune index 985274b0..ca764aa2 100644 --- a/tests/core/reg/dune +++ b/tests/core/reg/dune @@ -1,4 +1,3 @@ - (tests (ocamlopt_flags :standard -inline 1000) (names t_reg454) diff --git a/tests/core/t_heap.ml b/tests/core/t_heap.ml index cd47f2f3..4ef288e7 100644 --- a/tests/core/t_heap.ml +++ b/tests/core/t_heap.ml @@ -8,233 +8,232 @@ include T * generated by [QCheck.list]. * QCheck defines this generator under the name [nat] but does not expose it. *) let medium_nat = - Q.make ~print:Q.Print.int ~shrink:Q.Shrink.int ~small:(fun _ -> 1) + Q.make ~print:Q.Print.int ~shrink:Q.Shrink.int + ~small:(fun _ -> 1) (fun st -> - let p = Random.State.float st 1. in - if p < 0.5 then Random.State.int st 10 - else if p < 0.75 then Random.State.int st 100 - else if p < 0.95 then Random.State.int st 1_000 - else Random.State.int st 10_000 - ) + let p = Random.State.float st 1. in + if p < 0.5 then + Random.State.int st 10 + else if p < 0.75 then + Random.State.int st 100 + else if p < 0.95 then + Random.State.int st 1_000 + else + Random.State.int st 10_000) let list_delete_first (x0 : int) (xs : int list) : int list = let rec aux acc xs = - begin match xs with + match xs with | [] -> List.rev acc | x :: xs' when x = x0 -> List.rev_append acc xs' | x :: xs' -> aux (x :: acc) xs' - end in aux [] xs module H = CCHeap.Make (struct type t = int + let leq x y = x <= y end) - ;; t ~name:"of_list, find_min_exn, take_exn" @@ fun () -> - let h = H.of_list [ 5; 4; 3; 4; 1; 42; 0 ] in - assert_equal ~printer:string_of_int 0 (H.find_min_exn h); - let h, x = H.take_exn h in - assert_equal ~printer:string_of_int 0 x; - assert_equal ~printer:string_of_int 1 (H.find_min_exn h); - let h, x = H.take_exn h in - assert_equal ~printer:string_of_int 1 x; - assert_equal ~printer:string_of_int 3 (H.find_min_exn h); - let h, x = H.take_exn h in - assert_equal ~printer:string_of_int 3 x; - assert_equal ~printer:string_of_int 4 (H.find_min_exn h); - let h, x = H.take_exn h in - assert_equal ~printer:string_of_int 4 x; - assert_equal ~printer:string_of_int 4 (H.find_min_exn h); - let h, x = H.take_exn h in - assert_equal ~printer:string_of_int 4 x; - assert_equal ~printer:string_of_int 5 (H.find_min_exn h); - let h, x = H.take_exn h in - assert_equal ~printer:string_of_int 5 x; - assert_equal ~printer:string_of_int 42 (H.find_min_exn h); - let h, x = H.take_exn h in - assert_equal ~printer:string_of_int 42 x; - assert_raises ((=) H.Empty) (fun () -> H.find_min_exn h); - assert_raises ((=) H.Empty) (fun () -> H.take_exn h); - true +let h = H.of_list [ 5; 4; 3; 4; 1; 42; 0 ] in +assert_equal ~printer:string_of_int 0 (H.find_min_exn h); +let h, x = H.take_exn h in +assert_equal ~printer:string_of_int 0 x; +assert_equal ~printer:string_of_int 1 (H.find_min_exn h); +let h, x = H.take_exn h in +assert_equal ~printer:string_of_int 1 x; +assert_equal ~printer:string_of_int 3 (H.find_min_exn h); +let h, x = H.take_exn h in +assert_equal ~printer:string_of_int 3 x; +assert_equal ~printer:string_of_int 4 (H.find_min_exn h); +let h, x = H.take_exn h in +assert_equal ~printer:string_of_int 4 x; +assert_equal ~printer:string_of_int 4 (H.find_min_exn h); +let h, x = H.take_exn h in +assert_equal ~printer:string_of_int 4 x; +assert_equal ~printer:string_of_int 5 (H.find_min_exn h); +let h, x = H.take_exn h in +assert_equal ~printer:string_of_int 5 x; +assert_equal ~printer:string_of_int 42 (H.find_min_exn h); +let h, x = H.take_exn h in +assert_equal ~printer:string_of_int 42 x; +assert_raises (( = ) H.Empty) (fun () -> H.find_min_exn h); +assert_raises (( = ) H.Empty) (fun () -> H.take_exn h); +true ;; -q ~name:"of_list, to_list" - ~count:30 +q ~name:"of_list, to_list" ~count:30 Q.(list medium_nat) (fun l -> - (l |> H.of_list |> H.to_list |> List.sort CCInt.compare) + l |> H.of_list |> H.to_list |> List.sort CCInt.compare = (l |> List.sort CCInt.compare)) ;; -q ~name:"of_list, to_list_sorted" - ~count:30 +q ~name:"of_list, to_list_sorted" ~count:30 Q.(list medium_nat) - (fun l -> - (l |> H.of_list |> H.to_list_sorted) - = (l |> List.sort CCInt.compare)) + (fun l -> l |> H.of_list |> H.to_list_sorted = (l |> List.sort CCInt.compare)) ;; (* The remaining tests assume the correctness of [of_list], [to_list], [to_list_sorted]. *) -q ~name:"size" - ~count:30 +q ~name:"size" ~count:30 Q.(list_of_size Gen.small_nat medium_nat) - (fun l -> - (l |> H.of_list |> H.size) - = (l |> List.length)) + (fun l -> l |> H.of_list |> H.size = (l |> List.length)) ;; q ~name:"insert" Q.(pair medium_nat (list medium_nat)) (fun (x, l) -> - (l |> H.of_list |> H.insert x |> H.to_list_sorted) - = ((x::l) |> List.sort CCInt.compare)) + l |> H.of_list |> H.insert x |> H.to_list_sorted + = (x :: l |> List.sort CCInt.compare)) ;; q ~name:"merge" Q.(pair (list medium_nat) (list medium_nat)) (fun (l1, l2) -> - (H.merge (H.of_list l1) (H.of_list l2) |> H.to_list_sorted) - = ((l1@l2) |> List.sort CCInt.compare)) + H.merge (H.of_list l1) (H.of_list l2) + |> H.to_list_sorted + = (l1 @ l2 |> List.sort CCInt.compare)) ;; q ~name:"add_list" Q.(pair (list medium_nat) (list medium_nat)) (fun (l1, l2) -> - (H.add_list (H.of_list l1) l2 |> H.to_list_sorted) - = ((l1@l2) |> List.sort CCInt.compare)) + H.add_list (H.of_list l1) l2 + |> H.to_list_sorted + = (l1 @ l2 |> List.sort CCInt.compare)) ;; q ~name:"delete_one" Q.(pair medium_nat (list medium_nat)) (fun (x, l) -> - (l |> H.of_list |> H.delete_one (=) x |> H.to_list_sorted) + l |> H.of_list |> H.delete_one ( = ) x |> H.to_list_sorted = (l |> list_delete_first x |> List.sort CCInt.compare)) ;; q ~name:"delete_all" Q.(pair medium_nat (list medium_nat)) (fun (x, l) -> - (l |> H.of_list |> H.delete_all (=) x |> H.to_list_sorted) - = (l |> List.filter ((<>) x) |> List.sort CCInt.compare)) + l |> H.of_list |> H.delete_all ( = ) x |> H.to_list_sorted + = (l |> List.filter (( <> ) x) |> List.sort CCInt.compare)) ;; q ~name:"filter" Q.(list medium_nat) (fun l -> - let p = (fun x -> x mod 2 = 0) in + let p x = x mod 2 = 0 in let l' = l |> H.of_list |> H.filter p |> H.to_list in List.for_all p l' && List.length l' = List.length (List.filter p l)) ;; t ~name:"physical equality" @@ fun () -> - let h = H.of_list [ 5; 4; 3; 4; 1; 42; 0 ] in - assert_bool "physical equality of merge with left empty" - (CCEqual.physical h (H.merge H.empty h)) ; - assert_bool "physical equality of merge with right empty" - (CCEqual.physical h (H.merge h H.empty)) ; - assert_bool "physical equality of delete_one with element lesser than min" - (CCEqual.physical h (H.delete_one (=) (-999) h)) ; - assert_bool "physical equality of delete_one with element between min and max" - (CCEqual.physical h (H.delete_one (=) 2 h)) ; - assert_bool "physical equality of delete_one with element greater than max" - (CCEqual.physical h (H.delete_one (=) 999 h)) ; - assert_bool "physical equality of delete_all with element lesser than min" - (CCEqual.physical h (H.delete_all (=) (-999) h)) ; - assert_bool "physical equality of delete_all with element between min and max" - (CCEqual.physical h (H.delete_all (=) 2 h)) ; - assert_bool "physical equality of delete_all with element greater than max" - (CCEqual.physical h (H.delete_all (=) 999 h)) ; - assert_bool "physical equality of filter" - (CCEqual.physical h (H.filter (fun _ -> true) h)) ; - true +let h = H.of_list [ 5; 4; 3; 4; 1; 42; 0 ] in +assert_bool "physical equality of merge with left empty" + (CCEqual.physical h (H.merge H.empty h)); +assert_bool "physical equality of merge with right empty" + (CCEqual.physical h (H.merge h H.empty)); +assert_bool "physical equality of delete_one with element lesser than min" + (CCEqual.physical h (H.delete_one ( = ) (-999) h)); +assert_bool "physical equality of delete_one with element between min and max" + (CCEqual.physical h (H.delete_one ( = ) 2 h)); +assert_bool "physical equality of delete_one with element greater than max" + (CCEqual.physical h (H.delete_one ( = ) 999 h)); +assert_bool "physical equality of delete_all with element lesser than min" + (CCEqual.physical h (H.delete_all ( = ) (-999) h)); +assert_bool "physical equality of delete_all with element between min and max" + (CCEqual.physical h (H.delete_all ( = ) 2 h)); +assert_bool "physical equality of delete_all with element greater than max" + (CCEqual.physical h (H.delete_all ( = ) 999 h)); +assert_bool "physical equality of filter" + (CCEqual.physical h (H.filter (fun _ -> true) h)); +true ;; q ~name:"fold" Q.(list_of_size Gen.small_nat medium_nat) - (fun l -> - (l |> H.of_list |> H.fold (+) 0) - = (l |> List.fold_left (+) 0)) + (fun l -> l |> H.of_list |> H.fold ( + ) 0 = (l |> List.fold_left ( + ) 0)) ;; q ~name:"of_iter" Q.(list_of_size Gen.small_nat medium_nat) (fun l -> - (l |> CCList.to_iter |> H.of_iter |> H.to_list_sorted) + l |> CCList.to_iter |> H.of_iter |> H.to_list_sorted = (l |> List.sort CCInt.compare)) ;; q ~name:"of_seq" Q.(list_of_size Gen.small_nat medium_nat) (fun l -> - (l |> CCList.to_seq |> H.of_seq |> H.to_list_sorted) + l |> CCList.to_seq |> H.of_seq |> H.to_list_sorted = (l |> List.sort CCInt.compare)) ;; q ~name:"of_gen" Q.(list_of_size Gen.small_nat medium_nat) (fun l -> - (l |> CCList.to_gen |> H.of_gen |> H.to_list_sorted) + l |> CCList.to_gen |> H.of_gen |> H.to_list_sorted = (l |> List.sort CCInt.compare)) ;; q ~name:"to_iter" Q.(list_of_size Gen.small_nat medium_nat) (fun l -> - (l |> H.of_list |> H.to_iter |> CCList.of_iter |> List.sort CCInt.compare) + l |> H.of_list |> H.to_iter |> CCList.of_iter |> List.sort CCInt.compare = (l |> List.sort CCInt.compare)) ;; q ~name:"to_seq" Q.(list_of_size Gen.small_nat medium_nat) (fun l -> - (l |> H.of_list |> H.to_seq |> CCList.of_seq |> List.sort CCInt.compare) + l |> H.of_list |> H.to_seq |> CCList.of_seq |> List.sort CCInt.compare = (l |> List.sort CCInt.compare)) ;; q ~name:"to_gen" Q.(list_of_size Gen.small_nat medium_nat) (fun l -> - (l |> H.of_list |> H.to_gen |> CCList.of_gen |> List.sort CCInt.compare) + l |> H.of_list |> H.to_gen |> CCList.of_gen |> List.sort CCInt.compare = (l |> List.sort CCInt.compare)) ;; q ~name:"to_iter_sorted" Q.(list_of_size Gen.small_nat medium_nat) (fun l -> - (l |> H.of_list |> H.to_iter_sorted |> Iter.to_list) + l |> H.of_list |> H.to_iter_sorted |> Iter.to_list = (l |> List.sort CCInt.compare)) ;; q ~name:"to_seq_sorted" Q.(list_of_size Gen.small_nat medium_nat) (fun l -> - (l |> H.of_list |> H.to_seq_sorted |> CCList.of_seq |> List.sort CCInt.compare) + l |> H.of_list |> H.to_seq_sorted |> CCList.of_seq + |> List.sort CCInt.compare = (l |> List.sort CCInt.compare)) ;; q ~name:"to_string with default sep" Q.(list_of_size Gen.small_nat medium_nat) (fun l -> - (l |> H.of_list |> H.to_string string_of_int) - = (l |> List.sort CCInt.compare |> List.map string_of_int |> String.concat ",")) + l |> H.of_list |> H.to_string string_of_int + = (l |> List.sort CCInt.compare |> List.map string_of_int + |> String.concat ",")) ;; q ~name:"to_string with space as sep" Q.(list_of_size Gen.small_nat medium_nat) (fun l -> - (l |> H.of_list |> H.to_string ~sep:" " string_of_int) - = (l |> List.sort CCInt.compare |> List.map string_of_int |> String.concat " ")) + l |> H.of_list + |> H.to_string ~sep:" " string_of_int + = (l |> List.sort CCInt.compare |> List.map string_of_int + |> String.concat " ")) ;; q ~name:"Make_from_compare" Q.(list_of_size Gen.small_nat medium_nat) (fun l -> let module H' = Make_from_compare (CCInt) in - (l |> H'.of_list |> H'.to_list_sorted) - = (l |> List.sort CCInt.compare)) + l |> H'.of_list |> H'.to_list_sorted = (l |> List.sort CCInt.compare))