diff Examples/sorter/sort3 @ 0:cfb7c6b24319

Initial revision
author kono
date Thu, 30 Aug 2007 14:57:44 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Examples/sorter/sort3	Thu Aug 30 14:57:44 2007 +0900
@@ -0,0 +1,93 @@
+/* Program to do parallel quicksort.  Ben Moszkowski
+  Initial version written around 29 Apr 84.
+  Subsequent changes made.
+  Updated 7 Feb 85.
+
+  translate to Tokio by S.Kono
+				Sun Aug 31 21:29:10 JST 1986
+				using functor and implicit sync
+  */
+
+/* Support Routines */
+
+'$function' (len(L) = Length :- functor(L,_,Length)).
+
+'$function' (slice(List,From,To) = Slice
+ :- Size<--To-From+1,From=From1,To=To1,
+	(Size < 1, #(Slice = array) ; 
+	#functor(Slice,array,Size),
+	slice(1,List,From1,To1,1,Slice))).
+
+slice(N,List,From,To,_,_) :- N>To,!.
+slice(N,List,From,To,I,Slice) :- N>=From,!,
+    NN = N+1,II = I+1,arg(N,List,E),arg(I,Slice,E),
+    slice(NN,List,From,To,II,Slice).
+slice(N,List,From,To,I,Slice) :-
+    NN = N+1,
+    slice(NN,List,From,To,I,Slice).
+
+'$function' (thof(I,L) = E :- arg(I,L,E)).
+
+fixed_list(Array,Length) :- L <-- Length,
+	#functor(Array,array,L).
+
+'$function' ( (if Cond then Yes else No) = Reply :-
+    if Cond then Yes=Reply else No=Reply).
+
+
+/* Support Routines end */
+
+par_quicksort(L) :- 
+    if len(L) =< 1
+    then empty
+    else 
+	stable(Pivot),
+	(   quick_partition(L,Pivot) &
+	    sort_parts(L,Pivot) ).
+
+quick_partition(L,Pivot) :- 
+	I = 2, Z=1, J = len(L), J1=J+1,skip, 
+	P = thof(1,L),
+	partition(I,J1,P,Z,J,L,Pivot).
+
+partition(K,K,P,I,J,L,Pivot) :- !,@Pivot=I,@I=I,@thof(I,L)=P.
+partition(K,E,P,I,J,L,Pivot) :- thof(K,L) < P,!, II=I+1,
+	@I=I, @thof(I,L) = thof(K,L), KK=K+1,
+	partition(KK,E,P,II,J,L,Pivot).
+partition(K,E,P,I,J,L,Pivot) :- JJ=J-1,
+	@J=J, @thof(J,L) = thof(K,L), KK=K+1,
+	partition(KK,E,P,I,JJ,L,Pivot).
+
+sort_parts(L,Pivot) :- 
+	stable(thof(Pivot,L)),
+	quicksort_process(slice(L,1,       Pivot-1)),
+	quicksort_process(slice(L,Pivot+1, len(L) )).
+quicksort_process(L) :-
+	par_quicksort(L) & stable(L).
+
+monitor(L) :- 
+	fixed_list(Tag_list,len(L)),
+	#tag(1,len(L),L,Tag_list),
+    	#((write('''List='''),write(L),put(" "),
+	   write('''Tag_list='''),write(Tag_list))).
+
+tag(I,J,_,_) :- I>J,!.
+tag(I,K,L,T) :- (if I-1=thof(I,L) then 1 else 0) = thof(I,T),
+	J=I+1,tag(J,K,L,T).
+
+/*  test of quicksort */
+sort_test(Init_vector) :- 
+     %exists L : 
+	stable(Init_vector),
+        fixed_list(L,len(Init_vector)),
+	L=Init_vector,
+	par_quicksort(L),
+%	#write(L).
+	monitor(L).
+
+sort_test1 :- array(2,0,1)=List,sort_test(List).
+
+sort_test2 :-  array(2,4,9,1,0,10,6,8,7,5,3)=List,sort_test(List).
+
+sort_test3 :- array(13,7,5,3,1,9,8,6,2,0,12,11,4,10)=List,sort_test(List).
+