CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / mbug / mbug060.arc / CPM#006.LBR / MATHLIB.CMD < prev next >

Wrap

Text File | 1979-12-31 | 13.5 KB | 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