🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: fa.caml
Article #92

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

#92
From: Radu Grigore
Date: Mon, 05 Nov 2012 08:05
126 lines
5315 bytes
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--
Technical Details
Message-ID: <9da48315-639b-4de2-a3d5-f86685602425@googlegroups.com>
Path: arc1-ca.pugleaf.net!gf5ni18188417qab.0!nntp.google.com!c7no6839361qap.0!postnews.google.com!glegroupsg2000goo.googlegroups.com!not-for-mail
References: <fa.yP8czrxqEGCABee05wzAlISIlN4@ifi.uio.no> <fa.rve4x46ugIvZs4BizovvjOCeTG0@ifi.uio.no> <fa.i9E+7rAvghoTZ1MXH4g+uL4dpCY@ifi.uio.no> <fa.AX0JYJa8kXsH/YSZ08tuyBc8m+0@ifi.uio.no> <fa.YAoOn2iUcpHbr53eeBfGhPTDvtM@ifi.uio.no>

Show Full Headers
Complete Article Headers
X-Google-Thread: c0fe4b917e,1e67767467266ae5
X-Google-Attributes: gidc0fe4b917e,public,usenet
X-Google-NewGroupId: yes
X-Google-Language: ENGLISH,ASCII-7-bit
Received: by 10.224.189.16 with SMTP id dc16mr5149671qab.0.1352102722392;
        Mon, 05 Nov 2012 00:05:22 -0800 (PST)
Received: by 10.52.76.136 with SMTP id k8mr1165591vdw.13.1352102722367; Mon,
 05 Nov 2012 00:05:22 -0800 (PST)
Path: arc1-ca.pugleaf.net!gf5ni18188417qab.0!nntp.google.com!c7no6839361qap.0!postnews.google.com!glegroupsg2000goo.googlegroups.com!not-for-mail
Newsgroups: fa.caml
Date: Mon, 5 Nov 2012 00:05:22 -0800 (PST)
In-Reply-To: <fa.YAoOn2iUcpHbr53eeBfGhPTDvtM@ifi.uio.no>
Complaints-To: groups-abuse@google.com
Injection-Info: glegroupsg2000goo.googlegroups.com; posting-host=188.221.185.251;
 posting-account=e5mzsQoAAAB7g9y7Bkgam0zJDHRr7bCB
NNTP-Posting-Host: 188.221.185.251
References: <fa.yP8czrxqEGCABee05wzAlISIlN4@ifi.uio.no> <fa.rve4x46ugIvZs4BizovvjOCeTG0@ifi.uio.no>
 <fa.i9E+7rAvghoTZ1MXH4g+uL4dpCY@ifi.uio.no> <fa.AX0JYJa8kXsH/YSZ08tuyBc8m+0@ifi.uio.no>
 <fa.YAoOn2iUcpHbr53eeBfGhPTDvtM@ifi.uio.no>
User-Agent: G2/1.0
MIME-Version: 1.0
Message-ID: <9da48315-639b-4de2-a3d5-f86685602425@googlegroups.com>
Subject: Re: [Caml-list] Writing the function Set.map using first-class
 modules and 4.00 inference
From: Radu Grigore <radugrigore@gmail.com>
Cc: Gabriel Scherer <gabriel.scherer@gmail.com>, Caml List <caml-list@inria.fr>
Injection-Date: Mon, 05 Nov 2012 08:05:22 +0000
Content-Type: text/plain; charset=ISO-8859-1