home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rexxalgo.zip / TESTALGO / SqrRoot.CMD < prev    next >
OS/2 REXX Batch file  |  1997-08-25  |  4KB  |  125 lines
  1. /* REXX **********************************************/
  2. /*                                                   */
  3. /* Name.......: SqrRoot.CMD                          */
  4. /* Function...: Test Rexx algorithms for the Square  */
  5. /*              Root Evolution                       */
  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 _digit
  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( "( SQUARE ROOT EVOLUTION )", 80, '*')
  34.  
  35. /*--------------(Test Square Root)---------------*/
  36. If DataType( _digit, 'N' ) = 1 Then
  37.   Say Left("Sqrt("_digit")", 10) "=" SqrRoot(_digit)
  38.  
  39. Call RandomStem
  40.  
  41. Do i = 1 To stem.0
  42.   Say Left("Sqrt("stem.i")", 10) "=" SqrRoot(stem.i)
  43. End
  44.  
  45. Say
  46. Call LineOut , "Press any key to exit "
  47. Call LineIn
  48.  
  49. Exit
  50.  
  51. CLEARUP:
  52.   Say
  53.   Say 'GREED001E - Break, Failure or Syntax Error'
  54. Exit
  55.  
  56.  
  57. /*===============(Internal subroutines)===============*/
  58. /*====================(Square root)====================*/
  59. /* :-)                                               6 */
  60. /* Name.......: SqrRoot                                */
  61. /*                                                     */
  62. /* Function...: Square root evolution for the call     */
  63. /*              parameter                              */
  64. /* Call parms.: Evolution number, precision            */
  65. /* Returns....: Square root                            */
  66. /*                                                     */
  67. /* Syntax.....: sqrt = SqrRoot(number, [precision])    */
  68. /*                                                     */
  69. /* Notes......: precision is the highest possible      */
  70. /*              error for the evaluation.              */
  71. /*              Default Value is 0.00001               */
  72. /*              You are responsible for the valid      */
  73. /*              number value                           */
  74. /*                                                     */
  75. /* Changes....: No                                     */
  76. /*                                                     */
  77. /* Author.....: Janosch R. Kowalczyk                   */
  78. /*=====================================================*/
  79. SqrRoot: Procedure
  80.  
  81. Arg number, precision
  82.  
  83. If Datatype(number) \= 'NUM' Then Return -1
  84. If precision <= 0 | precision > 1 Then precision = 0.000001
  85.  
  86. sqrt = 1
  87.  
  88. Do Until Abs(sqrt_old - sqrt) < precision
  89.   sqrt_old = sqrt
  90.   sqrt = (sqrt_old * sqrt_old + number) / (2 * sqrt_old)
  91. End /* Do Until ... */
  92.  
  93. Return sqrt
  94.  
  95.  
  96.  
  97. /*===========(Fill stem with random numbers)=========*/
  98. /*                                                   */
  99. /* Name.......: RandomStem                           */
  100. /*                                                   */
  101. /* Function...: Fills the stem with random numbers   */
  102. /*                                                   */
  103. /* Call parm..: Number of items  (default = 10)      */
  104. /* Returns....: Nothing (NULL string)                */
  105. /*                                                   */
  106. /* Syntax.....: Call RandomStem number               */
  107. /*                                                   */
  108. /* Changes....: No                                   */
  109. /*                                                   */
  110. /*===================================================*/
  111. RandomStem: Procedure Expose stem.
  112.  
  113. Arg number
  114.  
  115. If DataType(number) \= 'NUM' Then number = 10
  116. stem.0 = number
  117.  
  118. Do i = 1 To number
  119.   stem.i = Random( )
  120. End
  121.  
  122. Return ''
  123.  
  124.  
  125.