home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxalgo.zip / TESTALGO / NoMult.CMD < prev    next >
OS/2 REXX Batch file  |  1997-08-25  |  5KB  |  153 lines
  1. /* REXX **********************************************/
  2. /*                                                   */
  3. /* Name.......: NoMult.CMD                           */
  4. /* Function...: Test Rexx algorithms for Exclude     */
  5. /*              multiple items from a stem.          */
  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( "( EXCLUDE MULTIPLE ITEMS )", 80, '*')
  34.  
  35. /*--------( Test Exclude duplicate items )-------*/
  36. Drop stem.
  37.  
  38. stem.1 = 2
  39. stem.2 = 3
  40. stem.3 = 3
  41. stem.4 = 3
  42. stem.5 = 6
  43. stem.6 = 6
  44. stem.7 = 6
  45. stem.8 = 6
  46. stem.9 = 7
  47. stem.10= 8
  48. stem.11= 8
  49. stem.12= 8
  50. stem.13= 8
  51. stem.14= 9
  52. stem.15= 9
  53. stem.0 = 15
  54.  
  55. Say 
  56. Say 'Test Exclude multiple items'
  57. Say
  58. Say 'Before:'
  59. Say SayStem()
  60. Say 
  61.  
  62. Call NoMult
  63.  
  64. stem.0 = Queued()
  65. Do i = 1 To stem.0
  66.   Pull stem.i
  67. End
  68. Say 'After:'
  69. Say SayStem()
  70.  
  71. Say
  72. Call LineOut , "Press any key to exit "
  73. Call LineIn
  74.  
  75. Exit
  76.  
  77. CLEARUP:
  78.   Say
  79.   Say 'GREED001E - Break, Failure or Syntax Error'
  80. Exit
  81.  
  82.  
  83.  
  84. /*===============(Internal subroutines)===============*/
  85.  
  86. /*=============( Exclude multiple items )=============*/
  87. /*                                                 11 */
  88. /* Name.......: NoMult                                */
  89. /*                                                    */
  90. /* Function...: Excludes multiple lines from a sorted */
  91. /*              file                                  */
  92. /* Call parm..: Nothing                               */
  93. /* Returns....: Nothing (0). The result will be placed*/
  94. /*              on the stack!                         */
  95. /*                                                    */
  96. /* Syntax.....: Call NoMult / y = NoMult()            */
  97. /*                                                    */
  98. /* Notes......: The elements to exclude must be       */
  99. /*              saved in the stem named so as the     */
  100. /*              stem in this Procedure (in this case  */
  101. /*              "STEM.")                              */
  102. /*              stem.0 must contain the number of     */
  103. /*              elements in stem.                     */
  104. /*              The stem variable must be previously  */
  105. /*              sorted                                */
  106. /*              The result will be placed on the      */
  107. /*              stack!                                */
  108. /*                                                    */
  109. /* Changes....: No                                    */
  110. /*                                                    */
  111. /* Author.....: Janosch R. Kowalczyk                  */
  112. /*====================================================*/
  113. NoMult: Procedure Expose stem.
  114.  
  115. Do i = 1 To stem.0
  116.   Queue stem.i
  117.   Do j = i + 1 while stem.i = stem.j
  118.   End
  119.   i = j - 1
  120. End
  121.  
  122. Return 0
  123.  
  124.  
  125. /*===============( Say stem as one line )============*/
  126. /*                                                   */
  127. /* Name.......: SayStem                              */
  128. /*                                                   */
  129. /* Function...: Says stem as one line with delimiter */
  130. /*                                                   */
  131. /* Call parm..: Delimiter character(s) (default: ',')*/
  132. /*              Prefix for return value (dflt. : '') */
  133. /*                                                   */
  134. /* Returns....: Line with all stems                  */
  135. /*                                                   */
  136. /* Syntax.....: stemLine = SayStem [delim][, prefix] */
  137. /*                                                   */
  138. /* Changes....: No                                   */
  139. /*                                                   */
  140. /*===================================================*/
  141. SayStem: Procedure Expose stem.
  142.  
  143. Parse Arg _delim, _stemLine
  144.  
  145. If _delim = '' Then _delim = ','
  146.  
  147. If stem.0 > 0 Then _stemLine = stem.1
  148.  
  149. Do i = 2 To stem.0
  150.   _stemLine = _stemLine || _delim || stem.i
  151. End /* End Do ... */
  152.  
  153. Return _stemLine