FB II Compiler

PG PRO

Debugging

Memory

System

Mathematics

Resources

Disk I/O

Windows

Controls

Menus

Mouse

Keyboard

Text

Fonts

Drawing

Sound

Clipboard

Printing

Communication

ASM

Made with FB

MATHEMATICS

Quickly sort numbers


Do anybody have anything that will do for numbers what Tedd's quicksort does for strings?

I need to be able to sort up to 250,000 values from smallest to largest.

Anything that would work quickly for this high amount of numbers would be nice no matter what the setup though. I tried the FB Bubble sort, but it took about 6 years to do 250,000 points. Heck, it took 6 years to do just 50,000 points.

Robert Covington

Bubble sort is one of the worst methods known.
Insertion sort is better, but still hopeless for big tasks (n>100 or so).
Shell's method is vastly better for big tasks.
HeapSort and QuickSort are industrial-strength methods that you will probably wish to explore eventually.

The demo below allows timing comparisons between Insertion and Shell, showing a huge advantage to Shell for n greater than a few hundred.

Use an indexed sort when you are sorting large records that would be slow to copy. An indexed sort swaps index values or pointers in an index array (fast) instead of moving around the original records (slow). The demo below includes an indexed Shell sort (which is of course a little _slower_ than the plain version here, because we are only sorting a simple array whose elements _can_ be copied quickly).

I looked over the sorting routines and added one I found a few years ago, simply called "SORT". I like "SORT" because it is small and fast.

My analysis of the four sort routines:

With 5000 items ( on a 233MHz G3 )
- Sort 25K ms
- ShellShortIndex 28K ms
- ShellSort 20K ms
- InsertSort 901K ms

With 50,000 items
- Sort 339K ms
- ShellShortIndex 490K ms
- ShellSort 336K ms
'====== The SORT code ==========

COMPILE ,_dimmedVarsOnly
DIM gArray&(100000), gIndex&(100000)
END GLOBALS

CLEAR LOCAL
LOCAL FN Sort(n&)
  
  DIM size&                                       '-- size of array
  DIM gap&
  DIM count&
  DIM theItem&
  
  '---------------- do the sorting -----------------------------
  size&=n&
  gap&=size&
  DO
    gap&=INT(gap&\1.3)
    FOR count&=1 TO size&-gap&
      theItem&=count&+gap&
      IF gArray&(count&)>gArray&(theItem&) THEN SWAP gArray&(count&), gArray&(theItem&)
    NEXT count&
  UNTIL gap&=0
END FN

LOCAL FN InsertionSort(n&)
  'Sort gArray&(1:n&) ascending
  'On exit gArray&(1) is smallest, gArray&(n&) is largest
  DIM i&,j&,v&
  LONG IF n&>1
    FOR j&=2 TO n&
      v&=gArray&(j&)
      FOR i&=j&-1 TO 1 STEP -1
        IF gArray&(i&)<=V& THEN GOTO "insskip"
        gArray&(i&+1)=gArray&(i&)
      NEXT i&
      i&=0
      "insskip"
      gArray&(i&+1)=v&
    NEXT j&
  END IF
END FN

LOCAL FN ShellSort(n&)
  'Sort gArray&(1:n&) ascending
  'On exit gArray&(1) is smallest, gArray&(n&) is largest
  'The method for adjusting incr& is recommended by Knuth and Numerical Recipes
  DIM i&,j&,n&,incr&,v&
  LONG IF n&>1
    incr&=1
    DO
      incr&=3*incr&+1
    UNTIL incr&>n&
    DO
      incr&=incr&/3
      FOR i&=incr&+1 TO n&
        v&=gArray&(i&)
        j&=i&
        WHILE gArray&(j&-incr&)>v&
          gArray&(j&)=gArray&(j&-incr&)
          j&=j&-incr&
          IF j&<=INCR& THEN GOTO "skip"
        WEND
        "skip"
        gArray&(j&)=v&
      NEXT i&
    UNTIL incr&<=1
  END IF
END FN

LOCAL FN ShellSortIndex(n&)
  DIM i&,j&,n&,incr&,v&,vIndx&
  'Sort gArray&(gIndex&(1):gIndex&(n&)) ascending
  'On exit gArray&(gIndex&(0)) is smallest, (gIndex&(n&)) is largest
  LONG IF n&>1
    incr&=1
    DO
      incr&=3*incr&+1
    UNTIL incr&>n&
    DO
      incr&=incr&/3
      FOR i&=incr&+1 TO n&
        vIndx&=gIndex&(i&)
        v&=gArray&(vIndx&)
        j&=i&
        WHILE gArray&(gIndex&(j&-incr&))>v&
          gIndex&(j&)=gIndex&(j&-incr&)
          j&=j&-incr&
          IF j&<=INCR& THEN GOTO "iskip"
        WEND
        "iskip"
        gIndex&(j&)=vIndx&
      NEXT i&
    UNTIL incr&<=1
  END IF
END FN

LOCAL FN FillArrays(n&)
  DIM i&
  FOR i&=1 TO n&
    gArray&(i&)=RND(n&)
    gIndex&(i&)=i&
  NEXT
END FN

