Mercurial > hg > Applications > Tokio
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). +