home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxalgo.zip / TESTALGO / BubSort.CMD < prev    next >
OS/2 REXX Batch file  |  1997-08-25  |  6KB  |  174 lines
  1. /* REXX **********************************************/
  2. /*                                                   */
  3. /* Name.......: BubSort.CMD                          */
  4. /* Function...: Test Rexx algorithms for the Bubble  */
  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. _items = 200
  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( "( BUBBLE SORT )", 80, '*')
  34.  
  35. /*--------------(Set random numbers)-------------*/
  36. Call RandomStem _items
  37.  
  38. /*-----------------(Bubble Sort)-----------------*/
  39. Say "Following values will be sorted:"
  40. Say
  41. Say SayStem()
  42. Say
  43. Say "Test Bubble Sort."
  44. start = Time(r)
  45.  
  46. Call BubSort
  47.  
  48. endTime = Time(r)
  49. Say "Sort duration for" stem.0 "digits:" endTime "sec."
  50. Say
  51. Call LineOut , "Press any key to continue "
  52. Call LineIn
  53.  
  54. /* Following 3 statements can be comment out */
  55. Say "Following values have been sorted:"
  56. Say SayStem()
  57. Say
  58.  
  59. Say "Sort duration for" stem.0 "digits:" endTime "sec."
  60. Say
  61. Call LineOut , "Press any key to exit "
  62. Call LineIn
  63.  
  64. Exit
  65.  
  66. CLEARUP:
  67.   Say
  68.   Say 'GREED001E - Break, Failure or Syntax Error'
  69. Exit
  70.  
  71.  
  72. /*===============(Internal subroutines)==============*/
  73.  
  74. /*===================(Bubble sort)===================*/
  75. /* :-I                                               */
  76. /* Name.......: BubSort                              */
  77. /*                                                   */
  78. /* Function...: Bubble Sort for a stem variable      */
  79. /* Call parm..: No                                   */
  80. /* Returns....: nothing (NULL string)                */
  81. /*                                                   */
  82. /* Sample call: Call BubSort                         */
  83. /*                                                   */
  84. /* Notes......: The elements to sort for must be     */
  85. /*              saved in the stem named so as the    */
  86. /*              stem in this Procedure (in this case */
  87. /*              "STEM.")                             */
  88. /*              stem.0 must contain the number of    */
  89. /*              elements in stem.                    */
  90. /*                                                   */
  91. /* Changes....: Mon, 25 Aug 1997                     */
  92. /*               Until flip_flop = 1 was replaced by */
  93. /*               Until flip_flop (thanks to Joe,     */
  94. /*               INTERNET:hunter@mhv.net)            */
  95. /*                                                   */
  96. /* Author.....: Janosch R. Kowalczyk                 */
  97. /*===================================================*/
  98.  
  99. BubSort: Procedure Expose stem.
  100.  
  101. /*------------(Bubble Sort for the Stem)-------------*/
  102. Do i = stem.0 To 1 By -1 Until flip_flop
  103.   flip_flop = 1
  104.   Do j = 2 To i
  105.     m = j - 1
  106.     If stem.m > stem.j Then Do
  107.       xchg   = stem.m
  108.       stem.m = stem.j
  109.       stem.j = xchg
  110.       flip_flop = 0
  111.     End /* If stem.m ... */
  112.   End /* Do j = 2 ...    */
  113. End /* Do i = stem.0 ... */
  114.  
  115. Return ''
  116.  
  117.  
  118. /*===========(Fill stem with random numbers)=========*/
  119. /*                                                   */
  120. /* Name.......: RandomStem                           */
  121. /*                                                   */
  122. /* Function...: Fills the stem with random numbers   */
  123. /*                                                   */
  124. /* Call parm..: Number of items  (default = 50)      */
  125. /* Returns....: Nothing (NULL string)                */
  126. /*                                                   */
  127. /* Syntax.....: Call RandomStem number               */
  128. /*                                                   */
  129. /* Changes....: No                                   */
  130. /*                                                   */
  131. /*===================================================*/
  132. RandomStem: Procedure Expose stem.
  133.  
  134. Arg number
  135.  
  136. If DataType(number) \= 'NUM' Then number = 50
  137. stem.0 = number
  138.  
  139. Do i = 1 To number
  140.   stem.i = Random( )
  141. End
  142.  
  143. Return ''
  144.  
  145.  
  146. /*===============( Say stem as one line )============*/
  147. /*                                                   */
  148. /* Name.......: SayStem                              */
  149. /*                                                   */
  150. /* Function...: Says stem as one line with delimiter */
  151. /*                                                   */
  152. /* Call parm..: Delimiter character(s) (default: ',')*/
  153. /*              Prefix for return value (dflt. : '') */
  154. /*                                                   */
  155. /* Returns....: Line with all stems                  */
  156. /*                                                   */
  157. /* Syntax.....: stemLine = SayStem [delim][, prefix] */
  158. /*                                                   */
  159. /* Changes....: No                                   */
  160. /*                                                   */
  161. /*===================================================*/
  162. SayStem: Procedure Expose stem.
  163.  
  164. Parse Arg _delim, _stemLine
  165.  
  166. If _delim = '' Then _delim = ','
  167.  
  168. If stem.0 > 0 Then _stemLine = stem.1
  169.  
  170. Do i = 2 To stem.0
  171.   _stemLine = _stemLine || _delim || stem.i
  172. End /* End Do ... */
  173.  
  174. Return _stemLine