Post by B+ on May 11, 2020 5:36:14 GMT
' More Evaluate.txt bplus started 2020-05-10 inspired by honkytonk app
global evalErr$, pi, rad, deg, Dflag, globalx, vTopI
pi = acs(-1) : rad = pi / 180 : deg = 180 / pi '<<<<<<<<<<< true constants
Dflag = 1 : globalx = 5 : vTopI = 0 : fTopI = 0 'changeable global variables change as needed
dim varNames$(100), varValues(100), fNames$(50), fExprs$(50)
open "vf.txt" for append as #1
close #1
open "vf.txt" for input as #1
while eof(#1) = 0
line input #1, fline$
if instr(fline$, "=") then count = count + 1
wend
close #1
if count then
open "vf.txt" for input as #1
while eof(#1) = 0
line input #1, fline$
if instr(fline$, "Formulas:") then fF = 1
if instr(fline$, "=") then
if fF then
fTopI = fTopI + 1
fNames$(fTopI) = trim$(word$(fline$, 1, "=")) : fExprs$(fTopI) = trim$(word$(fline$, 2, "="))
else
vTopI = vTopI + 1
varNames$(vTopI) = trim$(word$(fline$, 1, "=")) : varValues(vTopI) = val(trim$(word$(fline$, 2, "=")))
end if
end if
wend
close #1
end if
if fTopI > 0 then curFormI = 1
do
cls
print
print " Formula Evaluation Menu"
print
print " Current Formula: ";fNames$(curFormI);" = ";fExprs$(curFormI)
print
print " 1 for setting / resetting a variable and value"
print " 2 for getting a list of variables and values"
print " 3 for settimg a new formula"
print " 4 for selecting a formula from list saved"
print " 5 for Evaluating Current Formula with current variable values"
print " 6 for saving all current variables = values and formulas"
print " 7 for quitting"
print
input " Please enter your choice number ";choice
select case choice
case 1
print : print "Please enter variable name = variable value"
input "";vv$
call setVar trim$(word$(vv$, 1, "=")), val(trim$(word$(vv$, 2, "=")))
case 2
cls
print
print " Variables Listing:"
print
for i = 1 to vTopI
print varNames$(i);" = ";varValues(i),
if i mod 5 = 0 then print
next
print : print
input " Press enter to continue...";wate$
case 3
print : print "Please enter the formula name = formula with variables and constants, space everything!"
input "";fx$
if instr(fx$, "=") then
fTopI = fTopI + 1
fNames$(fTopI) = trim$(word$(fx$, 1, "=")) : fExprs$(fTopI) = trim$(word$(fx$, 2, "="))
curFormI = fTopI
end if
case 4
cls
print
print " Formulas Listing:" : print
for i = 1 to fTopI
print " ";i;" ";fNames$(i);" = ";fExprs$(i)
next
print
input " Press a number to select or just enter to continue...";wate$
if val(wate$) > 0 and val(wate$) <= fTopI then curFormI = val(wate$)
case 5
fs$ = fExprs$(curFormI)
call preEvalSubst fs$
print " ";fs$
result = evaluate(fs$)
print " ";fNames$(curFormI);" = ";result
print
input " Press enter to continue...";wate$
case 6
open "vf.txt" for output as #1
for i = 1 to vTopI
print #1, varNames$(i);" = ";varValues(i)
next
print #1, "Formulas:"
for i = 1 to fTopI
print #1, fNames$(i);" = ";fExprs$(i)
next
close #1
print " Data filed in vf.txt"
input " Press enter to continue...";wate$
case 7
quit = 1
end select
loop until quit
print " Goodbye!"
end
function value(vName$)
for i = 1 to vTopI
scan
if trim$(varNames$(i)) = trim$(vName$) then
value = varValues(i)
exit function
end if
next
value = -99.11
end function
sub preEvalSubst byref eString$
i = 1
while word$(eString$, i) <> ""
scan
v = value(word$(eString$, i))
if v <> -99.11 then
call wsSub eString$, i, i, str$(v)
'print eString$
end if
i = i + 1
wend
end sub
sub setVar vName$, vValue 'simply store or update a variable and it's value
'try to find variable in array
for i = 1 to vTopI
if varNames$(i) = vName$ then
varValues(i) = vValue
exit sub
end if
next
'if not found add it
if vTopI + 1 <= 100 then
vTopI = vTopI +1
varNames$(vTopI) = vName$
varValues(vTopI) = vValue
else
print : print "Sorry, no more room for variables. Goodbye!"
end if
end sub
function evaluate(e$)
'make sure ( ) + * / % ^ are wrapped with spaces on your own with -
for i = 1 to len(e$) 'filter chars and count ()
c$ = lower$(mid$(e$, i, 1))
select case
case c$ = ")" : po = po - 1 : b$ = b$;" ) "
case c$ = "(" : po = po + 1 : b$ = b$;" ( "
case instr("+*/%^", c$) > 0 : b$ = b$;" ";c$;" "
case instr(" -.0123456789abcdefghijklmnopqrstuvwxyz", c$) > 0 : b$ = b$;c$
end select
if po < 0 then evalErr$ = "Too many )" : exit function
next
if po <> 0 then evalErr$ = "Unbalanced ()" : exit function
e$ = b$
for i = 1 to 3
p = wIn(e$, word$("x e pi", i))
while p > 0
select case i
case 1 : subst$ = str$(globalx)
case 2 : subst$ = str$(exp(1))
case 3 : subst$ = str$(pi)
end select
call wsSub e$, p, p, subst$
p = wIn(e$, word$("x e pi", i))
wend
next
evaluate = evalW(e$)
end function
function evalW(s$)
scan
pop = wIn(s$, "(") 'parenthesis open place
while pop > 0
scan
if pop = 1 then
fun$ = "" : lPlace = 1
else
test$ = word$(s$, pop - 1)
funPlace = wIn("sin cos tan asin acos atan log exp sqr rad deg", test$)
if funPlace > 0 then
fun$ = test$ : lPlace = pop - 1
else
fun$ = "" : lPlace = pop
end if
end if
wc = wCnt(s$) : po = 1
for i = pop + 1 to wc
if word$(s$, i) = "(" then po = po + 1
if word$(s$, i) = ")" then po = po - 1
if po = 0 then rPlace = i : exit for
next
inner$ = ""
for i = (pop + 1) to (rPlace - 1)
w$ = word$(s$, i)
inner$ = inner$;w$;" "
if wIn("( + - * / % ^", w$) > 0 then recurs = 1
next
if recurs then inner = evalW(inner$) else inner = val(inner$)
select case fun$
case "" : m = inner
case "sin" : if Dflag then m = sin(rad * inner) else m = sin(inner)
case "cos" : if Dflag then m = cos(rad * inner) else m = cos(inner)
case "tan" : if Dflag then m = tan(rad * inner) else m = tan(inner)
case "asin": if Dflag then m = deg * (asn(inner)) else m = asn(inner)
case "acos": if Dflag then m = deg * (acs(inner)) else m = acs(inner)
case "atan": if Dflag then m = deg * (atn(inner)) else m = atn(inner)
case "log"
if inner > 0 then
m = log(inner)
else
evalErr$ = "LOG only works on numbers > 0." : exit function
end if
case "exp" 'the error limit is inconsistent!!!!!!!!!!!!!!!!!
'I had to readjust limit, memory problem ????????????????????????
'this worked fine tested alone up to -708 +709
if -693 <= inner and inner <= 709 then 'your system may have different results
m = exp(inner)
else
' what the heck???? 708 works fine all alone as limit ?????
evalErr$ = "EXP only works for ABS(number) <= ??? using 693." : exit function
end if
case "sqr"
if inner >= 0 then
m = sqr(inner)
else
evalErr$ = "SQR only works for numbers >= 0." : exit function
end if
case "rad" : m = inner * rad
case "deg" : m = inner * deg
case else : evalErr$ = "Unidentified function ";fun$ : exit function
end select
call wsSub s$, lPlace, rPlace, str$(m)
pop = wIn(s$, "(")
wend
ops$ = "%^/*-+" 'all () cleared, now for binary ops
for o = 1 to 6
op$ = mid$(ops$, o, 1)
p = wIn(s$, op$)
while p > 0
scan
a = val(word$(s$, p - 1))
b = val(word$(s$, p + 1))
select case op$
case "%"
if b >= 2 then
middle$ = str$(int(a) mod int(b))
else
evalErr$ = "For a Mod b, b value < 2."
exit function
end if
case "^"
if int(b) = b or a >= 0 then
middle$ = str$(a ^ b)
else
evalErr$ = "For a ^ b, a needs to be >= 0 when b not integer."
exit function
end if
case "/"
if b <> 0 then
middle$ = str$(a / b)
else
evalErr$ = "Div by 0"
exit function
end if
case "*" : middle$ = str$(a * b)
case "-" : middle$ = str$(a - b)
case "+" : middle$ = str$(a + b)
end select
call wsSub s$, p - 1, p + 1, middle$
p = wIn(s$, op$)
wend
next
evalW = val(s$)
end function
sub wsSub byref s$, first, last, subst$ 'far more powerful
wc = wCnt(s$)
for i = 1 to wc
if first <= i and i <= last then 'do this only once!
if subF = 0 then b$ = b$;subst$;" " : subF = 1
else
b$ = b$;word$(s$, i);" "
end if
next
s$ = b$
end sub
function wIn(s$, w$) 'first in s$ that matches w$ (no spaces in w$!)
wIn = 0 : wc = wCnt(s$)
for i = 1 to wc
if w$ = word$(s$, i) then wIn = i : exit function
next
end function
function wCnt(s$) 'of default space delimited string
while word$(s$, wc + 1) <> "" : wc = wc + 1 : wend
wCnt = wc
end function
Something buggy about the way INPUT is working when you make mistakes, but if your formulas get screwed up they can be easily edited in your favorite txt editor.
"vf.txt" file:
a = 1
b = 5
c = 6
x = -2
pi = 3.1415
r = 1
Celsius = 0
Fahrenheit = 32
Formulas:
Quadratic = a * x ^ 2 + b * x + c
Quadratic Root 1 = ( -1 * b - ( b ^ 2 - 4 * a * c ) ^ .5 ) / ( 2 * a )
Quadratic Root 2 = ( -1 * b + ( b ^ 2 - 4 * a * c ) ^ .5 ) / ( 2 * a )
Circle Area = pi * r ^ 2
Circumference = 2 * pi * r
Fahrenheit2Celsius = ( Fahrenheit - 32 ) * 5 / 9
Celsius2Fahrenheit = Celsius * 9 / 5 + 32