Author Topic: Precision Perfect!  (Read 137 times)

B+

  • Sr. Member
  • ****
  • Posts: 329
    • View Profile
Precision Perfect!
« on: 06. March 2017, 16:49:03 »
With a fractions calculator:
Code: [Select]
'Fractions Calculator.txt for JB [B+=MGA] 2017-03-06
' inspired by fraction functions posted by tsh 2017-03-05 at JB

global err$
print
print "            () Nesting Fractions Calculator:"
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 to the 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

'tests strings
'  "( 16/10 + 2/5 ) * 3/12" >.5
while 1
    print "  Enter a fraction expression to evaluate (just enter, quits)"
    input "  Enter > ";test$
    if test$ = "" then print "  Bye!" : end
    err$ = "" 'reset err$ to nothing
    r$ = evalFrac$(test$)
    if err$ = "" then
        print "  Evaluated > ";r$
    else
        print "  Error: "; err$
    end if
    print
wend

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 before reducing
        if instr(word$(s$, i), ".") > 0 then  'convert dec to impr frac
            w$ = reduce$(dec2Frac$(word$(s$, i)))
            call wPut s$, i, w$
            call wCut s$, i + 1
        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 wPut s$, i, w$
                call wCut s$, i + 1
            end if
        end if
    next
    print "  1st pass: "; s$
    s$ = evalFracRecursive$(s$)
    evalFrac$ = improper2Mixed$(s$)
end function

function evalFracRecursive$(s$)
    scan
    pop = wIn(s$, "(") 'pop = parenthesis open place
    while pop > 0
        scan
        rPlace = pop - 1
        wc = wCnt(s$) : po = 1
        for pcp = pop + 1 to wc
            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)
            scan
            w$ = word$(s$, i)
            inner$ = inner$;w$;" "
            if wIn("( + - * / ", w$) > 0 then recurs = 1
        next
        if recurs then inner$ = evalFracRecursive$(inner$)
        begin$ = "" : ending$ = ""
        if pop > 1 then
            for i = 1 to (pop - 1)
                begin$ = begin$;word$(s$, i);" "
            next
        end if
        wc = wCnt(s$)
        if pcp + 1 <= wc then
            for i = (pcp + 1) to wc
                ending$ = ending$;word$(s$, i);" "
            next
        end if
        s$ = begin$;inner$;" ";ending$
        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)
            f1$ = mixed2Improper$(f1$) : f2$ = mixed2Improper$(f2$)
            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))
            begin$ = "" : ending$ = "" : wc = wCnt(s$)
            if p - 2 >= 1 then
                for i = 1 to p-2
                    begin$ = begin$;word$(s$, i);" "
                next
            end if
            if p + 2 <= wc then
                for i = p + 2 to wc
                    ending$ = ending$;word$(s$, i);" "
                next
            end if
            s$ = begin$;middle$;" ";ending$
            p = wIn(s$, op$)
        wend
    next
    evalFracRecursive$ = s$
end function

function dec2Frac$(dn$) 'revise to improper?
    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 wPut byref s$, p, put$ 'insert put$ in s$ as p word
    wc = wCnt(s$)
    for i = 1 to wc
        if i = p then b$ = b$;put$;" "
        b$ = b$;word$(s$, i);" "
    next
    s$ = b$
end sub

sub wCut byref s$, p
    wc = wCnt(s$)
    for i = 1 to wc
        if i <> p then b$ = b$;word$(s$, i);" "
    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


B+

  • Sr. Member
  • ****
  • Posts: 329
    • View Profile
Re: Precision Perfect!
« Reply #1 on: 07. March 2017, 10:50:01 »
Some improvements and a demo:
Code: [Select]
'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

B+

  • Sr. Member
  • ****
  • Posts: 329
    • View Profile
Re: Precision Perfect!
« Reply #2 on: 12. March 2017, 21:31:09 »
The constant e to 50 decimal places:

Code: [Select]
'e with Fraction Tools.txt for JB [B+=MGA] 2017-03-08
' how many terms does it take to match eWiki$

'kth term estimate:  e^1 = 1 + 1/1 + 2/2*1 + 3/3*2*1 +...   k/k*(k-1)*...*2*1
eWiki$ = "2.71828182845904523536028747135266249775724709369995"

lastFactorial = 1 : lastSum$ = "0/1" : i = 0
while mid$(eCurrent$, 1, 52) <> mid$(eWiki$, 1, 52)
    scan
    i = i + 1
    nextFactorial = i * lastFactorial
    nextTerm$ = str$(i);"/";str$(nextFactorial)
    nextSum$ = frac$(lastSum$, "+", nextTerm$)
    call fSplit nextSum$, n, d
    print i;"th Term : ";nextTerm$
    eCurrent$ = nOverDlimitDP$(n, d, 50)
    print i;"th estimate: ";eCurrent$
    print i;"th  compare: ";eWiki$
    print
    lastFactorial = nextFactorial
    lastSum$ = nextSum$
    if i = 50 then exit while 'see where we are
wend
print "Wiki e constant (50 decimals) reached in ";i;" terms of Taylor estimate."
print "Bye!"

function frac$(f1$, op$, f2$)
    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
    frac$ = reduce$(str$(na);"/";str$(da))
end function

'n/d as decimal (if not integer) with limit of dp decimal places
'handles case when n/d is improper fraction
function nOverDlimitDP$(n, d, dp)
    ' n, d, dp are presumed to be integers before calling this function.
    ' As integer test: int(n) = n, does not work on very large decimal numbers.
    ' Also presumed, dp > 0. This function won't check these specs.

    ' handle cases n = 0, d = 1, n < 0, d < 0, abs(n) > d
    if n = 0 then nOverDlimitDP$ = "0" : exit function
    if d = 1 or d = -1 then nOverDlimitDP$ = str$(n) : exit function
    if n < 0 then s$ = "-" : n = n * -1
    if d < 0 then
        if s$ = "-" then s$ = "" else s$ = "-"
        d = d * -1
    end if
    i = int(n/d) : i$ = str$(i)
    if i <> 0 then n = n - i * d

    if n <> 0 then
        r = n * 10
        while len(out$) < dp and r <> 0
            while r - d < 0
                out$ = out$;"0"
                if len(out$) >= dp then exit while
                r = r * 10
            wend
            div = int(r/d)
            out$ = out$;str$(div)
            r = (r - div * d) * 10
        wend
        out$ = left$(out$, dp)  'make sure decimal places is correct
        nOverDlimitDP$ = s$;i$;".";out$
    else
        nOverDlimitDP$ = s$;i$
    end if
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 f$, 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

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