CP/M/CPM_CDROM.iso/mbug/mbug060.arc/CPM#006.LBR/MATHLIB.CMD

OS/2 REXX Batch file | 1979-12-31 | 14KB | 380 lines

* <<<===============================================================>>>
*
* This program is a mathematics function library for dBASE II.    This
* file will need to have the function called by a name to exectute the
* case.  Load the three charcter function code in a variable called
* FUNCTION.  Load the parameters as required by the function needed and
* say :  DO MATHLIB
*
*                E X A M P L E
*             ===================
*
*             store 'SQR' to FUNCTION
*             store (your value) to NUMBER
*             DO MATHLIB
*
* <<<=================================================================>>>
*
*            <<< W A R N I N G >>>
*
* The following is a list of variables used by this library.  Consider
* them to be reserved words or your variables with the same name will
* be gone.
*
*    A    PASS
*    ABSX    POWRX
*    ATNX    RADIANS
*    COSX    RD
*    CSX    RNDX
*    D
*    DEGREES S
*    DELTA    SEED
*    DMS
*    EXPO    SEPX
*    EXPX    SINX
*    FACT    SLOGX
*    LOGX    SNX
*    LOGO    SQRD
*    M
*    MD
*    NUMBER    SQRX
*    NX    TANX
*
*
* <<<================================================================>>>
*  These functions were copied from the October 1984 issue of DATA BASED
*  ADVISOR magazine.  They were written by Keith R. Plossi, Vice
*  President of George Plossl Educational Services, Inc., of
*  Atlanta, Georgia.       Bob Williams  Kansas City District COE
*
* <<<=================================================================>>>
*
*          M O D I F I C A T I O N     H I S T O R Y
*          ________________________________________
*
*   DATE--11/30/84
*   AUTHOR--Steven R. Burns    Kansas City District  COE
*   DESCRIPTION--Several functions have been added to enhance the versatility
*   of this library.  The DMS to DEGREES function changes degrees, minutes,
*   and seconds in the format DDD.MMSS to decimal degrees which are used in
*   the Degrees to Radians function.  An incorrect value for PI was published
*   for this function and this has been corrected.  In addition, function
*   routines were written to convert Radians to Degrees and Degrees to degrees,
*   minutes, and seconds (DMS).  Also the SIN, COS, and TAN functions have
*   been expanded to increase their accuracy.  The ATN function has been
*   commented out, however the original code has been left in place along with
*   comments on how to make it more accurate.
*
*
* <<<==================================================================>>>
do case
* <<<==================================================================>>>
*
*           ------>>>> Absolute Value Function <<<<-------
*
*           ------------------------------------------------------
*           |  Function Call: ABS       Input Parameters:  NUMBER |
*           |               Output Variable :  ABSX   |
*           ------------------------------------------------------
*
*
case !(FUNCTION) = 'ABS' .AND. TYPE(NUMBER) <>    'U'
  if NUMBER < 0
     store -1*NUMBER to ABSX
else
    store NUMBER to ABSX
  endif
    release NUMBER
* <<<==================================================================>>>
*
*           ------>>>> Random Number Function <<<<--------
*
*           ------------------------------------------------------
*           |  Function Call: RND       Input Parameters:  SEED  |
*           |  Default Seed = .375       Output Variable :  RNDX  |
*           ------------------------------------------------------
*
case !(FUNCTION) = 'RND' .AND. TYPE(SEED) <> 'U'
  if SEED <= 0 .or. SEED >= 1
     store .375 to SEED
  endif
  store (SEED*9821+.211327)-INT(SEED*9821+.211327) to SEED
  store SEED to RNDX
