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

[Radu Grigore]

Nice. I'll show you an alternative.

In your solution you write
let chrs = CharSet.map (module StringSet) strs (fun s -> s.[0])
In my solution you write
let chrs = CharSet.of_list (StringSet.map_l strs (fun s -> s.[0]))
It has about the same length.

The disadvantage of my solution is that the type of map_l is weird
StringSet.map_l : StringSet.t -> (string -> 'a) -> 'a list

The advantages are
1. It is possible to implement in O(n), rather than O(n lg n)
2. Works in 3.12.
Somebody should put the linear time [of_list] in the standard library.

Here is a simple, O(n lg n) implementation, similar to yours.

module FunkySet = struct
module type OrderedType = Set.OrderedType
module type S = Set.S
module Make (E : OrderedType) = struct
include Set.Make (E)
let of_list xs = List.fold_right add xs empty
let map_l s f = List.map f (elements s)
end
end

[Radu Grigore]

On Friday, November 2, 2012 2:59:17 PM UTC, Radu Grigore wrote:
> Somebody should put the linear time [of_list] in the standard library.

Actually, that should probably be called [of_sorted_list], to make it clear what it does. If you worry about having a function that requires a sorted list, then note that there is already one in the standard library: List.merge.

[Radu Grigore]

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--