home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols200 / vol217 / mathlib.cmd < prev    next >
OS/2 REXX Batch file  |  1986-02-12  |  11KB  |  295 lines
  1. * <<<=======================================================================>>>
  2. *     This program is Copyrighted and the Sole Property of Keith R. Plossl
  3. * 
  4. *            Program Name    : MATHLIB.CMD
  5. *            Author        : Keith R. Plossl
  6. *            Date Written    : February 1984
  7. *
  8. *  <++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
  9. *  <           C O P Y R I G H T E D   S O F T W A R E   N O T I C E        >
  10. *  <           =====================================================        >
  11. *  <  This software is copyrighted under the laws of the United States of   >
  12. *  <  America and all rights are reserved by Keith R. Plossl.  This program >
  13. *  <  may be freely copied for non-commercial use provided the title block, >
  14. *  <  modification history and this notice remain intact.  Copying this     >
  15. *  <  program for Resale or for any other commercial purpose is STRICTLY    >
  16. *  <  FORBIDDEN and subject to federal prosecution.       KRP 2/5/84        >
  17. *  <++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>
  18. *
  19. *                 M O D I F I C A T I O N    H I S T O R Y
  20. *
  21. *      Date            What                Who
  22. *
  23. * <<<=======================================================================>>>
  24. *
  25. * This program is a mathematics function library for DBASE II.  This file
  26. * will need to have the function called by a name to execute the case.
  27. * Load the three character function code in a variable called FUNCTION.
  28. * Load the parameters as required by the function needed and say: DO MATHLIB
  29. *
  30. *                  >>>> ----- W A R N I N G ----- <<<<
  31. *
  32. *  THE FOLLOWING IS LIST OF VARIABLES USED BY THIS LIBRARY.  CONSIDER THEM
  33. *  TO BE RESERVED WORDS OR YOUR VARIABLES WITH THE SAME NAME WILL BE GONE.
  34. *
  35. *         A             PASS    
  36. *        ABSX                POWRX   
  37. *        ATNX                RADIANS 
  38. *        COSX                RD      
  39. *        CSX            RNDX            
  40. *        DELTA               SEED    
  41. *        EXPO                SEPX    
  42. *        EXPX                SINX    
  43. *        FACT                SLOGX   
  44. *        LOGX                SNX
  45. *        LOGO                SQRD    
  46. *        NUMBER              SQRX    
  47. *           NX                  TANX    
  48. *
  49. do case
  50. * <<<=======================================================================>>>
  51. *
  52. *          ----- >>> Absolute Value Function <<< -----
  53. *     -----------------------------------------------------------
  54. *     | Function Call: ABS             Input Parameters: NUMBER |
  55. *     |                    Output Variable: ABSX   |
  56. *     -----------------------------------------------------------
  57. *
  58.     case !(FUNCTION) = 'ABS' .AND. TYPE(NUMBER) <> 'U'
  59.         if NUMBER < 0
  60.             store -1*NUMBER     to ABSX
  61.         endif
  62.         release NUMBER
  63. * <<<=======================================================================>>>
  64. *
  65. *          ----- >>> Random Number Function <<< -----
  66. *     -----------------------------------------------------------
  67. *     | Function Call: RND             Input Parameters: SEED   |
  68. *     |    Default Seed = .375            Output Variable: RNDX   |
  69. *     -----------------------------------------------------------
  70. *
  71.     case !(FUNCTION) =  'RND' .AND. TYPE(SEED) <> 'U'
  72.         if SEED <= 0 .OR. SEED >= 1
  73.             store .375 to SEED
  74.         endif
  75.         store (SEED*9821+.211327)-int(SEED*9821+.211327) to SEED
  76.         store SEED to RNDX
  77. * <<<=======================================================================>>>
  78. *
  79. *           ----- >>> Square Root Function <<< -----
  80. *     -----------------------------------------------------------
  81. *     | Function Call: SQR             Input Parameters: NUMBER |
  82. *     |                    Output Variable: SQRX   |
  83. *     -----------------------------------------------------------
  84. *
  85.     case !(FUNCTION) = 'SQR' .AND. TYPE(NUMBER) <> 'U'
  86.         if NUMBER < 0
  87.             store -1*NUMBER     to NUMBER
  88.         endif
  89.         store 1 to A, SQRX
  90.         store F  to SQRD
  91.         do while .not. SQRD
  92.             store .5*(A + NUMBER/A) to SQRX
  93.             store SQRX-A  to DELTA
  94.             if DELTA < 0
  95.                 store -1*DELTA to DELTA
  96.             endif
  97.             if DELTA < .000001
  98.                 store T  to SQRD
  99.             else
  100.                 store SQRX to A
  101.             endif
  102.         enddo
  103.         release NUMBER, A, SQRD, DELTA
  104.  
  105. * <<<=======================================================================>>>
  106. *
  107. *         ----- >>> Normal Probability Function <<< -----
  108. *
  109. *     It computes the area under the normal curve such that a number
  110. *     of zero yields a 50% or .5000 area.
  111. *     -----------------------------------------------------------
  112. *     | Function Call: PRB             Input Parameters: NUMBER |
  113. *     |                    Output Variable: PRBX   |
  114. *     -----------------------------------------------------------
  115. *
  116.     case !(FUNCTION) = 'PRB' .AND. TYPE(NUMBER) <> 'U'
  117.         store F to FLG
  118.         if NUMBER < 0
  119.             store T to FLG
  120.             store -1*NUMBER     to NUMBER
  121.         endif
  122.         if NUMBER < 3.08 .and. NUMBER > -3.08
  123.             store .436184 to A
  124.             store -.120168 to B
  125.             store .937298 to C
  126.             store .398942 to D2
  127.             store -1.000000*NUMBER*NUMBER/2.000000 to D1
  128.             store D1 to NX, POWRX
  129.             store 1.000000+NX to EXPX
  130.             store 1.000000 to DELTA, FACT, PASS
  131.             do while PASS < 14
  132.                 store PASS + 1 to PASS
  133.                 store PASS*FACT to FACT
  134.                 store POWRX*NX to POWRX
  135.                 store EXPX to EXPO
  136.                 store EXPX+POWRX/FACT to EXPX
  137.             enddo
  138.             store EXPX to DX
  139.             store DX * D2 to DX
  140.             release NX, EXPO, EXPX, DELTA, POWRX, FACT, PASS
  141.             store 1.000000/(1.000000 + .3326 * NUMBER) to EX
  142.             store 1.00 - DX * (A*EX + B*EX*EX + C*EX*EX*EX) to PRBX
  143.             store str(PRBX,6,4) to SEPX
  144.             store &SEPX to PRBX
  145.         else
  146.             store .999999 to PRBX
  147.         endif
  148.         if FLG
  149.             store 1.00 - PRBX to PRBX
  150.         endif
  151.         release A, B, C, D1, D2, DX, EX, FLG, NUMBER, SEPX
  152.  
  153. * <<<=======================================================================>>>
  154. *
  155. *    ----- >>> Exponential Function (e to X power) <<< -----
  156. *     -----------------------------------------------------------
  157. *     | Function Call: EXP             Input Parameters: NUMBER |
  158. *     |                    Output Variable: EXPX   |
  159. *     -----------------------------------------------------------
  160. *
  161.     case !(FUNCTION) = 'EXP' .AND. TYPE(NUMBER) <> 'U'
  162.         store NUMBER to NX, POWRX
  163.         store 1+NX to EXPX
  164.         store 1 to DELTA, FACT, PASS
  165.         do while DELTA > .0001
  166.             store PASS + 1 to PASS
  167.             store PASS*FACT to FACT
  168.             store POWRX*NX to POWRX
  169.             store EXPX to EXPO
  170.             store EXPX+POWRX/FACT to EXPX
  171.             store EXPX-EXPO to DELTA
  172.         enddo
  173.         store STR(EXPX,12,4) to SEPX
  174.         store &SEPX to EXPX
  175.         release NUMBER, NX, EXPO, DELTA, POWRX, FACT, SEPX, PASS
  176. * <<<=======================================================================>>>
  177. *
  178. *           ----- >>> Radians Function <<< -----
  179. *     -----------------------------------------------------------
  180. *     | Function Call: RAD             Input Parameters: DEGREES|
  181. *     |                    Output Variable: RADIANS|
  182. *     -----------------------------------------------------------
  183. *
  184.     case !(FUNCTION) = 'RAD' .and. type(DEGREES) <> 'U'
  185.         store DEGREES*3.1415962/180.000000 to RADIANS
  186.         release DEGREES
  187. *
  188. * <<<=======================================================================>>>
  189. *
  190. *           ----- >>> Sine Function <<< -----
  191. *     -----------------------------------------------------------
  192. *     | Function Call: SIN             Input Parameters: RADIANS|
  193. *     |                    Output Variable: SINX   |
  194. *     -----------------------------------------------------------
  195. *
  196.     case !(FUNCTION) = 'SIN' .AND. TYPE(RADIANS) <> 'U'
  197.         store RADIANS    to RD
  198.         store RD-RD*RD*RD/6+RD*RD*RD*RD*RD/120-RD*RD*RD*RD*RD*RD*RD/5040 to SINX
  199.         store SINX+RD*RD*RD*RD*RD*RD*RD*RD*RD/362880 to SINX
  200.         release RADIANS, RD
  201. * <<<=======================================================================>>>
  202. *
  203. *          ----- >>> Cosine Function <<< -----
  204. *     -----------------------------------------------------------
  205. *     | Function Call: COS             Input Parameters: RADIANS|
  206. *     |                    Output Variable: COSX   |
  207. *     -----------------------------------------------------------
  208. *
  209.     case !(FUNCTION) = 'COS' .AND. TYPE(RADIANS) <> 'U'
  210.         store RADIANS    to RD
  211.         store 1-RD*RD/2+RD*RD*RD*RD/24-RD*RD*RD*RD*RD*RD/720 to COSX
  212.         store COSX+RD*RD*RD*RD*RD*RD*RD*RD/40320 to COSX
  213.         store COSX-RD*RD*RD*RD*RD*RD*RD*RD*RD*RD/3628800 to COSX
  214.         release RADIANS, RD
  215. * <<<=======================================================================>>>
  216. *
  217. *         ----- >>> Tangent Function <<< -----
  218. *     -----------------------------------------------------------
  219. *     | Function Call: TAN             Input Parameters: RADIANS|
  220. *     |                    Output Variable: TANX   |
  221. *     -----------------------------------------------------------
  222. *
  223.     case !(FUNCTION) = 'TAN' .AND. TYPE(RADIANS) <> 'U'
  224.         store RADIANS to RD
  225.         store RD-RD*RD*RD/6+RD*RD*RD*RD*RD/120-RD*RD*RD*RD*RD*RD*RD/5040 to SNX
  226.         store SNX+RD*RD*RD*RD*RD*RD*RD*RD*RD/362880 to SNX
  227.         store 1-RD*RD/2+RD*RD*RD*RD/24-RD*RD*RD*RD*RD*RD/720 to CSX
  228.         store CSX+RD*RD*RD*RD*RD*RD*RD*RD/40320 to CSX
  229.         store CSX-RD*RD*RD*RD*RD*RD*RD*RD*RD*RD/3628800 to CSX
  230.         store SNX/CSX to TANX
  231.         release RADIANS, RD, SNX, CSX
  232.         
  233. * <<<=======================================================================>>>
  234. *
  235. *         ----- >>> Arc Tangent Function <<< -----
  236. *     -----------------------------------------------------------
  237. *     | Function Call: ATN             Input Parameters: NUMBER |
  238. *     |                    Output Variable: ATNX   |
  239. *     -----------------------------------------------------------
  240. *
  241.     case !(FUNCTION) = 'ATN' .AND. TYPE(NUMBER) <> 'U'
  242.         store NUMBER to NX
  243.         if NX*NX < 1
  244.             store NX-NX*NX*NX/3+NX*NX*NX*NX*NX/5-NX*NX*NX*NX*NX*NX*NX/7 to ATNX
  245.             store ATNX+NX*NX*NX*NX*NX*NX*NX*NX*NX/9 to ATNX
  246.         else
  247.             store 1.5707963-1/NX+1/(3*NX*NX*NX)-1/(5*NX*NX*NX*NX*NX) to ATNX
  248.             store ATNX+1/(7*NX*NX*NX*NX*NX*NX*NX)-1/(9*NX*NX*NX*NX*NX*NX*NX*NX*NX) to ATNX
  249.         endif
  250.         release NUMBER, NX
  251.  
  252. * <<<=======================================================================>>>
  253. *
  254. *       ----- >>> Natural (Naperian) Logarithm <<< -----
  255. *     -----------------------------------------------------------
  256. *     | Function Call: LNX             Input Parameters: NUMBER |
  257. *     |                    Output Variable: LOGX   |
  258. *     -----------------------------------------------------------
  259. *
  260.     case !(FUNCTION) = 'LNX' .AND. TYPE(NUMBER) <> 'U'
  261.         store (NUMBER-1.000000)/(NUMBER+1.000000) to NX, POWRX, LOGX
  262.         store 1 to DELTA, PASS
  263.         do while DELTA > .001
  264.             store PASS + 2 to PASS
  265.             store POWRX*NX*NX to POWRX
  266.             store LOGX  to LOGO
  267.             store LOGX+POWRX/PASS to LOGX
  268.             store LOGX-LOGO to DELTA
  269.         enddo
  270.         store 2.00*LOGX to LOGX
  271.         store STR(LOGX,12,4) to SLOGX
  272.         store &SLOGX to LOGX
  273.         release NUMBER, NX, LOGO, DELTA, POWRX, PASS, SLOGX
  274. * <<<=======================================================================>>>
  275. *
  276. *        ----- >>>  Otherwise Undefined <<< -----
  277. *
  278.     otherwise
  279.         store 'UNKNOWN' to FUNCTION
  280.         
  281. endcase
  282. if FUNCTION <> 'UNKNOWN'
  283.     release FUNCTION
  284. endif
  285. return
  286. * <<<=======================================================================>>>
  287. *
  288. *           End of DBASE II  Mathematical Function Library
  289. *
  290. * <<<=======================================================================>>>
  291. *     This program is Copyrighted and the Sole Property of Keith R. Plossl
  292. * <<<=======================================================================>>>
  293. *
  294.  
  295.