Ajout de Sort.array

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

stdlib/sort.ml

@@ -13,6 +13,8 @@
 
 (* Merging and sorting *)
 
+open Array
+
 let rec merge order l1 l2 =
   match l1 with
     [] -> l2
@@ -39,3 +41,55 @@ let list order l =
     | llist -> mergeall (merge2 llist) in
   mergeall(initlist l)
 
+let swap arr i j =
+  let tmp = unsafe_get arr i in
+  unsafe_set arr i (unsafe_get arr j);
+  unsafe_set arr j tmp
+
+let array order arr =
+  let rec qsort lo hi =
+    if hi <= lo then ()
+    else if hi - lo < 5 then begin
+      (* Use insertion sort *)
+      for i = lo + 1 to hi do
+        let val_i = unsafe_get arr i in
+        if order val_i (unsafe_get arr (i - 1)) then begin
+          unsafe_set arr i (unsafe_get arr (i - 1));
+          let j = ref (i - 1) in
+          while !j >= 1 && order val_i (unsafe_get arr (!j - 1)) do
+            unsafe_set arr !j (unsafe_get arr (!j - 1));
+            decr j
+          done;
+          unsafe_set arr !j val_i
+        end
+      done
+    end else begin
+      let mid = (lo + hi) lsr 1 in
+      (* Select median value from among LO, MID, and HI *)
+      let pivotpos =
+        let vlo = unsafe_get arr lo
+        and vhi = unsafe_get arr hi
+        and vmid = unsafe_get arr mid in
+        if order vlo vmid then
+          if order vmid vhi then mid
+          else if order vlo vhi then hi else lo
+        else
+          if order vhi vmid then mid
+          else if order vhi vlo then hi else lo in
+      swap arr pivotpos hi;
+      let pivot = unsafe_get arr hi in
+      let i = ref lo and j = ref hi in
+      while !i < !j do
+        while !i < hi && order (unsafe_get arr !i) pivot do incr i done;
+        while !j > lo && order pivot (unsafe_get arr !j) do decr j done;
+        if !i < !j then swap arr !i !j
+      done;
+      swap arr !i hi;
+      (* Recurse on larger half first *)
+      if (!i - 1) - lo >= hi - (!i + 1) then begin
+        qsort lo (!i - 1); qsort (!i + 1) hi
+      end else begin
+        qsort (!i + 1) hi; qsort lo (!i - 1)
+      end
+    end in
+  qsort 0 (Array.length arr - 1)

stdlib/sort.mli

@@ -18,6 +18,13 @@ val list : ('a -> 'a -> bool) -> 'a list -> 'a list
            The predicate should return [true] if its first argument is
            less than or equal to its second argument. *)
 
+val array : ('a -> 'a -> bool) -> 'a array -> unit
+        (* Sort an array in increasing order according to an
+           ordering predicate.
+           The predicate should return [true] if its first argument is
+           less than or equal to its second argument.
+           The array is sorted in place. *)
+
 val merge : ('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list
         (* Merge two lists according to the given predicate.
            Assuming the two argument lists are sorted according to the