changement List.sort; ajout fast_sort et List.merge

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4884 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Author: Damien Doligez

stdlib/array.ml

@@ -144,6 +144,7 @@ let to_list a =
     if i < 0 then res else tolist (i - 1) (unsafe_get a i :: res) in
   tolist (length a - 1) []
 
+(* Cannot use List.length here because the List module depends on Array. *)
 let rec list_length accu = function
   | [] -> accu
   | h::t -> list_length (succ accu) t
@@ -274,3 +275,5 @@ let stable_sort cmp a =
     merge l2 l1 t 0 l2 a 0;
   end;
 ;;
+
+let fast_sort = stable_sort;;

stdlib/array.mli

@@ -192,6 +192,12 @@ val stable_sort : ('a -> 'a -> int) -> 'a array -> unit
    It is usually faster than the current implementation of {!Array.sort}.
 *)
 
+val fast_sort : ('a -> 'a -> int) -> 'a array -> unit
+(** Same as {!Array.sort} or {!Array.stable_sort}, whichever is faster
+    on typical input.
+*)
+
+
 (**/**)
 (** {6 Undocumented functions} *)
 

stdlib/arrayLabels.mli

@@ -178,6 +178,12 @@ val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit
    It is faster than the current implementation of {!ArrayLabels.sort}.
 *)
 
+val fast_sort : cmp:('a -> 'a -> int) -> 'a array -> unit
+(** Same as {!Array.sort} or {!Array.stable_sort}, whichever is faster
+    on typical input.
+*)
+
+
 (**/**)
 
 (** {6 Undocumented functions} *)

stdlib/list.ml

@@ -195,6 +195,101 @@ let rec combine l1 l2 =
 
 (** sorting *)
 
+let rec merge cmp l1 l2 =
+  match l1, l2 with
+  | [], l2 -> l2
+  | l1, [] -> l1
+  | h1 :: t1, h2 :: t2 ->
+      if cmp h1 h2 <= 0
+      then h1 :: merge cmp t1 l2
+      else h2 :: merge cmp l1 t2
+;;
+
+let rec chop k l =
+  if k = 0 then l else begin
+    match l with
+    | x::t -> chop (k-1) t
+    | _ -> assert false
+  end
+;;
+
+let stable_sort cmp l =
+  let rec rev_merge l1 l2 accu =
+    match l1, l2 with
+    | [], l2 -> rev_append l2 accu
+    | l1, [] -> rev_append l1 accu
+    | h1::t1, h2::t2 ->
+        if cmp h1 h2 <= 0
+        then rev_merge t1 l2 (h1::accu)
+        else rev_merge l1 t2 (h2::accu)
+  in
+  let rec rev_merge_rev l1 l2 accu =
+    match l1, l2 with
+    | [], l2 -> rev_append l2 accu
+    | l1, [] -> rev_append l1 accu
+    | h1::t1, h2::t2 ->
+        if cmp h1 h2 > 0
+        then rev_merge_rev t1 l2 (h1::accu)
+        else rev_merge_rev l1 t2 (h2::accu)
+  in
+  let rec sort n l =
+    match n, l with
+    | 2, x1 :: x2 :: _ ->
+       if cmp x1 x2 <= 0 then [x1; x2] else [x2; x1]
+    | 3, x1 :: x2 :: x3 :: _ ->
+       if cmp x1 x2 <= 0 then begin
+         if cmp x2 x3 <= 0 then [x1; x2; x3]
+         else if cmp x1 x3 <= 0 then [x1; x3; x2]
+         else [x3; x1; x2]
+       end else begin
+         if cmp x1 x3 <= 0 then [x2; x1; x3]
+         else if cmp x2 x3 <= 0 then [x2; x3; x1]
+         else [x3; x2; x1]
+       end
+    | n, l ->
+       let n1 = n asr 1 in
+       let n2 = n - n1 in
+       let l2 = chop n1 l in
+       let s1 = rev_sort n1 l in
+       let s2 = rev_sort n2 l2 in
+       rev_merge_rev s1 s2 []
+  and rev_sort n l =
+    match n, l with
+    | 2, x1 :: x2 :: _ ->
+       if cmp x1 x2 > 0 then [x1; x2] else [x2; x1]
+    | 3, x1 :: x2 :: x3 :: _ ->
+       if cmp x1 x2 > 0 then begin
+         if cmp x2 x3 > 0 then [x1; x2; x3]
+         else if cmp x1 x3 > 0 then [x1; x3; x2]
+         else [x3; x1; x2]
+       end else begin
+         if cmp x1 x3 > 0 then [x2; x1; x3]
+         else if cmp x2 x3 > 0 then [x2; x3; x1]
+         else [x3; x2; x1]
+       end
+    | n, l ->
+       let n1 = n asr 1 in
+       let n2 = n - n1 in
+       let l2 = chop n1 l in
+       let s1 = sort n1 l in
+       let s2 = sort n2 l2 in
+       rev_merge s1 s2 []
+  in
+  let len = length l in
+  if len < 2 then l else sort len l
+;;
+
+let sort = stable_sort;;
+let fast_sort = stable_sort;;
+
+(* Note: on a list of length between about 100000 (depending on the minor
+   heap size and the type of the list) and Sys.max_array_size, it is
+   actually faster to use the following, but it might also use more memory
+   because the argument list cannot be deallocated incrementally.
+
+   Also, there seems to be a bug in this code or in the
+   implementation of obj_truncate.
+
 external obj_truncate : 'a array -> int -> unit = "obj_truncate"
 
 let array_to_list_in_place a =
@@ -217,5 +312,4 @@ let stable_sort cmp l =
   Array.stable_sort cmp a;
   array_to_list_in_place a
 ;;
-
-let sort = stable_sort;;
+*)

stdlib/list.mli

@@ -260,3 +260,17 @@ val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
    The current implementation uses Merge Sort. It runs in constant
    heap space and logarithmic stack space.
 *)
+
+val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list
+(** Same as {!List.sort} or {!List.stable_sort}, whichever is faster
+    on typical input. *)
+
+val merge : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
+(** Merge two lists:
+    Assuming that [l1] and [l2] are sorted according to the
+    comparison function [cmp], [merge cmp l1 l2] will return a
+    sorted list containting all the elements of [l1] and [l2].
+    If several elements compare equal, the elements of [l1] will be
+    before the elements of [l2].
+    Not tail-recursive (sum of the lenghts of the arguments).
+*)

stdlib/listLabels.mli

@@ -268,3 +268,16 @@ val stable_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
    heap space and logarithmic stack space.
 *)
 
+val fast_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
+(** Same as {!List.sort} or {!List.stable_sort}, whichever is faster
+    on typical input. *)
+
+val merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
+(** Merge two lists:
+    Assuming that [l1] and [l2] are sorted according to the
+    comparison function [cmp], [merge cmp l1 l2] will return a
+    sorted list containting all the elements of [l1] and [l2].
+    If several elements compare equal, the elements of [l1] will be
+    before the elements of [l2].
+    Not tail-recursive (sum of the lenghts of the arguments).
+*)