home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / bmag / qsort.bas < prev    next >
Encoding:
BASIC Source File  |  1994-04-15  |  1.5 KB  |  54 lines

  1. '─ Area: F-QUICKBASIC ─────────────────────────────────────────────────────────
  2. '  Msg#: 445                                          Date: 12 Apr 94  14:24:05
  3. '  From: Coridon Henshaw                              Read: Yes    Replied: No 
  4. '    To: CHRIS CRANFORD                               Mark:                     
  5. '  Subj: Sorting Routine
  6. '──────────────────────────────────────────────────────────────────────────────
  7. 'Here's a standard QuickSort routine that will sort any string data, including
  8. 'FTN addresses:
  9.  
  10. SUB QSort (Array$(), StartEl, NumEls) STATIC
  11.  
  12.  REDIM QStack(NumEls \ 5 + 10)
  13.  First = StartEl
  14.  Last = StartEl + NumEls - 1
  15.  DO
  16.   DO
  17.    Temp$ = Array$((Last + First) \ 2)
  18.    I = First
  19.    j = Last
  20.    DO
  21.     WHILE Array$(I) < Temp$
  22.      I = I + 1
  23.     WEND
  24.     WHILE Array$(j) > Temp$
  25.      j = j - 1
  26.     WEND
  27.     IF I > j THEN EXIT DO
  28.     IF I < j THEN SWAP Array$(I), Array$(j)
  29.     I = I + 1
  30.     j = j - 1
  31.    LOOP WHILE I <= j
  32.    IF I < Last THEN                      'Done
  33.     QStack(StackPtr) = I              'Push I
  34.     QStack(StackPtr + 1) = Last       'Push Last
  35.     StackPtr = StackPtr + 2
  36.    END IF
  37.    Last = j
  38.   LOOP WHILE First < Last
  39.   IF StackPtr = 0 THEN EXIT DO
  40.   StackPtr = StackPtr - 2
  41.   First = QStack(StackPtr)              'Pop First
  42.   Last = QStack(StackPtr + 1)           'Pop Last
  43.  LOOP
  44.  ERASE QStack                              'delete the stack array
  45.  
  46. END SUB
  47. ===
  48.  
  49. CSBH
  50.  
  51. -!- GEcho 1.00
  52.  ! Origin: Barney (n): Well known purple mutant eggplant from Hell. (1:250/820)
  53.  
  54.