* <<<==================================================================>>>
*
*          -------->>> Square Root Function <<<---------
*
*           ------------------------------------------------------
*           |  Function Call: SQR       Input Parameters:  NUMBER |
*           |               Output Variable :  SQRX   |
*           ------------------------------------------------------
*
case !(FUNCTION) = 'SQR' .AND. TYPE (NUMBER) <>  'U'
  if NUMBER < 0
      store -1*NUMBER to NUMBER
  endif
  store 1 to A, SQRX
  store F to SQRD
  do while .not. SQRD
     store .5*(A + NUMBER/A) to SQRX
     store SQRX-A to DELTA
    if DELTA < 0
       store -1*DELTA to DELTA
    endif
    if DELTA < .000001
       store T to SQRD
    else
       store SQRX to A
    endif
enddo
release NUMBER, A, SQRD, DELTA
* <<<===============================================================>>>
*
*           --------->>> Normal Probability Function <<<--------
*
*
*           It computes the area under the normal curve such that
*           a number of zero yields a 50% or .5000 area.
*
*
*           ------------------------------------------------------
*           |  Function Call: PRB       Input Parameters:  NUMBER |
*           |               Output Variable :  PRBX   |
*           ------------------------------------------------------
*
case !(FUNCTION) = 'PRB' .AND. TYPE(NUMBER) <> 'U'
  store F to FLG
  if NUMBER < 0
     store T to FLG
     store -1*NUMBER to NUMBER
  endif
if NUMBER < 3.08 .and. NUMBER > -3.08
     store  .436184 to A
     store  -.120168 to B
     store  .937298 to C
     store  .398942 to D2
     store  -1.000000* NUMBER*NUMBER/2.000000 to D1
     store D1 to NX, POWRX
     store 1.000000+NX to EXPX
     store 1.000000 to FACT, PASS
     do while PASS < 14
    store PASS + 1 to PASS
    store PASS*FACT to FACT
    store POWRX*NX to POWRX
    store EXPX to EXPO
    store EXPX+POWRX/FACT to EXPX
     enddo
     store EXPX to DX
     store DX * D2 to DX
     release NX, EXPO, EXPX, POWRX, FACT, PASS
     store 1.000000/(1.000000 + .3326 * NUMBER) to  EX
     store 1.00 - DX * (A*EX + B*EX*EX + C*EX*EX*EX) to PRBX
     store str(PRBX,6,4) to SEPX
     store &SEPX to PRBX
else
     store .999999 to PRBX
endif
if FLG
     store 1.00 - PRBX to PRBX
endif
release A, B, C, D1, D2, DX, EX, FLG, NUMBER, SEPX
* <<<=============================================================>>>
*
*     -------->>>> Exponential Function (e to X power) <<<<--------
*
*           ------------------------------------------------------
*           |  Function Call: EXP       Input Parameters:  NUMBER |
*           |               Output Variable :  EXPX   |
*           ------------------------------------------------------
*
case !(FUNCTION) = 'EXP' .AND. TYPE(NUMBER) <> 'U'
  store NUMBER to NX, POWRX
  store 1+NX to EXPX
  store 1 to FACT, PASS
do while PASS < 12
   store PASS + 1 to PASS
   store PASS*FACT to FACT
   store POWRX*NX to POWRX
   store EXPX to EXPO
   store EXPX+POWRX/FACT to EXPX
enddo
store STR(EXPX,12,4) to SEPX
store &SEPX to EXPX
release NUMBER, NX, EXPO, POWRX, FACT, SEPX, PASS
* <<<==================================================================>>>
*
*         ---------->>>> DMS to Degrees Function <<<<--------
*           Format for DMS = DDD.MMSS
*           ------------------------------------------------------
*           |  Function Call: DEC       Input Parameters:  DMS    |
*           |               Output Variable :  DEGREES|
*           ------------------------------------------------------
*
case !(FUNCTION) = 'DEC' .AND. TYPE(DMS)<>'U'
  store INT(DMS) to D
  store (DMS-D)*100 to MD
  store INT(MD) to M
  store (MD-M)*100 to S
  store D/1.000000000 to DEGREES
  store DEGREES +M/60 TO DEGREES
  store DEGREES +S/3600 TO DEGREES
  release D,MD,M,S,DMS
