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

[Ralph Becket]

I'd like to check this in before the end of today.

Estimated hours taken: 4

Added sorting, fold and permutation functions/predicates to array.m.

library/array.m:
	Added funcs sort/1, foldl/3, foldr/3.
	Added pred permutation/4.

NEWS:
	Recorded above in changes to library section.

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/02/05 13:04:13
@@ -33,7 +33,7 @@
 
 :- module array.
 :- interface.
-:- import_module list, std_util.
+:- import_module list, std_util, random.
 
 :- type array(T).
 
@@ -287,6 +287,39 @@
 :- 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.
+
+	% 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.
+:- mode array__foldl(func(in, di) = uo is det, array_ui, di) = uo is det.
+:- mode array__foldl(func(in, di) = uo is det, in, di) = uo 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.
+:- mode array__foldr(func(in, di) = uo is det, array_ui, di) = uo is det.
+:- mode array__foldr(func(in, di) = uo is det, in, di) = uo is det.
+
+	% array__permutation(A0, A, RS0, RS) permutes the elements in
+	% A0 given random seed RS0 and returns the permuted array in A
+	% and the next random seed in RS.
+	%
+:- pred array__permutation(array(T), array(T), random__supply,
random__supply).
+:- mode array__permutation(array_di, array_uo, mdi, muo) is det.
+
 
%---------------------------------------------------------------------------
--%
 :- implementation.
 
@@ -967,16 +1000,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 +1135,176 @@
 array__elem(Index, Array) = array__lookup(Array, Index).
 
 'array__elem :='(Index, Array, Value) = array__set(Array, Index, Value).
+
+%
----------------------------------------------------------------------------
%
+
+    % array__sort/1 has type specialised versions for arrays of
+    % ints and strings on the expectation that these constitute
+    % the common case and are hence worth providing a fast-path.
+    %
+    % Experiments indicate that type specialisation improves
+    % array__sort/1 by a factor of 30-40%.
+    %
+    % We randomly permute the input array before sorting to
+    % transform the worst case (sorted or mostly sorted input) to
+    % something that will hopefully never turn up in practice.
+    % This is acceptable since it only requires an O(n) pass
+    % over the input array.
+    %
+:- pragma type_spec(array__sort/1, T = int).
+:- pragma type_spec(array__sort/1, T = string).
+
+% array__sort(A) = qsort_subarray(A, array__min(A), array__max(A)).
+
+array__sort(A) = qsort_subarray(P, Lo, Hi) :-
+	Lo = array__min(A),
+	Hi = array__max(A),
+	random__init(2450987, RS),
+	array__permutation(A, P, RS, _).
+
+%
----------------------------------------------------------------------------
%
+
+array__permutation(A0, A, RS0, RS) :-
+	Lo = array__min(A0),
+	Hi = array__max(A0),
+	Sz = array__size(A0),
+	permutation_2(Lo, Lo, Hi, Sz, A0, A, RS0, RS).
+
+
+
+:- pred permutation_2(int, int, int, int, array(T), array(T),
+		random__supply, random__supply).
+:- mode permutation_2(in, in, in, in, array_di, array_uo, mdi, muo) is det.
+
+permutation_2(I, Lo, Hi, Sz, A0, A, RS0, RS) :-
+	( if I > Hi then
+		A  = A0,
+		RS = RS0
+	  else
+	  	random__random(R, RS0, RS1),
+	  	J   = Lo + (R `rem` Sz),
+		Tmp = A0 ^ elem(J),
+		A1  = ((A0
+				^ elem(J) := A0 ^ elem(I))
+				^ elem(I) := Tmp),
+		permutation_2(I + 1, Lo, Hi, Sz, A1, A, RS1, RS)
+	).
+
+%
----------------------------------------------------------------------------
%
+
+    % 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)),
+        Pivot = A0 ^ elem(Mid),
+        partition(Pivot, Lo, Hi, I, A0, A1),
+        A2    = qsort_subarray(A1, Lo, I - 1),
+        A     = qsort_subarray(A2, I + 1, Hi)
+    ).
+
+%
----------------------------------------------------------------------------
%
+
+    % 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.
+:- mode foldl_0(func(in, di) = uo is det, array_ui, di, in, in) = uo is
det.
+:- mode foldl_0(func(in, di) = uo is det, in, di, in, in) = uo 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.
+:- mode foldr_0(func(in, di) = uo is det, array_ui, di, in, in) = uo is
det.
+:- mode foldr_0(func(in, di) = uo is det, in, di, in, in) = uo 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
--------------------------------------------------------------------------