QB64.org Forum
Active Forums => QB64 Discussion => Topic started by: jack on May 22, 2020, 01:10:32 pm
-
example input
5!
-2^2
a$ = " "
WHILE a$ <> ""
LINE INPUT "? "; a$
result# = eval(a$)
PRINT result#
WEND
END
FUNCTION eval# (ee AS STRING)
DIM i AS INTEGER
DIM id AS INTEGER
DIM l AS INTEGER
DIM fn AS INTEGER
DIM aa AS STRING
DIM d2 AS STRING
DIM e2 AS STRING
DIM s2 AS STRING
DIM ch2 AS STRING
DIM g AS _FLOAT
DIM x AS _FLOAT
DIM fc AS DOUBLE
DIM v##(20)
e2 = UCASE$(ee)
IF LEN(e2) = 0 THEN e2 = "0"
i = 1: id = 0: l = LEN(e2): s2 = "": fn = 0
GOSUB scan
GOSUB expr
IF ch2 <> " " OR id > 1 THEN
PRINT
PRINT "Syntax Error"
PRINT
END IF
eval# = v##(0)
EXIT FUNCTION
'================================
scan:
IF i > l THEN
ch2 = " "
RETURN
END IF
ch2 = MID$(e2, i, 1)
i = i + 1
IF ch2 = " " THEN GOSUB scan
RETURN
unary:
IF ch2 = "-" OR ch2 = "+" THEN
s2 = s2 + ch2
GOSUB scan
GOSUB term
aa = RIGHT$(s2, 1)
s2 = LEFT$(s2, LEN(s2) - 1)
IF aa <> "-" THEN RETURN
v##(id - 1) = -v##(id - 1)
RETURN
END IF
GOSUB factor
RETURN
gamma:
GOSUB unary
WHILE ch2 = "!"
x = v##(id - 1)
GOSUB factorial
v##(id - 1) = g
GOSUB scan
WEND
RETURN
expon:
GOSUB gamma
WHILE ch2 = "^"
GOSUB scan
GOSUB gamma
id = id - 1
v##(id - 1) = v##(id - 1) ^ v##(id)
WEND
RETURN
term:
GOSUB expon
WHILE (ch2 = "*" OR ch2 = "/")
s2 = s2 + ch2
GOSUB scan
GOSUB expon
aa = RIGHT$(s2, 1)
s2 = LEFT$(s2, LEN(s2) - 1)
IF aa = "*" THEN
id = id - 1
v##(id - 1) = v##(id - 1) * v##(id)
END IF
IF aa = "/" THEN
id = id - 1
v##(id - 1) = v##(id - 1) / v##(id)
END IF
WEND
RETURN
expr:
GOSUB term
WHILE (ch2 = "-" OR ch2 = "+")
s2 = s2 + ch2
GOSUB scan
GOSUB term
aa = RIGHT$(s2, 1)
s2 = LEFT$(s2, LEN(s2) - 1)
IF aa = "-" THEN
id = id - 1
v##(id - 1) = v##(id - 1) - v##(id)
END IF
IF aa = "+" THEN
id = id - 1
v##(id - 1) = v##(id - 1) + v##(id)
END IF
WEND
RETURN
factor:
IF ch2 = "E" THEN
IF MID$(e2, i - 1, 2) <> "EX" THEN
v##(id) = 2.71828182845904523536##
id = id + 1
GOSUB scan
RETURN
END IF
END IF
IF ch2 = "P" AND MID$(e2, i - 1, 2) = "PI" THEN
v##(id) = 3.14159265358979323846##
id = id + 1
i = i + 1
GOSUB scan
RETURN
END IF
IF INSTR(".0123456789", ch2) THEN
d2 = ""
WHILE INSTR("DE.0123456789", ch2)
d2 = d2 + ch2
GOSUB scan
WEND
v##(id) = VAL(d2)
id = id + 1
RETURN
END IF
IF ch2 = "(" THEN
GOSUB scan
GOSUB expr
IF ch2 = "," THEN
GOSUB scan
GOSUB expr
END IF
IF ch2 <> ")" THEN
PRINT
PRINT "Missing ')'"
END IF
'IF fn = 0 THEN
GOSUB scan
'END IF
RETURN
END IF
IF ch2 = "A" THEN
IF MID$(e2, i - 1, 4) = "ABS(" THEN
i = i + 2 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = ABS(v##(id - 1))
ELSEIF MID$(e2, i - 1, 5) = "ACOS(" THEN
i = i + 3 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = _ACOS(v##(id - 1))
ELSEIF MID$(e2, i - 1, 6) = "ACOSH(" THEN
i = i + 4
GOSUB scan
GOSUB factor
v##(id - 1) = _ACOSH(v##(id - 1))
ELSEIF MID$(e2, i - 1, 7) = "ARCCOT(" THEN
i = i + 5
GOSUB scan
GOSUB factor
v##(id - 1) = _ARCCOT(v##(id - 1))
ELSEIF MID$(e2, i - 1, 7) = "ARCCSC(" THEN
i = i + 5
GOSUB scan
GOSUB factor
v##(id - 1) = _ARCCSC(v##(id - 1))
ELSEIF MID$(e2, i - 1, 7) = "ARCSEC(" THEN
i = i + 5
GOSUB scan
GOSUB factor
v##(id - 1) = _ARCSEC(v##(id - 1))
ELSEIF MID$(e2, i - 1, 5) = "ASIN(" THEN
i = i + 3
GOSUB scan
GOSUB factor
v##(id - 1) = _ASIN(v##(id - 1))
ELSEIF MID$(e2, i - 1, 6) = "ASINH(" THEN
i = i + 4
GOSUB scan
GOSUB factor
v##(id - 1) = _ASINH(v##(id - 1))
ELSEIF MID$(e2, i - 1, 4) = "ATN(" THEN
i = i + 2
GOSUB scan
GOSUB factor
v##(id - 1) = ATN(v##(id - 1))
ELSEIF MID$(e2, i - 1, 6) = "ATAN2(" THEN
i = i + 4
GOSUB scan
GOSUB factor
id = id - 1
v##(id - 1) = _ATAN2(v##(id - 1), v##(id))
ELSE
k% = INSTR(i, e2, "(")
PRINT "unknown function A" + MID$(e2, i, k% - i)
END IF
ELSEIF ch2 = "C" THEN
IF MID$(e2, i - 1, 4) = "COS(" THEN
i = i + 2 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = COS(v##(id - 1))
ELSEIF MID$(e2, i - 1, 5) = "COSH(" THEN
i = i + 3
GOSUB scan
GOSUB factor
v##(id - 1) = _COSH(v##(id - 1))
ELSEIF MID$(e2, i - 1, 4) = "COT(" THEN
i = i + 2
GOSUB scan
GOSUB factor
v##(id - 1) = _COT(v##(id - 1))
ELSEIF MID$(e2, i - 1, 5) = "COTH(" THEN
i = i + 3
GOSUB scan
GOSUB factor
v##(id - 1) = _COTH(v##(id - 1))
ELSEIF MID$(e2, i - 1, 4) = "CSC(" THEN
i = i + 2 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = _CSC(v##(id - 1))
ELSEIF MID$(e2, i - 1, 5) = "CSCH(" THEN
i = i + 3 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = _CSCH(v##(id - 1))
ELSE
k% = INSTR(i, e2, "(")
PRINT "unknown function C" + MID$(e2, i, k% - i)
END IF
ELSEIF ch2 = "D" THEN
IF MID$(e2, i - 1, 4) = "D2G(" THEN
i = i + 2 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = _D2G(v##(id - 1))
ELSEIF MID$(e2, i - 1, 4) = "D2R(" THEN
i = i + 2
GOSUB scan
GOSUB factor
v##(id - 1) = _D2R(v##(id - 1))
ELSE
k% = INSTR(i, e2, "(")
PRINT "unknown function D" + MID$(e2, i, k% - i)
END IF
ELSEIF ch2 = "E" THEN
IF MID$(e2, i - 1, 4) = "EXP(" THEN
i = i + 2 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = EXP(v##(id - 1))
ELSEIF MID$(e2, i - 1, 6) = "EXP10(" THEN
i = i + 4 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = EXP(v##(id - 1) * 2.3025850929940456840##)
ELSE
k% = INSTR(i, e2, "(")
PRINT "unknown function E" + MID$(e2, i, k% - i)
END IF
ELSEIF ch2 = "G" THEN
IF MID$(e2, i - 1, 4) = "G2D(" THEN
i = i + 2 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = _G2D(v##(id - 1))
ELSEIF MID$(e2, i - 1, 4) = "G2R(" THEN
i = i + 2
GOSUB scan
GOSUB factor
v##(id - 1) = _G2R(v##(id - 1))
ELSE
k% = INSTR(i, e2, "(")
PRINT "unknown function G" + MID$(e2, i, k% - i)
END IF
ELSEIF ch2 = "H" THEN
IF MID$(e2, i - 1, 6) = "HYPOT(" THEN
i = i + 4 'advance pointer to just before "("
GOSUB scan
GOSUB factor
id = id - 1
v##(id - 1) = _HYPOT(v##(id - 1), v##(id))
ELSE
k% = INSTR(i, e2, "(")
PRINT "unknown function H" + MID$(e2, i, k% - i)
END IF
ELSEIF ch2 = "I" THEN
IF MID$(e2, i - 1, 4) = "INT(" THEN
i = i + 2 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = INT(v##(id - 1))
ELSE
k% = INSTR(i, e2, "(")
PRINT "unknown function I" + MID$(e2, i, k% - i)
END IF
ELSEIF ch2 = "L" THEN
IF MID$(e2, i - 1, 4) = "LOG(" THEN
i = i + 2 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = LOG(v##(id - 1))
ELSEIF MID$(e2, i - 1, 6) = "LOG10(" THEN
i = i + 4 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = LOG(v##(id - 1)) * 0.43429448190325182765##
ELSE
k% = INSTR(i, e2, "(")
PRINT "unknown function L" + MID$(e2, i, k% - i)
END IF
ELSEIF ch2 = "R" THEN
IF MID$(e2, i - 1, 4) = "R2D(" THEN
i = i + 2 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = _R2D(v##(id - 1))
ELSEIF MID$(e2, i - 1, 4) = "R2G(" THEN
i = i + 2
GOSUB scan
GOSUB factor
v##(id - 1) = _R2G(v##(id - 1))
ELSE
k% = INSTR(i, e2, "(")
PRINT "unknown function R" + MID$(e2, i, k% - i)
END IF
ELSEIF ch2 = "S" THEN
IF MID$(e2, i - 1, 4) = "SIN(" THEN
i = i + 2 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = SIN(v##(id - 1))
ELSEIF MID$(e2, i - 1, 5) = "SINH(" THEN
i = i + 3
GOSUB scan
GOSUB factor
v##(id - 1) = _SINH(v##(id - 1))
ELSEIF MID$(e2, i - 1, 4) = "SEC(" THEN
i = i + 2
GOSUB scan
GOSUB factor
v##(id - 1) = _SEC(v##(id - 1))
ELSEIF MID$(e2, i - 1, 5) = "SECH(" THEN
i = i + 3
GOSUB scan
GOSUB factor
v##(id - 1) = _SECH(v##(id - 1))
ELSEIF MID$(e2, i - 1, 4) = "SQR(" THEN
i = i + 2 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = SQR(v##(id - 1))
ELSE
k% = INSTR(i, e2, "(")
PRINT "unknown function S" + MID$(e2, i, k% - i)
END IF
ELSEIF ch2 = "T" THEN
IF MID$(e2, i - 1, 4) = "TAN(" THEN
i = i + 2 'advance pointer to just before "("
GOSUB scan
GOSUB factor
v##(id - 1) = TAN(v##(id - 1))
ELSEIF MID$(e2, i - 1, 5) = "TANH(" THEN
i = i + 3
GOSUB scan
GOSUB factor
v##(id - 1) = _TANH(v##(id - 1))
ELSE
k% = INSTR(i, e2, "(")
PRINT "unknown function T" + MID$(e2, i, k% - i)
END IF
END IF
RETURN
factorial:
g = 1##
FOR fc = 1 TO x
g = g * fc
NEXT fc
RETURN
END FUNCTION
bug fixed, should be OK now, the only funny thing is that because I wanted to support the atan2 function which takes 2 values is that it won't complain if you enter "(1, 2)" for example
but as long as you enter a valid math expression it should give a reasonably correct answer
-
Nice, someone can probably make a decent calculator out of this.
-
it's very basic, I mainly wrote it so I could enter coefficients for polynomial calculations like -1/3!
-
i like it !
-
to illustrate, this program calculates the reverse of a power series, the first term must <>0 and no zero term as for example the cosine function
example input
"Number of input polynomial "; 7
1
ENTER
-1/3!
ENTER
1/5!
ENTER
-1/7!
a$ = ""
CLS
PRINT
PRINT "this program computes g(y)=f(h(x)^-1)."
PRINT "where the f(i) coefficients are optional."
PRINT "if the f(i) are omitted, then g(y)=h(x)^-1 is computed."
PRINT
INPUT "Number of input polynomial "; n%
DIM a#(n%), b#(n%), c#(n%), d#(n%), e#, t#
DIM i3%, j%, k%, k0%
a$ = ""
PRINT
PRINT "Enter coefficients as prompted"
PRINT "if the coefficient is 0 then just press Enter"
PRINT
FOR i3% = 1 TO n%
PRINT USING "a(###) = "; i3%;
INPUT a$
IF a$ = "" THEN a$ = "0"
c#(i3%) = eval(a$)
NEXT i3%
PRINT
INPUT "Want to enter a transformation polynomial (y/n) "; a$
a$ = UCASE$(a$)
IF a$ <> "Y" THEN
a#(1) = 1
GOTO skipt
END IF
PRINT
PRINT "Enter transformation coefficients as prompted"
PRINT "if the coefficient is 0 then just press Enter"
PRINT
FOR i3% = 1 TO n%
PRINT USING "a(###) = "; i3%;
INPUT a$
IF a$ = "" THEN a$ = "0"
a#(i3%) = eval(a$)
NEXT i3%
skipt:
t# = 1
FOR i3% = 1 TO n%
t# = t# / c#(1)
b#(i3%) = a#(i3%) * t#
d#(i3%) = c#(i3%) * t#
NEXT i3%
IF n% < 2 THEN GOTO skip
FOR k% = 2 TO n%
e# = -d#(k%)
k0% = k% - 1
FOR i3% = k% TO n%
FOR j% = i3% TO n%
b#(j%) = e# * b#(j% - k0%) + b#(j%)
d#(j%) = e# * d#(j% - k0%) + d#(j%)
NEXT j%
NEXT i3%
NEXT k%
skip:
CLS
PRINT
PRINT "The reversed Polynomial coefficients are:"
PRINT
FOR i3% = 1 TO n%
IF b#(i3%) <> 0 THEN
PRINT USING "b(###) = "; i3%;
PRINT b#(i3%)
END IF
NEXT i3%
INPUT "press return to end"; a$
END
FUNCTION eval# (ee AS STRING)
DIM i AS INTEGER
DIM id AS INTEGER
DIM l AS INTEGER
DIM aa AS STRING
DIM d2 AS STRING
DIM e2 AS STRING
DIM s2 AS STRING
DIM ch2 AS STRING
DIM g AS DOUBLE
DIM x AS DOUBLE
DIM fc AS DOUBLE
DIM v#(20)
e2 = UCASE$(ee)
IF LEN(e2) = 0 THEN e2 = "0"
i = 1: id = 0: l = LEN(e2): s2 = ""
GOSUB scan
GOSUB expr
IF ch2 <> " " THEN
PRINT
PRINT "Syntax Error"
PRINT
END IF
eval# = v#(0)
EXIT FUNCTION
'================================
scan:
IF i > l THEN
ch2 = " "
RETURN
END IF
ch2 = MID$(e2, i, 1)
i = i + 1
IF ch2 = " " THEN GOSUB scan
RETURN
unary:
IF ch2 = "-" OR ch2 = "+" THEN
s2 = s2 + ch2
GOSUB scan
GOSUB term
aa = RIGHT$(s2, 1)
s2 = LEFT$(s2, LEN(s2) - 1)
IF aa <> "-" THEN RETURN
v#(id - 1) = -v#(id - 1)
RETURN
END IF
GOSUB factor
RETURN
gamma:
GOSUB unary
WHILE ch2 = "!"
x = v#(id - 1)
GOSUB factorial
v#(id - 1) = g
GOSUB scan
WEND
RETURN
expon:
GOSUB gamma
WHILE ch2 = "^"
GOSUB scan
GOSUB gamma
id = id - 1
v#(id - 1) = v#(id - 1) ^ v#(id)
WEND
RETURN
term:
GOSUB expon
WHILE (ch2 = "*" OR ch2 = "/")
s2 = s2 + ch2
GOSUB scan
GOSUB expon
aa = RIGHT$(s2, 1)
s2 = LEFT$(s2, LEN(s2) - 1)
IF aa = "*" THEN
id = id - 1
v#(id - 1) = v#(id - 1) * v#(id)
END IF
IF aa = "/" THEN
id = id - 1
v#(id - 1) = v#(id - 1) / v#(id)
END IF
WEND
RETURN
expr:
GOSUB term
WHILE (ch2 = "-" OR ch2 = "+")
s2 = s2 + ch2
GOSUB scan
GOSUB term
aa = RIGHT$(s2, 1)
s2 = LEFT$(s2, LEN(s2) - 1)
IF aa = "-" THEN
id = id - 1
v#(id - 1) = v#(id - 1) - v#(id)
END IF
IF aa = "+" THEN
id = id - 1
v#(id - 1) = v#(id - 1) + v#(id)
END IF
WEND
RETURN
factor:
IF ch2 = "E" THEN
v#(id) = 2.71828182845904523536
id = id + 1
GOSUB scan
RETURN
END IF
IF ch2 = "P" AND MID$(e2, i - 1, 2) = "PI" THEN
v#(id) = 3.14159265358979323846
id = id + 1
i = i + 1
GOSUB scan
RETURN
END IF
IF INSTR(".0123456789", ch2) THEN
d2 = ""
WHILE INSTR("DE.0123456789", ch2)
d2 = d2 + ch2
GOSUB scan
WEND
v#(id) = VAL(d2)
id = id + 1
RETURN
END IF
IF ch2 = "(" THEN
GOSUB scan
GOSUB expr
IF ch2 <> ")" THEN
PRINT
PRINT "Missing ')'"
END IF
GOSUB scan
RETURN
END IF
RETURN
factorial:
g = 1
FOR fc = 1 TO x
g = g * fc
NEXT fc
RETURN
END FUNCTION
-
cleaned it up a bit and put all the sub's related to the eval function inside the eval function, looks much better
-
Nice! Is it only for integers? As, It does seems to be work for decimal inputs.
-
I made a small modification, it will accept floating point numbers, however, there's no error checking for proper floating point number, but as long as it's a valid float it will work.
-
this is a quick&dirty way to add functions like trig and exp functions, see the subroutine factor for details
only the trig functions starting with "A" are implemented as an example
[edit]
see first post
-
ok, I think that this could actually be useful, a modified the factor subroutine to deal with "," separated arguments, only tested with 2 arguments as that's what's needed for the atan2 function, post right above is updated.
now you can call the eval function like:y = eval#("atan2(atan2(.5+.5,4*.5),4*.5)")
-
see first post
-
Possible next steps:
1) Variable storage/recovery for simple numbers
2) Once (1) is mastered, use the same apparatus to store not just store numbers, but any valid input. You've got an interpreter, after all.
Carry on in that spirit for about a year and you might end up with Sxript: http://barnes.x10host.com/sxript/ (http://barnes.x10host.com/sxript/)
-
Hi STxAxTIC
single-leter variables should not be too hard to implement but I think that this code is a hack at best, not suited to go beyond that.
-
fixed the bug in the eval function, should work OK now, see first post
-
5 - 5.1 = -9.999999999999964D-02
Close, but no cigar. This is why I switched to string math.
-
do have a link to your string math routines?
-
I think it's here: https://www.qb64.org/forum/index.php?topic=1093.0
Warning it's not simple.
-
I tried to compile BNC from http://www.rain.org/~mkummel/tbvault.html
but there are too many duplicated symbols and a ton of string concatenations using & which QB64 doesn't like, so I gave up
-
https://www.tapatalk.com/groups/qbasic/viewtopic.php?p=212679#p212679
The second one of the two on that page is the most updated one I have. It matches the last build in my QB64 database.
It would need a lot more additions to use as a calculator, log functions, exponents, square roots, etc. This was something it looks like I did a year ago, for fun. Since I have no practical use for it, I moved on to other things, as just what was mentioned above would have nearly doubled the program size.
Computers suck at math, which is just so ironic, but obviously programmers found ways around this base two challenge to produce working calculator apps.
Since I just decided to manipulate numbers as strings, I never explored any other possible non-string converting methods, although I did work a bit with large data types like _INTEGER64 and _FLOAT, but eventually they break, too.
Pete
-
thanks Pete
BTW, I changed the float type to _float, so now your example 5 - 5.1 = .1 :)
it was a fun distraction building and debugging this evaluator
-
thanks Pete
BTW, I changed the float type to _float, so now your example 5 - 5.1 = .1 :)
it was a fun distraction building and debugging this evaluator
new math?
-
thanks Pete
BTW, I changed the float type to _float, so now your example 5 - 5.1 = .1 :)
it was a fun distraction building and debugging this evaluator
Yep, now all you have to do is calculate the limitations, if you want to make it into a working calculator. I remember the old TI ones, from the early 1980's. They just throw a E on the screen for error, at some point. 16 digit display for the better ones, 8 digit display for the less expensive ones.
Pete
-
new math?
in my haste I forgot the - sign in the post.
-
Quick and dirty trig functions you say!?
SUB GDK_MathX
DECLARE LIBRARY
FUNCTION atan2# (BYVAL y#, BYVAL x#)
FUNCTION acos# (BYVAL x#)
FUNCTION asin# (BYVAL x#)
FUNCTION cosh# (BYVAL x#)
FUNCTION sinh# (BYVAL x#)
FUNCTION tanh# (BYVAL x#)
FUNCTION pow# (BYVAL base#, BYVAL exponent#)
END DECLARE
END SUB
Hope it helps
Unseen