* <<<==================================================================>>>
*
*         ---------->>>> Radians Function <<<<--------
*
*           ------------------------------------------------------
*           |  Function Call: RAD       Input Parameter :  DEGREES|
*           |               Output Variable :  RADIANS|
*           ------------------------------------------------------
*
case !(FUNCTION) = 'RAD' .AND. TYPE(DEGREES) <> 'U'
  store DEGREES*3.141592654/180.000000000 to RADIANS
  release DEGREES
* <<<==================================================================>>>
*
*         ---------->>>> Degrees Function <<<<--------
*
*           ------------------------------------------------------
*           |  Function Call: DEG       Input Parameter :  RADIANS|
*           |               Output Variable :  DEGREES|
*           ------------------------------------------------------
*
case !(FUNCTION) = 'DEG' .AND. TYPE(RADIANS) <> 'U'
  store RADIANS*180.000000000/3.141592654 to DEGREES
  release RADIANS
* <<<==================================================================>>>
*
*         ---------->>>> Degrees to DMS Function <<<<--------
*           Format for DMS = DDD.MMSS
*           ------------------------------------------------------
*           |  Function Call: DMS       Input Parameter :  DEGREES|
*           |               Output Variables:  DMS    |
*           ------------------------------------------------------
*
case !(FUNCTION) = 'DMS' .AND. TYPE(DEGREES) <> 'U'
  store INT(DEGREES) to DMS
  store (DEGREES-DMS)*60 to MD
  store INT(MD) to M
  store (((MD-M)*60)+.0005) to S
  store (INT(1000*(S)))/1000.00000000 to S
  store DMS+M/100+S/10000 to DMS
release DEGREES, MD, M, S
* <<<==================================================================>>>
*
*           ---------->>>> Sine Function <<<<------------
*
*           ------------------------------------------------------
*           |  Function Call: SIN       Input Parameter :  RADIANS|
*           |               Output Variable :  SINX   |
*           ------------------------------------------------------
*
case !(FUNCTION) = 'SIN' .AND. TYPE(RADIANS) <> 'U'
  store RADIANS to RD
  store RD-RD*RD*RD/6+RD*RD*RD*RD*RD/120-RD*RD*RD*RD*RD*RD*RD/5040 to SINX
  store SINX+RD*RD*RD*RD*RD*RD*RD*RD*RD/362880 to SINX
  store SINX+RD*RD*RD*RD*RD*RD*RD*RD*RD*RD*RD/39916800 to SINX
release RADIANS, RD
* <<<==================================================================>>>
*
*          ----------->>> Cosine Function <<<<-------------
*
*           ------------------------------------------------------
*           |  Function Call: COS       Input Parameters:  RADIANS|
*           |               Output Variable :  COSX   |
*           ------------------------------------------------------
*
case !(FUNCTION) = 'COS' .AND. TYPE(RADIANS) <> 'U'
  store RADIANS to RD
  store 1-RD*RD/2+RD*RD*RD*RD/24-RD*RD*RD*RD*RD*RD/720 to COSX
  store COSX+RD*RD*RD*RD*RD*RD*RD*RD/40320 to COSX
  store COSX-RD*RD*RD*RD*RD*RD*RD*RD*RD*RD/3628800 to COSX
  store COSX+RD*RD*RD*RD*RD*RD*RD*RD*RD*RD*RD*RD/479001600 to COSX
release RADIANS, RD
* <<<==================================================================>>>
*
*         --------->>>> Tangent Function <<<<---------------
*
*           ------------------------------------------------------
*           |  Function Call: TAN       Input Parameters:  RADIANS|
*           |               Output Variable :  TANX   |
*           ------------------------------------------------------
*
case !(FUNCTION) = 'TAN' .AND. TYPE(RADIANS) <> 'U'
  store RADIANS to RD
  store RD-RD*RD*RD/6+RD*RD*RD*RD*RD/120-RD*RD*RD*RD*RD*RD*RD/5040 to SNX
  store SNX+RD*RD*RD*RD*RD*RD*RD*RD*RD/362880 to SNX
