REXX Tips & Tricks, Version 2.80


Inf-HTML [About][Toc][Index] 0.9b (c) 1995 Peter Childs


Flexible Quick sort





 
/* ------------------------------------------------------------------ */
/* 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

  

Inf-HTML End Run - Successful