DEFDBL A-Z DECLARE FUNCTION Interpret (Formula$) DECLARE FUNCTION ParseExp$ (Expr$) CONST TRUE = -1 CONST FALSE = NOT TRUE DIM SHARED gError AS INTEGER DIM SHARED Numbers(255) AS DOUBLE DIM Res AS DOUBLE ON ERROR GOTO Trap PRINT PRINT "Enter an arithmetic expression (empty line terminates, ? = help)" DO PRINT "->"; LINE INPUT ; a$ IF a$ = "" THEN EXIT DO IF a$ = "?" THEN PRINT PRINT "The following trigonometric and math. functions are supported:" PRINT " SIN or S - sine, COS or C - cosine, TAN or T - tangent, ANAT, ATN or N -" PRINT " arc tangent, SQRT, SQR or R - Root, LOG or L - nLogarithm," PRINT " EXP or E - exponent, ABS or A - absolute, PI or P - number pi." PRINT PRINT "You can use up to 150 nested parenthesis. Unrecognised characters and spaces" PRINT "will be ignored. Negative numbers should be entered in parenthesis: (-85)" PRINT PRINT " Example: S5+(4*7d-4)-T(6^2) = SIN(5) + (4 * 0.0007) - TAN(6 ^ 2)" PRINT PRINT "Numbers in scientific format are entered in the following fashion:" PRINT " [+/-]12345D[+/-]123 | (-0.007) = (-7D-3) | 7000000 = 7D6" PRINT PRINT "Trigonometric functions use radians. To convert degrees to radians," PRINT "multiply the degrees by PI/180. To convert from radians to degrees," PRINT "multiply the radians by 180/PI" PRINT PRINT " Algorithm by Steinar Foss." PRINT " Superoptimized by Stanislav Sokolov." PRINT PRINT "Enter an arithmetic expression (empty line terminates, ? = help)" ELSE a$ = ParseExp$(a$) IF LEFT$(a$, 3) = "Par" OR LEFT$(a$, 3) = "Las" THEN PRINT " = Error! " + a$ ELSE Res = Interpret(UCASE$(a$)) IF NOT gError THEN PRINT " ="; Res ELSE PRINT " = Illigal operation!" gError = FALSE END IF END IF END IF LOOP END Trap: IF ERR = 11 OR ERR = 5 THEN 'Division by zero or Illigal function call gError = TRUE RESUME NEXT END IF FUNCTION Interpret (Formula$) DIM i AS INTEGER, a AS INTEGER 'Counter DIM Orden AS INTEGER 'Parentheses level DIM Type1 AS DOUBLE 'The number being handled (converted from string) REDIM Sum(150) AS DOUBLE REDIM Overfac(150) AS DOUBLE REDIM Exp2(150) AS DOUBLE 'Initialize Orden = 1 Overfac(1) = 1 a = 0 'Main loop (the string is being prosessed from the end) FOR i = LEN(Formula$) TO 1 STEP -1 b$ = MID$(Formula$, i, 1) 'Read a letter form the string 'Find which operation to perform SELECT CASE b$ CASE "#" Type1 = Numbers(a) a = a + 1 CASE "*" Overfac(Orden) = Type1 ^ (Exp2(Orden) + 1) * Overfac(Orden) Type1 = 0 Exp2(Orden) = 0 CASE "+" Sum(Orden) = Sum(Orden) + Type1 ^ (Exp2(Orden) + 1) * Overfac(Orden) Type1 = 0 Overfac(Orden) = 1 Exp2(Orden) = 0 CASE "-" Sum(Orden) = Sum(Orden) - Type1 ^ (Exp2(Orden) + 1) * Overfac(Orden) Type1 = 0 Overfac(Orden) = 1 Exp2(Orden) = 0 CASE "/" Overfac(Orden) = Overfac(Orden) / Type1 ^ (Exp2(Orden) + 1) Type1 = 0 Exp2(Orden) = 0 'Return to previous level CASE "(" Type1 = Sum(Orden) + Type1 ^ (Exp2(Orden) + 1) * Overfac(Orden) Sum(Orden) = 0 Exp2(Orden) = 0 Orden = Orden - 1 'Jump to next level (the string is being prosessed from the end) CASE ")" Orden = Orden + 1 Overfac(Orden) = 1 CASE "^" Exp2(Orden) = Type1 - 1 Type1 = 0 CASE "T" Type1 = TAN(Type1) CASE "N" Type1 = ATN(Type1) CASE "S" Type1 = SIN(Type1) CASE "C" Type1 = COS(Type1) CASE "L" Type1 = LOG(Type1) CASE "E" Type1 = 2.718282# ^ Type1 CASE "R" Type1 = SQR(Type1) CASE "A" Type1 = ABS(Type1) CASE "P" Type1 = 3.141592654# END SELECT NEXT i 'The final calculation Interpret = Type1 ^ (Exp2(1) + 1) * Overfac(1) + Sum(1) END FUNCTION FUNCTION ParseExp$ (Expr$) REDIM Find(11) AS STRING REDIM Repl(11) AS STRING DIM i AS INTEGER, f AS INTEGER Find(0) = "sin" Find(1) = "cos" Find(2) = "tan" Find(3) = "atan" Find(4) = "atn" Find(5) = "exp" Find(6) = "abs" Find(7) = "sqrt" Find(8) = "sqr" Find(9) = "pi" Find(10) = "log" Find(11) = " " Repl(0) = "S" Repl(1) = "C" Repl(2) = "T" Repl(3) = "N" Repl(4) = "N" Repl(5) = "E" Repl(6) = "A" Repl(7) = "R" Repl(8) = "R" Repl(9) = "P" Repl(10) = "L" Repl(11) = "" 'Precalculate separate numbers a% = 0 NumLen% = 0 FOR i = LEN(Expr$) TO 1 STEP -1 b$ = MID$(Expr$, i, 1) Empty% = TRUE IF (b$ >= "0" AND b$ <= "9") OR b$ = "." OR b$ = "D" OR b$ = "-" THEN IF i > 1 THEN IF b$ <> "-" OR (b$ = "-" AND MID$(Expr$, i - 1, 1) = "D") THEN Num$ = b$ + Num$ NumLen = NumLen + 1 Empty% = FALSE END IF ELSE IF b$ <> "-" THEN Num$ = b$ + Num$ NumLen = NumLen + 1 Empty% = FALSE END IF END IF END IF IF Empty% AND NumLen > 0 THEN Numbers(a%) = VAL(Num$) Expr$ = LEFT$(Expr$, i) + "#" + MID$(Expr$, i + NumLen + 1) a% = a% + 1 b$ = "" Num$ = "" NumLen = 0 END IF NEXT i IF NOT Empty% THEN Numbers(a%) = VAL(Num$) Expr$ = "#" + MID$(Expr$, i + NumLen + 1) a% = a% + 1 Num$ = "" NumLen = 0 END IF 'End precalculating separate numbers FOR i = 0 TO 11 f = INSTR(LCASE$(Expr$), Find(i)) IF f <> 0 THEN Expr$ = LEFT$(Expr$, f - 1) + Repl(i) + MID$(Expr$, f + LEN(Find(i))) i = i - 1 'A case of Find[i] has been found - try another search until no more cases found END IF NEXT i 'Check if the amount of opening and closing parenthesis coinside . . . FOR i = 1 TO LEN(Expr$) IF MID$(Expr$, i, 1) = "(" THEN ParCount = ParCount + 1 IF MID$(Expr$, i, 1) = ")" THEN ParCount = ParCount - 1 NEXT i ' . . . If not, abort calculation IF ParCount <> 0 THEN ParseExp$ = "Parenthesis count mismatch!" EXIT FUNCTION END IF 'Check the last symbol in the expression l$ = RIGHT$(Expr$, 1) IF l$ = "#" OR l$ = "P" OR l$ = ")" THEN ELSE Expr$ = "Last symbol in the expression is illigal!" END IF ParseExp$ = Expr$ END FUNCTION