### Author Topic: Precision Perfect!  (Read 2286 times)

#### B+

• Guest
##### Precision Perfect!
« on: March 06, 2017, 03:49:03 PM »
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 JBglobal err\$printprint "            () Nesting Fractions Calculator:"printprint "  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."printprint "   ( ) + * 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" >.5while 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    printwendfunction 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 functionfunction 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 functionfunction 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 functionfunction 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 ifend functionfunction 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 + bend functionfunction 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 ifend functionfunction 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 ifend functionsub fSplit f\$, byref n, byref d    n = val(word\$(f\$, 1, "/"))    d = val(word\$(f\$, 2, "/"))    if d = 0 then d = 1end subsub 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 subsub 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 subfunction 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    nextend functionfunction wCnt(s\$) 'of default space delimited string    while word\$(s\$, wc + 1) <> "" : wc = wc + 1 : wend    wCnt = wcend function`

#### B+

• Guest
##### Re: Precision Perfect!
« Reply #1 on: March 07, 2017, 09:50:01 AM »
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 algoglobal err\$printprint "            () Nesting Fractions Calc 2:"printprint "  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."printprint "   ( ) + * 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."'wendfunction 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 functionfunction 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 functionfunction 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 functionfunction 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 functionfunction 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 functionfunction 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 ifend functionfunction 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 + bend functionfunction 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 ifend functionfunction 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 ifend functionsub fSplit f\$, byref n, byref d    n = val(word\$(f\$, 1, "/"))    d = val(word\$(f\$, 2, "/"))    if d = 0 then d = 1end subsub 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 subfunction 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    nextend functionfunction wCnt(s\$) 'of default space delimited string    while word\$(s\$, wc + 1) <> "" : wc = wc + 1 : wend    wCnt = wcend function`

#### B+

• Guest
##### Re: Precision Perfect!
« Reply #2 on: March 12, 2017, 08:31:09 PM »
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*1eWiki\$ = "2.71828182845904523536028747135266249775724709369995"lastFactorial = 1 : lastSum\$ = "0/1" : i = 0while 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 arewendprint "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 fractionfunction 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 ifend functionfunction 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 ifend functionfunction 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 + bend functionsub fSplit f\$, byref n, byref d    n = val(word\$(f\$, 1, "/"))    d = val(word\$(f\$, 2, "/"))    if d = 0 then d = 1end sub`