home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxalgo.zip / TESTALGO / BiSearch.CMD next >
OS/2 REXX Batch file  |  1997-08-25  |  8KB  |  222 lines
  1. /* REXX **********************************************/
  2. /*                                                   */
  3. /* Name.......: BiSearch.CMD                         */
  4. /* Function...: Test Rexx algorithms for the Binary  */
  5. /*              search                               */
  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( "( BINARY SEARCH )", 80, '*')
  34.  
  35. /*--------------(Set random numbers)-------------*/
  36. _items = RandomStem( _items )
  37. searchValue = stem._items
  38.  
  39. /*------------------(Quick Sort)-----------------*/
  40. Call QSort
  41. Say "Searched Value:" searchValue
  42. Say
  43. Say SayStem()
  44.  
  45. /*----------------(Binary search)----------------*/
  46. startTime = Time(r)
  47.  
  48. found = BiSearch( searchValue )
  49.  
  50. endTime = Time(r)
  51. Say "Search duration for value" searchValue "from" stem.0 "digits:" endTime "sec."
  52. Say "Searched value is the" found"-th value in the stem."  
  53. Say 
  54. Call LineOut , "Press any key to exit "
  55. Call LineIn
  56.  
  57. Exit
  58.  
  59. CLEARUP:
  60.   Say
  61.   Say 'GREED001E - Break, Failure or Syntax Error'
  62. Exit
  63.  
  64.  
  65. /*===============(Internal subroutines)===============*/
  66.  
  67. /*====================(Quick sort)====================*/
  68. /* :-D                                              4 */
  69. /* Name.......: QSort                                 */
  70. /*                                                    */
  71. /* Function...: Quick Sort for a stem variable        */
  72. /* Call parm..: No                                    */
  73. /* Returns....: Left-Right span                       */
  74. /*                                                    */
  75. /* Sample call: Call QSort                            */
  76. /*                                                    */
  77. /* Notes......: The elements to sort for must be      */
  78. /*              saved in the stem named so as the     */
  79. /*              stem in this Procedure (in this case  */
  80. /*              "STEM.")                              */
  81. /*              stem.0 must contain the number of     */
  82. /*              elements in stem.                     */
  83. /*                                                    */
  84. /* Changes....: No                                    */
  85. /*                                                    */
  86. /* Author.....: Janosch R. Kowalczyk                  */
  87. /*====================================================*/
  88. QSort: Procedure Expose stem.
  89.  
  90. Arg left, right
  91.  
  92. If left  = '' Then left  = 1
  93. If right = '' Then right = stem.0
  94. If right > left Then Do
  95.   i = left
  96.   j = right
  97.   k = (left+right)%2
  98.   x = stem.k
  99.   Do Until i > j
  100.     Do While stem.i < x; i = i + 1; End
  101.     Do While stem.j > x; j = j - 1; End
  102.     If i <= j Then Do
  103.       xchg = stem.i
  104.       stem.i = stem.j
  105.       stem.j = xchg
  106.       i = i + 1
  107.       j = j - 1
  108.     End
  109.   End
  110.   y = QSort(left,j)
  111.   y = QSort(i,right)
  112. End
  113.  
  114. Return right - left
  115.  
  116.  
  117. /*==================(Binary search)===================*/
  118. /* :-D                                              1 */
  119. /* Name.......: BiSearch                              */
  120. /*                                                    */
  121. /* Function...: Search a stem variable for a value    */
  122. /* Call parm..: Search value                          */
  123. /* Returns....: 0 if nothing found                    */
  124. /*              index of the found value              */
  125. /* Sample call: found_index = BiSearch(value)         */
  126. /*              If found_index = 0 Then               */
  127. /*                Say 'Value' value 'not found!'      */
  128. /*              Else                                  */
  129. /*                Say stem.found_index                */
  130. /*                                                    */
  131. /* Notes......: The elements to search for must be    */
  132. /*              saved in the stem named so as the     */
  133. /*              stem in this Procedure (in this case  */
  134. /*              "STEM.")                              */
  135. /*              stem.0 must contain the number of     */
  136. /*              elements in stem.                     */
  137. /*              The stem-variable must be in the      */
  138. /*              sorted order                          */
  139. /*                                                    */
  140. /* Changes....: No                                    */
  141. /*                                                    */
  142. /* (C) Copyright Janosch R. Kowalczyk, 1996.          */
  143. /* All rights reserved.                               */
  144. /*====================================================*/
  145. BiSearch: Procedure Expose stem.
  146.  
  147. Parse Arg value             /* Search value            */
  148.  
  149. found  = 0                  /* Index of the found Item */
  150. bottom = 1                  /* Index of the first Item */
  151. top    = stem.0             /* Index of the last Item  */
  152.  
  153. Do While found = 0 & top >= bottom
  154.   mean = (bottom + top) % 2
  155.   If value = stem.mean Then
  156.     found = mean
  157.   Else If value < stem.mean Then
  158.     top = mean - 1
  159.   Else
  160.     bottom = mean + 1
  161. End /* Do While */
  162.  
  163. Return found
  164.  
  165.  
  166. /*===========(Fill stem with random numbers)=========*/
  167. /*                                                   */
  168. /* Name.......: RandomStem                           */
  169. /*                                                   */
  170. /* Function...: Fills the stem with random numbers   */
  171. /*                                                   */
  172. /* Call parm..: Number of items  (default = 50)      */
  173. /* Returns....: Nothing (NULL string)                */
  174. /*                                                   */
  175. /* Syntax.....: Call RandomStem number               */
  176. /*                                                   */
  177. /* Changes....: No                                   */
  178. /*                                                   */
  179. /*===================================================*/
  180. RandomStem: Procedure Expose stem.
  181.  
  182. Arg number
  183.  
  184. If DataType(number) \= 'NUM' Then number = 50
  185. stem.0 = number
  186.  
  187. Do i = 1 To number
  188.   stem.i = Random( )
  189. End
  190.  
  191. Return number
  192.  
  193.  
  194. /*===============( Say stem as one line )============*/
  195. /*                                                   */
  196. /* Name.......: SayStem                              */
  197. /*                                                   */
  198. /* Function...: Says stem as one line with delimiter */
  199. /*                                                   */
  200. /* Call parm..: Delimiter character(s) (default: ',')*/
  201. /*              Prefix for return value (dflt. : '') */
  202. /*                                                   */
  203. /* Returns....: Line with all stems                  */
  204. /*                                                   */
  205. /* Syntax.....: stemLine = SayStem [delim][, prefix] */
  206. /*                                                   */
  207. /* Changes....: No                                   */
  208. /*                                                   */
  209. /*===================================================*/
  210. SayStem: Procedure Expose stem.
  211.  
  212. Parse Arg _delim, _stemLine
  213.  
  214. If _delim = '' Then _delim = ','
  215.  
  216. If stem.0 > 0 Then _stemLine = '(1)' stem.1
  217.  
  218. Do i = 2 To stem.0
  219.   _stemLine = _stemLine || _delim '('i')' stem.i
  220. End /* End Do ... */
  221.  
  222. Return _stemLine