home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / BAS_SORT.ZIP / RIPLSORT.SUB < prev    next >
Text File  |  1989-07-15  |  6KB  |  114 lines
  1. DECLARE SUB RiplSort (Ar$(), Elements%)
  2.  
  3. ' ********************************************************************************
  4. ' ** Name:    RiplSort                                                          **
  5. ' ** Type:    SubProgram                                                        **
  6. ' ** Lang:    MS-QuickBASIC or BASICA                                           **
  7. ' ** Author:  Mike Welch                                                        **
  8. ' ** Purpose: A really fast BASIC sort                                          **
  9. ' ** History: Mike Shaffer (of Dallas) first introduced me to his               **
  10. ' **          modification of the Mentat sort (ripple sort) by answering        **
  11. ' **          a request for help in creating a fast QB sort.  After finding     **
  12. ' **          a copy of the MNTSORT itself, I made the necessary changes to     **
  13. ' **          make the program truly structured.  (The original contained 15+   **
  14. ' **          GOTO's and line labels).  This sort is the end result of          **
  15. ' **          25 + hours of work.  I think that it will prove to be the         **
  16. ' **          fastest STRUCTURED sort for a BASIC program.  My thanks to        **
  17. ' **          both Mike Shaffer and Richard F. Ashwell III, author of the       **
  18. ' **          MNTSORT (Mentat) sort.  Yes friends, it blows the Qsort away.     **
  19. ' ** Other:   This particular rendition of the ripple sort is Copywrited (C)    **
  20. ' **          <7/1989> for one reason:  I have worked too hard on the algorithim**
  21. ' **          and especially the 'structurization' process to have someone      **
  22. ' **          publish it in a magazine as his own work and receive a fee.       **
  23. ' **          (I'm in college and if anybody needs money it's me).  Otherwise,  **
  24. ' **          This routine is FREE to whomever cares to use it.  As you can     **
  25. ' **          probably tell it is written for Microsoft's (C) QuickBASIC        **
  26. ' **          compiler.  However, with modification it could surely be used     **
  27. ' **          in BASIC(a) as well. I invite your comments and improvements.     **
  28. ' **          Keep the SHAREWARE idea alive by sending comments/improvements.   **
  29. ' ** Coore:   Send comments to:  Mike Welch: PO Box 401011: Dallas, TX 75243.   **
  30. ' ** Finals:  Original author's address (a software company) below:             **
  31. ' **          Mentat Software: Richard F. Ashwell III:  1830 Dover Rd.: Dover   **
  32. ' **          Florida:  33527                                                   **
  33. ' ********************************************************************************
  34. '
  35. '
  36. SUB RiplSort (Ar$(), Elements%) STATIC
  37.        
  38.         ' Dimension array variables and initialize
  39. DIM Plane%(1000), Wave%(1000)
  40. CONST FALSE% = 0, TRUE% = NOT FALSE%
  41. Y% = Elements%
  42.  
  43.         ' Begin the sort routine
  44. DReg% = 1
  45. EReg% = 1
  46. Plane%(DReg%) = 1
  47. Wave%(DReg%) = Y%
  48. AReg% = Y%
  49.  
  50. DO
  51.         DO
  52.                 EndLoop% = TRUE%
  53.                 IF (AReg% - EReg%) < 9 THEN
  54.                         IF (AReg% - EReg%) = 0 THEN
  55.                                 EReg% = Plane%(DReg%)
  56.                                 AReg% = Wave%(DReg%)
  57.                                 DReg% = DReg% - 1
  58.                                 IF DReg% = 0 THEN
  59.                                         ' < Sort ends here       >
  60.                                         ' < so erase the markers >
  61.                                         ERASE Plane%, Wave%
  62.                                         EXIT SUB
  63.                                 ELSE
  64.                                         EndLoop% = FALSE%
  65.                                 END IF
  66.                         END IF
  67.                         IF EndLoop% = TRUE% THEN
  68.                                 FOR BReg% = (EReg% + 1) TO AReg%
  69.                                         FOR CReg% = EReg% TO (BReg% - 1)
  70.                                                 FReg% = BReg% - CReg% + EReg% - 1
  71.                                                 IF NOT Ar$(FReg%) <= Ar$(FReg% + 1) THEN
  72.                                                         SWAP Ar$(FReg%), Ar$(FReg% + 1)
  73.                                                 END IF
  74.                                         NEXT CReg%
  75.                                 NEXT BReg%
  76.                         END IF
  77.                 END IF
  78.         LOOP UNTIL EndLoop% = TRUE%
  79.         BReg% = EReg%
  80.         CReg% = AReg%
  81.  
  82.         DO
  83.                 IF Ar$(BReg%) > Ar$(CReg%) THEN
  84.                         SWAP Ar$(CReg%), Ar$(BReg%)
  85.                         DO
  86.                                 BReg% = BReg% + 1
  87.                                 IF CReg% > BReg% THEN
  88.                                         IF Ar$(CReg%) < Ar$(BReg%) THEN
  89.                                                 SWAP Ar$(CReg%), Ar$(BReg%)
  90.                                                 EXIT DO
  91.                                         END IF
  92.                                 ELSE
  93.                                         EXIT DO
  94.                                 END IF
  95.                         LOOP
  96.                 END IF
  97.                 CReg% = CReg% - 1
  98.         LOOP WHILE CReg% > BReg%
  99.         CReg% = CReg% + 1
  100.         DReg% = DReg% + 1
  101.         IF (BReg% - EReg%) < (AReg% - CReg%) THEN
  102.                 Plane%(DReg%) = CReg%
  103.                 Wave%(DReg%) = AReg%
  104.                 AReg% = BReg%
  105.         ELSE
  106.                 Plane%(DReg%) = EReg%
  107.                 Wave%(DReg%) = BReg%
  108.                 EReg% = CReg%
  109.         END IF
  110. LOOP
  111.  
  112. END SUB
  113.  
  114.