LONG FN MicroSeconds&
  ` dc.w $A193
END FN

LOCAL FN PrintArray(n&,indx)
  DIM i&
  FOR i&=1 TO n&
    LONG IF indx
      PRINT gArray&(gIndex&(i&))
    XELSE
      PRINT gArray&(i&)
    END IF
  NEXT
END FN

WINDOW 1,,(0,0)-(500,440)
DIM MS&,n&,indx, a$
n&=50000                                          ' try values up to 10000=
0
FN FillArrays(n&)
MS&=FN MicroSeconds&

'FN ShellSortIndex(n&): indx=_zTrue                ' uncomment..
'FN ShellSort(n&): indx=_false                     '..one of these..
'FN InsertionSort(n&): indx=_false                 '..these --- 
FN Sort(n&): indx=_false                          ' --- four.

MS&=FN MicroSeconds&-MS&
a$=USING"###,###,###,###";MS&
PRINT %(100,50) a$" microseconds    (click to continue)"
FN PrintArray(20,indx)
DO: UNTIL FN BUTTON
Robert Purves

Robert, don't know how fast it will be for your 250,000... but it's a comb sort. Notice that I use it to sort different arrays.
CLEAR LOCAL MODE
LOCAL FN combSortScores (@arrayPtr&,maxElems&,entNum%(_maxElements))
  XREF arrayPtr%(_maxElements)
  gap& = maxElems&
  DO
    gap& = INT (gap& / 1.3)
    IF gap& < 1 THEN gap& = 1
    switch& = 0
    FOR count& = 0 TO maxElems& - gap&
      testElem& = count& + gap&
      LONG IF arrayPtr% (count&) < arrayPtr% (testElem&)
        SWAP arrayPtr% (count&), arrayPtr% (testElem&)
        SWAP entNum%(count&), entNum%(testElem&)
        INC (switch&)
      END IF
    NEXT count&
  UNTIL switch& = 0 AND gap& = 1
END FN

LOCAL FN doSomething
  'blah, blah, blah
  FN combSortScores (transNonQualScr%(0),finalSeed%,transNonQualEnt%(0))
END FN

LOCAL FN doingSomethingElse
  'more blah, blah, blah
  FN combSortScores (gSAryScores%(0),scoresElem%,gSAryEntNum%(0))
END FN

LOCAL FN doingMoreStuff
  'blah, blah, blah
  FN combSortScores (shiftScore%(0),y,shiftBwlr%(0))
END FN
Al Boyd

Try the following: It will sort numbers in the STR# resource, but you should be able to alter it to sort arrays and it should be quick. If you do get it to sort arrays, please provide me with a copy.
'==========================
'-------------------  sort numbers ----------------------------
'==========================
' This sorts the items in the STR# source numerically.

LOCAL FN sortNumberRes(theID)
  DIM err,OSErr,elemCnt,ptr&,l,resHndl&
  DIM pLoop,gap,switch,loop
  DIM test,theSize&,newRes&,refill
  XREF @sHndl&(32000)
  
  err        = _zTrue
  resHndl&   = FN GETRESOURCE(_"STR#",theID)
  
  LONG IF resHndl&
    theSize& = FN GETHANDLESIZE(resHndl&)
    LONG IF theSize&
      OSErr    = FN HLOCK(resHndl&)
      elemCnt  = {[resHndl&]}
      LONG IF elemCnt > 1
        sHndl& = FN NEWHANDLE _clear((elemCnt + 1)*4)
        ptr&   = [resHndl&] + 2
        FOR pLoop = 1 TO elemCnt
          sHndl&(pLoop) = ptr&
          ptr& = ptr& + PEEK(ptr&) + 1
        NEXT pLoop
        '-----------------------------------
        gap         = elemCnt
        DO
          gap      = gap/1.3
          IF gap < 1 THEN gap = 1
          switch   = _false
          FOR loop = 1 TO elemCnt - gap
            test  = loop + gap
            LONG IF VAL(PSTR$(sHndl&(loop))) > VAL(PSTR$(sHndl&(test)))
              SWAP sHndl&(loop),sHndl&(test)
              switch = _zTrue
            END IF
          NEXT loop
        UNTIL switch = _false AND gap = 1
        '-----------------------------------
        newRes&  = FN NEWHANDLE(theSize&)
        LONG IF newRes&
          OSErr = FN HLOCK(newRes&)
          % [newRes&],elemCnt
          ptr& = [newRes&] + 2
          
          FOR refill = 1 TO elemCnt
            l = PEEK(sHndl&(refill)) + 1
            BLOCKMOVE sHndl&(refill),ptr&,l
            ptr& = ptr& + l
          NEXT
          
          BLOCKMOVE [newRes&],[resHndl&],theSize&
          CALL CHANGEDRESOURCE(resHndl&)
          OSErr = FN HUNLOCK(resHndl&)
          OSErr = FN HNOPURGE(resHndl&)
          DEF DISPOSEH(newRes&)
        END IF
        
        DEF DISPOSEH(sHndl&)
      END IF
    END IF
  END IF
END FN
Tedd

Here is a little sort sorting an array: gtempcntr# is how many numbers are being sorted! glatency#() is the array of values being sorted! Hope this helps! Not for sure on 250,000 vals.
LOCAL FN getmedianlatency                         'sort latency
  n = gtempcntr# : i = 0 : j = 0 : k = 0 : s# = 0 : i = n / 2
  DO
    j = i
    DO
      j = j + 1
      k = j - i
      DO
        LONG IF glatency#(k) > glatency#(k + i)
                  s# = glatency#(k) : glatency#(k) = glatency#(k + i)
                  glatency#(k + i) = s# : k = k - i
        XELSE
                  k = 0
        END IF
      UNTIL k <= 0
    UNTIL j = n
    i = i / 2
  UNTIL i <= 0
'whats the middle median value
'  LONG IF USR EVEN(gtempcntr#) - gtempcntr# = 0
'    gmedlatency# = (glatency#(gtempcntr#/2) +
'    glatency#((gtempcntr#/2)+1))/2
'  XELSE
'    gmedlatency# = glatency#(INT((gtempcntr#/2)+1))
'  END IF
END FN
Doug