home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxalgo.zip / TESTALGO / QSort.CMD < prev    next >
OS/2 REXX Batch file  |  1997-08-25  |  6KB  |  181 lines
  1. /* REXX **********************************************/
  2. /*                                                   */
  3. /* Name.......: QSort.CMD                            */
  4. /* Function...: Test Rexx algorithms for the Quick   */
  5. /*              sort                                 */
  6. /*                                                   */
  7. /* Author.....: Janosch R. Kowalczyk                 */
  8. /*              Compuserve: 101572,2160              */
  9. /*                                                   */
  10. /* Create date: 26 May 1996                          */
  11. /* Version....: 1.0                                  */
  12. /*                                                   */
  13. /* Changes....: No                                   */
  14. /*                                                   */
  15. /* Notes......: Start this file with PMREXX to see   */
  16. /*              the output lines.                    */
  17. /*                                                   */
  18. /* Made use of GREED.  26 May 1996 / 12:29:24   JRK  */
  19. /*****************************************************/
  20. Arg _items
  21.  
  22. /*===============(Exception handling)================*/
  23. Signal On Failure Name CLEARUP
  24. Signal On Halt    Name CLEARUP
  25. Signal On Syntax  Name CLEARUP
  26.  
  27. If RxFuncQuery('SysLoadFuncs') Then Do
  28.   Call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  29.   Call SysLoadFuncs
  30. End /* If RxFuncQuery... */
  31.  
  32. Say 
  33. Say Center( "( QUICK SORT )", 80, '*')
  34.  
  35. /*--------------(Set random numbers)-------------*/
  36. Call RandomStem _items
  37.  
  38. /*------------------(Quick Sort)-----------------*/
  39. Say
  40. Say "Following values will be sorted:"
  41. Say
  42. Say SayStem()
  43. Say
  44. Say "Test Quick Sort."
  45. start = Time(r)
  46.  
  47. Call QSort
  48.  
  49. endTime = Time(r)
  50. Say "Quick Sort duration for" stem.0 "digits:" endTime "sec."
  51. Say 
  52. Call LineOut , "Press any key to continue "
  53. Call LineIn
  54.  
  55. /* Following 3 statements can be comment out */
  56. Say "Following values have been sorted:"
  57. Say SayStem()
  58. Say
  59.  
  60. Say "Quick Sort duration for" stem.0 "digits:" endTime "sec."
  61. Say
  62. Call LineOut , "Press any key to exit "
  63. Call LineIn
  64.  
  65. Exit
  66.  
  67. CLEARUP:
  68.   Say
  69.   Say 'GREED001E - Break, Failure or Syntax Error'
  70. Exit
  71.  
  72.  
  73. /*===============(Internal subroutines)===============*/
  74.  
  75. /*====================(Quick sort)====================*/
  76. /* :-D                                              4 */
  77. /* Name.......: QSort                                 */
  78. /*                                                    */
  79. /* Function...: Quick Sort for a stem variable        */
  80. /* Call parm..: No                                    */
  81. /* Returns....: Left-Right span                       */
  82. /*                                                    */
  83. /* Sample call: Call QSort                            */
  84. /*                                                    */
  85. /* Notes......: The elements to sort for must be      */
  86. /*              saved in the stem named so as the     */
  87. /*              stem in this Procedure (in this case  */
  88. /*              "STEM.")                              */
  89. /*              stem.0 must contain the number of     */
  90. /*              elements in stem.                     */
  91. /*                                                    */
  92. /* Changes....: No                                    */
  93. /*                                                    */
  94. /* Author.....: Janosch R. Kowalczyk                  */
  95. /*====================================================*/
  96. QSort: Procedure Expose stem.
  97.  
  98. Arg left, right
  99.  
  100. If left  = '' Then left  = 1
  101. If right = '' Then right = stem.0
  102. If right > left Then Do
  103.   i = left
  104.   j = right
  105.   k = (left+right)%2
  106.   x = stem.k
  107.   Do Until i > j
  108.     Do While stem.i < x; i = i + 1; End
  109.     Do While stem.j > x; j = j - 1; End
  110.     If i <= j Then Do
  111.       xchg = stem.i
  112.       stem.i = stem.j
  113.       stem.j = xchg
  114.       i = i + 1
  115.       j = j - 1
  116.     End
  117.   End
  118.   y = QSort(left,j)
  119.   y = QSort(i,right)
  120. End
  121.  
  122. Return right - left
  123.  
  124.  
  125. /*===========(Fill stem with random numbers)=========*/
  126. /*                                                   */
  127. /* Name.......: RandomStem                           */
  128. /*                                                   */
  129. /* Function...: Fills the stem with random numbers   */
  130. /*                                                   */
  131. /* Call parm..: Number of items  (default = 50)      */
  132. /* Returns....: Nothing (NULL string)                */
  133. /*                                                   */
  134. /* Syntax.....: Call RandomStem number               */
  135. /*                                                   */
  136. /* Changes....: No                                   */
  137. /*                                                   */
  138. /*===================================================*/
  139. RandomStem: Procedure Expose stem.
  140.  
  141. Arg number
  142.  
  143. If DataType(number) \= 'NUM' Then number = 50
  144. stem.0 = number
  145.  
  146. Do i = 1 To number
  147.   stem.i = Random( )
  148. End
  149.  
  150. Return ''
  151.  
  152.  
  153. /*===============( Say stem as one line )============*/
  154. /*                                                   */
  155. /* Name.......: SayStem                              */
  156. /*                                                   */
  157. /* Function...: Says stem as one line with delimiter */
  158. /*                                                   */
  159. /* Call parm..: Delimiter character(s) (default: ',')*/
  160. /*              Prefix for return value (dflt. : '') */
  161. /*                                                   */
  162. /* Returns....: Line with all stems                  */
  163. /*                                                   */
  164. /* Syntax.....: stemLine = SayStem [delim][, prefix] */
  165. /*                                                   */
  166. /* Changes....: No                                   */
  167. /*                                                   */
  168. /*===================================================*/
  169. SayStem: Procedure Expose stem.
  170.  
  171. Parse Arg _delim, _stemLine
  172.  
  173. If _delim = '' Then _delim = ','
  174.  
  175. If stem.0 > 0 Then _stemLine = stem.1
  176.  
  177. Do i = 2 To stem.0
  178.   _stemLine = _stemLine || _delim || stem.i
  179. End /* End Do ... */
  180.  
  181. Return _stemLine