[m-dev.] For review: additions to array.m

[Ralph Becket]

Assuming this is accepted, I plan to change list__sort and
list__sort_and_remove_dups to use array__sort rather than
list__merge_sort.

Array based quicksorting is substantially less costly in
terms of space(O(n) vs O(n log n)) and informal testing 
shows it to be about 10 times faster in practice.


Estimated hours taken: 3

Added sort and fold functionality to array.m

library/array.m:
	Added array__sort/1, implemented using quicksort.
	Added array__fold[lr]/3.
	Changed array__to_list/1 to use foldr_0/3 (the core of
	array__foldr) since this is shorter and tail recursive.

Index: array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.82
diff -u -r1.82 array.m
--- array.m	2001/01/12 14:08:46	1.82
+++ array.m	2001/01/31 09:55:57
@@ -287,6 +287,31 @@
 :- func array_compare(array(T), array(T)) = comparison_result.
 :- mode array_compare(in, in) = out is det.
 
+	% array__sort(Array) returns a version of Array sorted
+	% into ascending order.
+	%
+:- func array__sort(array(T)) = array(T).
+:- mode array__sort(array_di) = array_uo is det.
+
+:- pragma type_spec(array__sort/1, T = int).
+:- pragma type_spec(array__sort/1, T = string).
+
+	% array__foldl(Fn, Array, X) is equivalent to
+	% 	list__foldl(Fn, array__to_list(Array), X)
+	% but much more efficient.
+	%
+:- func array__foldl(func(T1, T2) = T2, array(T1), T2) = T2.
+:- mode array__foldl(func(in, in) = out is det, array_ui, in) = out is det.
+:- mode array__foldl(func(in, in) = out is det, in, in) = out is det.
+
+	% array__foldr(Fn, Array, X) is equivalent to
+	% 	list__foldr(Fn, array__to_list(Array), X)
+	% but much more efficient.
+	%
+:- func array__foldr(func(T1, T2) = T2, array(T1), T2) = T2.
+:- mode array__foldr(func(in, in) = out is det, array_ui, in) = out is det.
+:- mode array__foldr(func(in, in) = out is det, in, in) = out is det.
+
 
%---------------------------------------------------------------------------
--%
 :- implementation.
 
@@ -967,16 +992,7 @@
 
%---------------------------------------------------------------------------
--%
 
 array__fetch_items(Array, Low, High, List) :-
-        (
-                Low > High
-        ->
-                List = []
-        ;
-                Low1 is Low + 1,
-                array__fetch_items(Array, Low1, High, List0),
-                array__lookup(Array, Low, Item),
-                List = [Item|List0]
-        ).
+	List = foldr_0(func(X, Xs) = [X | Xs], Array, [], Low, High).
 
 
%---------------------------------------------------------------------------
--%
 
@@ -1111,3 +1127,141 @@
 array__elem(Index, Array) = array__lookup(Array, Index).
 
 'array__elem :='(Index, Array, Value) = array__set(Array, Index, Value).
