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