Some improvements and a demo:
'Fractions calc 2.txt for JB [B+=MGA] 2017-03-07
' from Fractions calculator posted 2017-03-06 at JB
' edit with more powerful sub for replacing sections of string cuts 37 lines
' add another function mix2Dec$ which needed
' extendedDivision$ function, mod based on zzzabc000 algo
global err$
print
print " () Nesting Fractions Calc 2:"
print
print " For things to work as planned, put a space before and after"
print " / and - if they are to be used for division or subtraction."
Print " Otherwise, no spaces when / or - is used in a number."
print " Express fractions like: 12/36 or -4_1/3 or 99/3"
print " Notice the _ sign connects integer part to fraction part."
print
print " ( ) + * will be spaced as needed."
print " Writing integers or decimals is allowed too,"
print " eg 3.45 + 9_20/50 * 10 <enter> 97_9/20"
print " but eg ( 3.45 + 9_20/50 ) * 10 <enter> 128_1/2"
print
'while 1 'remove commented lines to use as calculator
' print " Enter a fraction expression to evaluate (just enter, quits)"
' input " Enter > ";test$
' if test$ = "" then print " Bye!" : end
' err$ = "" 'reset err$ to nothing
''''<<< save comments here but comment out next line to use as calculator
test$ = "1+1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+1/20) / 19) / 18) / 17) / 16) / 15) / 14) / 13) / 12) / 11) / 10 ) / 9) / 8) / 7) / 6) / 5) / 4) / 3) / 2"
r$ = evalFrac$(test$)
if err$ = "" then
print " Evaluated > ";mixed2Dec$(r$, 50)
''''<<< save comments here but comment out next line to use as calculator
print " Wiki e > 2.71828182845904523536028747135266249775724709369995"
else
print " Error: "; err$
end if
print " See a better estimate of e! 20 significant digits of 50."
'wend
function extendedDivision$(numerator, divisor, digitsAfterDecimal)
'modified algo, thanks zzz000abc !
do
remainder = numerator mod divisor
quotient = (numerator - remainder) / divisor
q$ = q$ + str$(quotient)
if remainder then
while remainder < divisor
remainder = remainder * 10
if divisor > remainder then q$ = q$ + "0"
wend
end if
if lenFirstQstring = 0 then lenFirstQstring = len(str$(q))
numerator = remainder
loop until remainder = 0 or (len(q$) - lenFirstQstring) >= digitsAfterDecimal
digits = lenFirstQstring + digitsAfterDecimal + 1
q$ = mid$(q$, 1, lenFirstQstring) + "." + mid$(q$, lenFirstQstring + 1, len(q$))
if len(q$) < digits then
for i = len(q$) to digits
q$ = q$ + "0"
next
end if
extendedDivision$ = q$
end function
function mixed2Dec$(mF$, decimals)
ul = instr(mF$, "_")
if ul then
i = val(mid$(mF$, 1, ul - 1)) : f$ = mid$(mF$, ul + 1)
else
f$ = mF$
end if
call fSplit f$, n, d
mixed2Dec$ = extendedDivision$(i * d + n, d, decimals)
end function
function evalFrac$(s$) 'wrapper for recursive function
'make sure ( ) + * are wrapped with spaces on your own with - and /
for i = 1 to len(s$) 'filter chars and count ()
c$ = mid$(s$, 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("/-.0 123456789_", c$) > 0 : b$ = b$;c$
end select
if po < 0 then err$ = "Too many )" : exit function
next
if po <> 0 then err$ = "Unbalanced ()" : exit function
s$ = b$ : print " Evaluating: ";s$
wc = wCnt(s$)
for i = 1 to wc 'reduce$ will check for Mixed fraction
if instr(word$(s$, i), ".") > 0 then 'convert dec to impr frac
w$ = reduce$(dec2Frac$(word$(s$, i)))
call wsSub s$, i, i, w$
else 'reduce all to cover when no operators present
if instr(word$(s$, i), "/") > 0 and word$(s$, i) <> "/" then
w$ = reduce$(word$(s$, i))
call wsSub s$, i, i, w$
end if
end if
next
print " 1st pass: "; s$
s$ = evalFracRecursive$(s$)
evalFrac$ = improper2Mixed$(s$)
end function
function evalFracRecursive$(s$)
pop = wIn(s$, "(") 'pop = parenthesis open place
while pop > 0
wc = wCnt(s$) : po = 1
for pcp = pop + 1 to wc 'pcp = parenthesis close place
if word$(s$, pcp) = "(" then po = po + 1
if word$(s$, pcp) = ")" then po = po - 1
if po = 0 then exit for
next
inner$ = "" : recurs = 0
for i = (pop + 1) to (pcp - 1)
w$ = word$(s$, i)
inner$ = inner$;w$;" "
if wIn("( + - * / ", w$) > 0 then recurs = 1
next
if recurs then inner$ = evalFracRecursive$(inner$)
call wsSub s$, pop, pcp, inner$
pop = wIn(s$, "(")
wend
for o = 1 to 4
op$ = mid$("/*-+", o, 1)
p = wIn(s$, op$)
while p > 0
f1$ = word$(s$, p - 1) : f2$ = word$(s$, p + 1)
call fSplit f1$, n1, d1 : call fSplit f2$, n2, d2
select case op$
case "+" : da = d1 * d2 : na = n1 * d2 + n2 * d1
case "-" : da = d1 * d2 : na = n1 * d2 - n2 * d1
case "*" : da = d1 * d2 : na = n1 * n2
case "/" : da = d1 * n2 : na = n1 * d2
end select
middle$ = reduce$(str$(na);"/";str$(da))
call wsSub s$, p - 1, p + 1, middle$
p = wIn(s$, op$)
wend
next
evalFracRecursive$ = s$
end function
function dec2Frac$(dn$) 'revise to improper? not necessary
dn = val(dn$)
if dn < 0 then dn = -1 * dn : si$ = "-"
i = int(dn) : frac = dn - i
if frac = 0 then dec2Frac$ = dn$ : exit function
dot = instr(dn$, ".")
d$ = str$(10 ^ (len(dn$) - dot))
n$ = mid$(dn$, dot + 1)
l$ = reduce$(n$;"/";d$)
if i then dec2Frac$ = si$;str$(i);"_";l$ else dec2Frac$ = si$;l$
end function
function reduce$(f$) 'f$ can't be a mixed fraction, fixed for improper
t$ = mixed2Improper$(f$) 'check that it is not mixed form
call fSplit t$, n, d
if n < 0 then s$ = "-": n = 0 - n
if n >= d then m = int(n/d) : n = n mod d
gcd = gcd(n, d)
if gcd > 1 then
n = n / gcd : d = d / gcd
end if
if d = 1 then ' output is not mixed fraction
reduce$ = s$;str$(n + m)
else
reduce$ = s$;str$(m * d + n);"/";str$(d)
end if
end function
function gcd(a, b)
while a <> 0 and b <> 0
if a > b then a = a mod b else b = b mod a
wend
gcd = a + b
end function
function improper2Mixed$(f$) 'use this for final output
call fSplit f$, n, d
if n < 0 then s$ = "-": n = 0 - n
if n >= d then
i = int(n / d) : n = n mod d
if n <> 0 then
improper2Mixed$ = s$;str$(i);"_";n;"/";d
else
improper2Mixed$ = s$;str$(i)
end if
else
improper2Mixed$ = f$ 'might not be improper
end if
end function
function mixed2Improper$(f$) 'or just check if mixed
andP = instr(f$, "_")
if andP > 0 then
i = val(mid$(f$, 1, andP - 1))
f1$ = mid$(f$, andP + 1)
if i < 0 then s$ = "-" : i = i * -1
call fSplit f1$, n, d
mixed2Improper$ = s$;str$(d * i + n);"/";str$(d)
else
mixed2Improper$ = f$
end if
end function
sub fSplit f$, byref n, byref d
n = val(word$(f$, 1, "/"))
d = val(word$(f$, 2, "/"))
if d = 0 then d = 1
end sub
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
