Re: [Caml-list] Writing the function Set.map using first-class modules and 4.00 inference

[Radu Grigore <radugrigore@gmail.com>]

Just to clarify what I meant, see the attached (hackish) benchmarks and patch.

-- begin benchmarks.ml --
(* Times (in seconds)

1000000 random lists of length 10
  of_list1 9.23
  of_list2 9.80
  S.of_list 10.15 (+3.6% compared to of_list2)

1 random list of length 10000000
  of_list1 Stack_overflow
  of_list2 102.39
  S.of_list 104.15 (+1.8% compared to of_list2)

1000000 sorted lists of length 10
  of_list1 11.14
  of_list2 12.51
  S.of_list 4.53 (-63% compared to of_list2)

1 sorted list of length 10000000
  of_list1 Stack_overflow
  of_list2 71.91
  S.of_list 6.73 (-90% compared to of_list2)

*)
open Printf

module S = Set.Make (struct type t = int let compare = compare end)

let of_list1 xs = List.fold_right S.add xs S.empty
let of_list2 xs = List.fold_left (fun x y -> S.add y x ) S.empty xs

let mk_list n =
  let xs = ref [] in
  for i = n downto 1 do xs := i (*Random.int max_int*) :: !xs done;
  !xs

let time s f xss =
  let a = Sys.time () in
  List.iter (fun xs -> ignore (f xs)) xss;
  let b = Sys.time () in
  printf "%s %.2f\n" s (b -. a)

let _ =
  Random.init 0;
  let n = 1 in
  let xss = ref [] in
  for i = 1 to n do xss := mk_list 10000000 :: !xss done;
(*   time "of_list1" of_list1 !xss; *)
  time "of_list2" of_list2 !xss;
  time "S.of_list" S.of_list !xss
-- end benchmarks.ml --



--begin of_list.patch--
Index: stdlib/moreLabels.mli
===================================================================
--- stdlib/moreLabels.mli	(revision 13061)
+++ stdlib/moreLabels.mli	(working copy)
@@ -155,6 +155,7 @@
       val partition : f:(elt -> bool) -> t -> t * t
       val cardinal : t -> int
       val elements : t -> elt list
+      val of_list : elt list -> t
       val min_elt : t -> elt
       val max_elt : t -> elt
       val choose : t -> elt
Index: stdlib/set.ml
===================================================================
--- stdlib/set.ml	(revision 13061)
+++ stdlib/set.ml	(working copy)
@@ -43,6 +43,7 @@
     val partition: (elt -> bool) -> t -> t * t
     val cardinal: t -> int
     val elements: t -> elt list
+    val of_list: elt list -> t
     val min_elt: t -> elt
     val max_elt: t -> elt
     val choose: t -> elt
@@ -343,6 +344,29 @@
         Empty -> accu
       | Node(l, v, r, _) -> elements_aux (v :: elements_aux accu r) l
 
+    exception Unsorted
+
+    let rec of_sorted_list n xs =
+      if n = 0 then (empty, xs) else begin
+        let l, xs = of_sorted_list (n / 2) xs in
+        let v, xs = (match xs with v :: xs -> v, xs | [] -> assert false) in
+        let r, xs = of_sorted_list (n - n / 2 - 1) xs in
+        (create l v r, xs)
+      end
+
+    let of_list = function
+        [] -> empty
+      | (x :: xs) as ys -> begin
+          let rec len n x = function
+              [] -> n
+            | z :: zs ->
+                if Ord.compare x z < 0
+                then len (n + 1) z zs
+                else raise Unsorted in
+          try let n = len 1 x xs in let set, _ = of_sorted_list n ys in set
+          with Unsorted -> List.fold_left (fun t elt -> add elt t) empty ys
+        end
+
     let elements s =
       elements_aux [] s
 
Index: stdlib/set.mli
===================================================================
--- stdlib/set.mli	(revision 13061)
+++ stdlib/set.mli	(working copy)
@@ -121,6 +121,9 @@
        to the ordering [Ord.compare], where [Ord] is the argument
        given to {!Set.Make}. *)
 
+    val of_list : elt list -> t
+    (** Makes a set out of a list. *)
+
     val min_elt: t -> elt
     (** Return the smallest element of the given set
        (with respect to the [Ord.compare] ordering), or raise
--end of_list.patch--