+
+%
----------------------------------------------------------------------------
%
+
+array__sort(A) = qsort_subarray(A, array__min(A), array__max(A)).
+
+%
----------------------------------------------------------------------------
%
+
+    % qsort_subarray(A, Lo, Hi) sorts into ascending order
+    % the elements of array A with indices Lo, Lo + 1, ..., Hi.
+    %
+    % This procedure uses quicksort choosing the pivot as
+    % median of three where candidate pivots have indices
+    % Lo, (Lo + Hi) //2, and Hi.
+    %
+    % NOTE: I tried implementing the partial sort (i.e. into
+    % a totally ordered sequence of unordered subranges of
+    % e.g. 16 elements) and then applying insertion sort in
+    % a single pass, but that was a performance disaster.
+    % Anybody guess why?  This is the method recommended in
+    % Jon Bentley's "Programming Pearls" (Column 10).
+    %
+:- func qsort_subarray(array(T), int, int) = array(T).
+:- mode qsort_subarray(array_di, in, in) = array_uo is det.
+
+:- pragma type_spec(qsort_subarray/3, T = int).
+:- pragma type_spec(qsort_subarray/3, T = string).
+
+qsort_subarray(A0, Lo, Hi) = A :-
+    ( if Lo >= Hi then
+        A     = A0
+      else
+        Mid   = (Lo + Hi) // 2,
+        Pivot = median_of_three(A0 ^ elem(Lo), A0 ^ elem(Mid), A0 ^
elem(Hi)),
+        partition(Pivot, Lo, Hi, I, A0, A1),
+        A2    = qsort_subarray(A1, Lo, I - 1),
+        A     = qsort_subarray(A2, I + 1, Hi)
+    ).
+
+%
----------------------------------------------------------------------------
%
+
+:- func median_of_three(T, T, T) = T.
+
+:- pragma type_spec(median_of_three/3, T = int).
+:- pragma type_spec(median_of_three/3, T = string).
+
+median_of_three(X, Y, Z) =
+    ( if compare((<), X, Y) then
+        (      if compare((<), Y, Z) then Y
+          else if compare((<), X, Z) then Z
+          else                            X
+        )
+      else
+        (      if compare((<), X, Z) then X
+          else if compare((<), Z, Y) then Y
+          else                            Z
+        )
+    ).
+
+%
----------------------------------------------------------------------------
%
+
+    % partition(Pivot, Lo, Hi, I, A0, A) reorders the subarray from
+    % Lo to Hi in A0 into A such that all elements less than Pivot come
+    % before all other elements, returning the index of an instance
+    % of Pivot in I.
+    %
+:- pred partition(T, int, int, int, array(T), array(T)).
+:- mode partition(in, in, in, out, array_di, array_uo) is det.
+
+:- pragma type_spec(partition/6, T = int).
+:- pragma type_spec(partition/6, T = string).
+
+partition(Pivot, Lo, Hi, I, A0, A) :-
+    partition_0(Pivot, Lo, Hi, Lo, I, A0, A).
+
+%
----------------------------------------------------------------------------
%
+
+:- pred partition_0(T, int, int, int, int, array(T), array(T)).
+:- mode partition_0(in, in, in, in, out, array_di, array_uo) is det.
+
+:- pragma type_spec(partition_0/7, T = int).
+:- pragma type_spec(partition_0/7, T = string).
+
+partition_0(Pivot, Lo, Hi, I0, I, A0, A) :-
+    ( if Lo >= Hi then
+        I = I0,
+        A = A0
+      else
+        X = A0 ^ elem(Lo),
+        compare(Result, X, Pivot),
+        (
+            Result = (<),
+            partition_0(Pivot, Lo + 1, Hi, I0, I, A0, A)
+        ;
+            Result = (=),
+            partition_0(Pivot, Lo + 1, Hi, Lo, I, A0, A)
+        ;
+            Result = (>),
+            Y  = A0 ^ elem(Hi),
+            A1 = A0 ^ elem(Hi) := X,
+            A2 = A1 ^ elem(Lo) := Y,
+            partition_0(Pivot, Lo, Hi - 1, I0, I, A2, A)
+        )
+    ).
+
+%
----------------------------------------------------------------------------
%
+
+array__foldl(Fn, A, X) =
+	foldl_0(Fn, A, X, array__min(A), array__max(A)).
+
+%
----------------------------------------------------------------------------
%
+
+:- func foldl_0(func(T1, T2) = T2, array(T1), T2, int, int) = T2.
+:- mode foldl_0(func(in, in) = out is det, array_ui, in, in, in) = out is
det.
+:- mode foldl_0(func(in, in) = out is det, in, in, in, in) = out is det.
+
+foldl_0(Fn, A, X, I, Max) =
+	( if Max < I	then X
+			else foldl_0(Fn, A, Fn(A ^ elem(I), X), I + 1, Max)
+	).
+
+%
----------------------------------------------------------------------------
%
+
+array__foldr(Fn, A, X) =
+	foldr_0(Fn, A, X, array__min(A), array__max(A)).
+
+%
----------------------------------------------------------------------------
%
+
+:- func foldr_0(func(T1, T2) = T2, array(T1), T2, int, int) = T2.
+:- mode foldr_0(func(in, in) = out is det, array_ui, in, in, in) = out is
det.
+:- mode foldr_0(func(in, in) = out is det, in, in, in, in) = out is det.
+
+foldr_0(Fn, A, X, Min, I) =
+	( if I < Min	then X
+			else foldr_0(Fn, A, Fn(A ^ elem(I), X), Min, I - 1)
+	).
+
+%
----------------------------------------------------------------------------
%
+%
----------------------------------------------------------------------------
%


--
Ralph Becket      |      MSR Cambridge      |      rbeck at microsoft.com 
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------