Flexible Quick sort
[Autolink] Menu
/* ------------------------------------------------------------------ */
/* modul : qsort.cmd */
/* project : OS/2-Rexx */
/* date : 20 Dez 1994 21.35.15 */
/* (c)author: Andreas Pohlmann */
/* (see EMail Addresses) */
/* */
/* func/ret : */
/* */
/* use ext. : */
/* */
/* LastDo :10 Nov 1995 19.30.10 ( qsCompFunc ) */
/* ToDo : */
/* */
/* Note : This is a quick sort with a variable compare function */
/* ------------------------------------------------------------------ */
call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
call SysLoadFuncs
/* init test data */
i = 0
atmp.0 = 611
do while ( i < atmp.0 )
i = i+1
atmp.i = random( 0,999,i )
end /* do */
call LineOut , 'Flexible Quicksort test program'
call LineOut , ''
call charout , '*Start Timer... '
nTime = time( 'E' )
call quicksort 1, atmp.0
call LineOut , '*QuickSort elapsed:' ( time( 'E' )-nTime )
/*
call ShowArray 1, atmp.0
*/
/* Test sorted Array */
call CharOut, 'Testing the result '
ErrorFound = 0
do i=1 to atmp.0
if i // 10 = 0 then
call CharOut , '.'
j = i+1
if ( atmp.i >> atmp.j ) then /* v2.80 */
do
errorFound = 1
call LineOut , "Error on position" i j
end /* if */
end /* do */
call LineOut , ''
if errorFound = 0 then
call LineOut , 'No errors found.'
else
call LineOut , 'One or more errors found.'
exit
/* ------------------------------------------------------------------ */
/* sample routine to print the contents of the array */
ShowArray: PROCEDURE expose atmp.
parse arg first, last
do i=first to last
call charout , format( atmp.i,4 )
end /* do */
call LineOut, ''
return
/* ------------------------------------------------------------------ */
/* func/ret : qsCompFunc( <a>, <b> ) */
/* ---> like ANSI-C 'strcmp'-Func */
/* ( a < b ) --> -1 */
/* ( a > b ) --> 1 */
/* ( a b ) --> 0 */
/* ( rc*-1 ) for descending order */
/* use ext. : */
/* called from QuickSort */
/* ToDo : */
/* */
/* Note : This is the compare function used by the QuickSort */
/* routine. */
/* ------------------------------------------------------------------ */
qsCompFunc: PROCEDURE
parse arg a, b
select
when ( a << b ) then /* v2.80 */
rc = -1
when ( a >> b ) then /* v2.80 */
rc = 1
otherwise
rc = 0
end /* select */
/* use 'return ( rc*-1 )' for descending order */
return ( rc )
/* ------------------------------------------------------------------ */
/* func/ret : QuickSort <StartPos>, <EndPos> */
/* ---> nix */
/* call QuickSort 1, atmp. */
/* */
/* use ext. : need the func 'qsCompFunc' for comparing two elements */
/* */
/* sort the global Array 'atmp.' recursive, not stable */
/* faster ( ca.3x ) replace the 'qsCompFunc' with direct- */
/* compare-calls */
/* ToDo : Median-of-3 */
/* ------------------------------------------------------------------ */
QuickSort: PROCEDURE EXPOSE atmp.
parse arg top, down
if ( ( down-top ) < 2 ) then
do
/* sort short subarrays, */
/* here only tow elements */
if ( ( down - top ) > 0 ) then
/* if ( atmp.top > atmp.down ) then */ /* fast or */
if ( qsCompFunc( atmp.top, atmp.down ) > 0 ) then /* flexible */
do
tmpval = atmp.top
atmp.top = atmp.down
atmp.down = tmpval
end /* ( qsCompFunc( atmp.top, atmp.down ) > 0 ) */
end
else
do
/* sorting large subarrays */
l = top /* pointer left */
r = down /* pointer right */
m = top + trunc( ( down-top )/2 ) /* pointer median, */
/* better Median-of-3 */
do while ( l<r )
m_val = atmp.m
/* seek from left and right */
/* do while ( atmp.l < m_val ) */ /* fast or */
do while ( qsCompFunc( atmp.l, m_val ) < 0 ) /* fexible */
if ( l < m ) then
l=l+1
else
leave
end /* while ( qsCompFunc( atmp.l, m_val ) < 0 ) */
/* do while ( atmp.r > m_val ) */ /* fast or */
do while ( qsCompFunc( atmp.r, m_val ) > 0 ) /* flexible */
if ( m < r ) then
r=r-1
else
leave
end /* while ( qsCompFunc( atmp.r, m_val ) > 0 ) */
if ( l < r ) then
do
tmpval = atmp.l
atmp.l = atmp.r
atmp.r = tmpval
select
when ( m=r ) then
do
r = r-1
m = l
end /* when ( m=r ) */
when ( m=l ) then
do
l = l+1
m = r
end /* when ( m=l ) */
otherwise
do
l = l+1
r = r-1
end /* otherwise */
end /* select */
end /* if ( ( l < m ) | ( m < r ) ) then do */
end /* do while ( l<r ) */
/* median is on the correct position */
/* start recursion with smallest part */
if ( ( r-top ) < ( down-l ) ) then
do
call quicksort top, m-1
call quicksort m+1, down
end /* do */
else
do
call quicksort m+1, down
call quicksort top, m-1
end /* do */
end /* else sorting large subarrays */
return
[Back: Fast Quick sort]
[Next: Heapsort routine]