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