* store SNX+RD*RD*RD*RD*RD*RD*RD*RD*RD*RD*RD/39916800 to SNX
  store 1-RD*RD/2+RD*RD*RD*RD/24-RD*RD*RD*RD*RD*RD/720 to CSX
  store CSX+RD*RD*RD*RD*RD*RD*RD*RD/40320 to CSX
  store CSX-RD*RD*RD*RD*RD*RD*RD*RD*RD*RD/3628800 to CSX
* store CSX+RD*RD*RD*RD*RD*RD*RD*RD*RD*RD*RD*RD/479001600 to CSX
  store SNX/CSX to TANX
release RADIANS, RD, SNX, CSX
* <<<=================================================================>>>
*
*          -------->>> Arc Tangent Function <<<----------
*        ****THIS FUNCTION IS NOT ACCURATE--IT NEEDS WORK****
*           ------------------------------------------------------
*           |  Function Call: ATN       Input Parameters:  NUMBER |
*           |               Output Variable :  RADIANS|
*           ------------------------------------------------------
*   These series functions need to be expanded to at least NX**41/41 to be
*   accurate to the nearest 0.1 seconds when converted to DMS.
*case !(FUNCTION) = 'ATN' .AND. TYPE(NUMBER) <> 'U'
* store NUMBER to NX
* if NX*NX < 1
*    store  NX-NX*NX*NX/3+NX*NX*NX*NX*NX/5-NX*NX*NX*NX*NX*NX*NX/7;
*        to RADIANS
*    store  RADIANS +NX*NX*NX*NX*NX*NX*NX*NX*NX/9 to RADIANS
*    store  RADIANS -NX*NX*NX*NX*NX*NX*NX*NX*NX*NX*NX/11 to RADIANS
*   These series functions need to be expanded to at least 1/(41*NX**41) to be
*   accurate to the nearest 0.1 seconds when converted to DMS.
*else
*    store  1.570796327-1/NX+1/(3*NX*NX*NX )-1/(5*NX*NX*NX*NX*NX) to RADIANS
*    store  RADIANS+1/(7*NX*NX*NX*NX*NX*NX*NX)-;
*        1/(9*NX*NX*NX*NX*NX*NX*NX*NX*NX) to RADIANS
*    store  RADIANS+1/(11*NX*NX*NX*NX*NX*NX*NX*NX*NX*NX*NX) to RADIANS
*endif
*release NUMBER, NX
* <<<=================================================================>>>
*
*     ---------->>> Natural (Naperian) Logarithm <<<---------
*
*           ------------------------------------------------------
*           |  Function Call: LNX       Input Parameters:  NUMBER |
*           |               Output Variable :  LOGX   |
*           ------------------------------------------------------
*
case !(FUNCTION) = 'LNX' .AND. TYPE(NUMBER) <> 'U'
  store (NUMBER-1.000000)/(NUMBER+1.000000) to NX, POWRX, LOGX
  store 1 to PASS
  do while PASS < 14
     store PASS + 2 to PASS
     store POWRX*NX*NX to POWRX
     store LOGX to LOGO
     store LOGX+POWRX/PASS to LOGX
  enddo
store 2.00*LOGX to LOGX
store STR(LOGX,12,4) to SLOGX
store  &SLOGX to LOGX
release NUMBER, NX, LOGO, POWRX, PASS, SLOGX
* <<<=================================================================>>>
*
*           ------------->>> Otherwise Undefined <<<-----------
*
*
otherwise
   store 'UNKNOWN' to FUNCTION
endcase
if FUNCTION <> 'UNKOWN'
   release FUNCTION
endif
return
------
*
*
otherwise
   store 'UNKNOWN' to FUNCTION
endcase
if FUNCT