home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxalgo.zip / TESTALGO / ShlSort.CMD < prev    next >
OS/2 REXX Batch file  |  1997-08-25  |  6KB  |  172 lines
  1. /* REXX **********************************************/
  2. /*                                                   */
  3. /* Name.......: ShlSort.CMD                          */
  4. /* Function...: Test Rexx algorithms for the Shell   */
  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( "( SHELL SORT )", 80, '*')
  34.  
  35. /*--------------(Set random numbers)-------------*/
  36. Call RandomStem _items
  37.  
  38. /*------------------(Shell Sort)-----------------*/
  39. Say "Following values will be sorted:"
  40. Say
  41. Say SayStem()
  42. Say
  43. Say "Test Shell Sort."
  44. start = Time(r)
  45.  
  46. Call ShlSort
  47.  
  48. endTime = Time(r)
  49. Say "Shell 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 "Shell 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. /*====================(Shell sort)=====================*/
  75. /* :-)                                               5 */
  76. /* Name.......: ShlSort                                */
  77. /*                                                     */
  78. /* Function...: Shell Sort for a stem variable         */
  79. /* Call parm..: No                                     */
  80. /* Returns....: nothing (NULL string)                  */
  81. /*                                                     */
  82. /* Sample call: Call ShlSort                           */
  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....: No                                     */
  92. /*                                                     */
  93. /* Author.....: Janosch R. Kowalczyk                   */
  94. /*=====================================================*/
  95. ShlSort: Procedure Expose stem.
  96.  
  97. parts = 3        /* adjust to your necessities ( >1 ) */
  98. Do n = 1 To parts
  99.   incr = 2**n - 1
  100.   Do j = incr + 1 To stem.0
  101.     i = j - incr
  102.     xchg = stem.j
  103.     Do While xchg < stem.i & i > 0
  104.       m = i + incr
  105.       stem.m = stem.i
  106.       i = i - incr
  107.     End /* Do While xchg ... */
  108.     m = i + incr
  109.     stem.m = xchg
  110.   End /* Do j = incr ... */
  111. End /* Do n = 1 ... */
  112.  
  113. Return ''
  114.  
  115.  
  116. /*===========(Fill stem with random numbers)=========*/
  117. /*                                                   */
  118. /* Name.......: RandomStem                           */
  119. /*                                                   */
  120. /* Function...: Fills the stem with random numbers   */
  121. /*                                                   */
  122. /* Call parm..: Number of items  (default = 50)      */
  123. /* Returns....: Nothing (NULL string)                */
  124. /*                                                   */
  125. /* Syntax.....: Call RandomStem number               */
  126. /*                                                   */
  127. /* Changes....: No                                   */
  128. /*                                                   */
  129. /*===================================================*/
  130. RandomStem: Procedure Expose stem.
  131.  
  132. Arg number
  133.  
  134. If DataType(number) \= 'NUM' Then number = 50
  135. stem.0 = number
  136.  
  137. Do i = 1 To number
  138.   stem.i = Random( )
  139. End
  140.  
  141. Return ''
  142.  
  143.  
  144. /*===============( Say stem as one line )============*/
  145. /*                                                   */
  146. /* Name.......: SayStem                              */
  147. /*                                                   */
  148. /* Function...: Says stem as one line with delimiter */
  149. /*                                                   */
  150. /* Call parm..: Delimiter character(s) (default: ',')*/
  151. /*              Prefix for return value (dflt. : '') */
  152. /*                                                   */
  153. /* Returns....: Line with all stems                  */
  154. /*                                                   */
  155. /* Syntax.....: stemLine = SayStem [delim][, prefix] */
  156. /*                                                   */
  157. /* Changes....: No                                   */
  158. /*                                                   */
  159. /*===================================================*/
  160. SayStem: Procedure Expose stem.
  161.  
  162. Parse Arg _delim, _stemLine
  163.  
  164. If _delim = '' Then _delim = ','
  165.  
  166. If stem.0 > 0 Then _stemLine = stem.1
  167.  
  168. Do i = 2 To stem.0
  169.   _stemLine = _stemLine || _delim || stem.i
  170. End /* End Do ... */
  171.  
  172. Return _stemLine