KISS MY ASCII GOOD PI!

[Pete]

So I updated my pi approximation routine with my faster string math addition/subtraction/multiplication routine and got...

3.14149 and change in about 15-minutes. Now my system is Mem/CPU challenged, so I suspect your systems might be able to turn and burn the 10,000 iterations it took to achieve that in under 5-minutes. Anyway pi by Liebniz's method (1 - (1/3) + (1/5)... = pi /4) appears valid, but to get anything close to accurate would take maybe what, 50,000 iterations? Also, I cheated a bit by not increasing the digit limit to over 1,000 and I used the betatest% variable to direct the routine to cut the final division calculation to 32 digits. I did that because I have not addressed a faster way to do long division by chunks or some other method in my new improved string math routines. If I left that last cheat out, the difference would not be all that great and the calculation time would probably be a few hours and burn up the CPU.

Anyway, if you are impatient, just play around with lowering the loops. It will do 500 very fast.

Code: (Select All)

DIM SHARED betatest%: betatest% = -2
WIDTH 160, 43
_SCREENMOVE 0, 0
limit&& = 128
j = -1
FOR i = 1 TO 10000
    IF betatest% <> -1 THEN IF i MOD 100 = 0 THEN PRINT "Loop"; i
    j = j + 2

    IF oldd$ = "" THEN
        d$ = "1": oldd$ = "1": oldn$ = "1": n$ = "1"
    ELSE
        d$ = LTRIM$(STR$(j))
        ' 2nd denominator * 1st numerator.
        a$ = d$: b$ = oldn$: op$ = "*"
        CALL string_math(a$, op$, b$, x$, limit&&)
        m1$ = x$
        ' 1st denominator * 2nd numerator.
        a$ = oldd$: b$ = n$
        CALL string_math(a$, op$, b$, x$, limit&&)
        m2$ = x$
        ' Get common denominator
        a$ = d$: b$ = oldd$
        CALL string_math(a$, op$, b$, x$, limit&&)
        d$ = x$
        a$ = m1$: b$ = m2$: IF i / 2 = i \ 2 THEN op$ = "-" ELSE op$ = "+"
        CALL string_math(a$, op$, b$, x$, limit&&)
        REM  PRINT "oldn$ = "; oldn$; " oldd$ = "; oldd$, "n$ = "; x$; " d$ = "; d$
        IF betatest% = -1 THEN PRINT "n$ = "; x$; " d$ = "; d$;: COLOR 14, 0: PRINT " "; op$; " 1/"; LTRIM$(STR$(j)): COLOR 7, 0
        oldn$ = x$: oldd$ = d$
    END IF
NEXT

n$ = x$
a$ = x$: b$ = d$: op$ = "/"

IF betatest% = -1 THEN ' Reduce for speed increase
    limit&& = 32
    j&& = LEN(b$) - LEN(a$)
    a$ = MID$(a$, 1, 32)
    b$ = MID$(b$, 1, j&& + 32)
    PRINT: PRINT "Numerator = "; a$; " "; "Denominator = "; b$
ELSE
    IF betatest% = -2 THEN
        limit&& = 32
        j&& = LEN(b$) - LEN(a$)
        a$ = MID$(a$, 1, 32)
        b$ = MID$(b$, 1, j&& + 32)
        PRINT: PRINT "Numerator = "; a$; " "; "Denominator = "; b$
    ELSE
        PRINT "Begin long division...": PRINT
    END IF
END IF

CALL string_math(a$, op$, b$, x$, limit&&)

a$ = x$: b$ = "4": op$ = "*"
CALL string_math(a$, op$, b$, x$, limit&&)
PRINT: PRINT "pi = "; x$
END

SUB string_math (stringmatha$, operator$, stringmathb$, runningtotal$, limit&&)
    DIM AS _INTEGER64 a, c, aa, cc, s, ss

    SELECT CASE operator$
        CASE "+", "-"
            GOTO string_add_subtract_new
        CASE "*"
            GOTO string_multiply_new
        CASE "/"
            GOTO string_divide
        CASE ELSE
            PRINT "Error, no operator selected. operator$ = "; operator$
    END SELECT

    string_divide:
    terminating_decimal% = 0: divsign% = 0: divremainder& = 0: divremainder$ = "": divplace& = 0: divplace2& = 0: quotient$ = "": divcarry& = 0
    operationdivision% = -1
    divbuffer& = LEN(stringmathb$) - LEN(stringmatha$)
    IF divbuffer& < 0 THEN divbuffer& = 0
    d2dividend$ = stringmatha$
    d1divisor$ = stringmathb$
    IF LEFT$(d1divisor$, 1) = "0" AND LEN(d1divisor$) = 1 THEN PRINT "Division by zero not allowed.": divsign% = 0: operationdivision% = 0: EXIT SUB
    IF LEFT$(d1divisor$, 1) = "-" THEN divsign% = -1: d1divisor$ = MID$(d1divisor$, 2)
    IF LEFT$(d2dividend$, 1) = "-" THEN
        IF divsign% THEN
            divsign% = 0
        ELSE
            divsign% = -1
        END IF
        d2dividend$ = MID$(d2dividend$, 2)
    END IF
    IF INSTR(d1divisor$, ".") <> 0 THEN
        DO UNTIL RIGHT$(d1divisor$, 1) <> "0"
            d1divisor$ = MID$(d1divisor$, 1, LEN(d1divisor$) - 1) ' Strip off trailing zeros
        LOOP
        divplace& = LEN(d1divisor$) - INSTR(d1divisor$, ".")
        d1divisor$ = MID$(d1divisor$, 1, INSTR(d1divisor$, ".") - 1) + MID$(d1divisor$, INSTR(d1divisor$, ".") + 1) ' Strip off decimal point.
        DO UNTIL LEFT$(d1divisor$, 1) <> "0"
            d1divisor$ = MID$(d1divisor$, 2) ' Strip off leading zeros for divisors smaller than .1
        LOOP
    END IF

    IF INSTR(d2dividend$, ".") <> 0 THEN
        d2dividend$ = d2dividend$ + STRING$(divplace& - LEN(d2dividend$) - INSTR(d2dividend$, "."), "0") ' Add any zeros based on the length of dividend at decimal - length of divisor at decimal. If less than zero, nothing added.
        divplace2& = INSTR(d2dividend$, ".")
        DO UNTIL RIGHT$(d2dividend$, 1) <> "0"
            d2dividend$ = MID$(d2dividend$, 1, LEN(d2dividend$) - 1) ' Strip off trailing zeros
        LOOP
        d2dividend$ = MID$(d2dividend$, 1, INSTR(d2dividend$, ".") - 1) + MID$(d2dividend$, INSTR(d2dividend$, ".") + 1) ' Strip off decimal point.
    ELSE
        d2dividend$ = d2dividend$ + STRING$(divplace&, "0") ' Add any zeros based on the length of dividend at decimal - length of divisor at decimal. If less than zero, nothing added.
        divplace& = 0
    END IF
    DO
        DO
            divremainder& = divremainder& + 1: divremainder$ = divremainder$ + MID$(d2dividend$, divremainder&, 1)
            IF MID$(d2dividend$, divremainder&, 1) = "" THEN
                IF divremainder$ = STRING$(LEN(divremainder$), "0") AND LEN(quotient$) > LEN(d2dividend$) THEN
                    divflag% = -1
                    terminating_decimal% = -1
                    EXIT DO
                END IF
                divcarry& = divcarry& + 1
                IF divcarry& = 1 THEN divplace3& = divremainder& - 1
                IF divcarry& > limit&& + 1 + divbuffer& THEN
                    divflag% = -2: EXIT DO
                END IF
                divremainder$ = divremainder$ + "0" ' No more digits to bring down.
            END IF
            IF LEN(divremainder$) > LEN(d1divisor$) OR LEN(divremainder$) = LEN(d1divisor$) AND divremainder$ >= d1divisor$ THEN EXIT DO
            quotient$ = quotient$ + "0"
        LOOP
        IF divflag% THEN divflag% = 0: EXIT DO
        FOR div_i% = 9 TO 1 STEP -1
            stringmatha$ = LTRIM$(STR$(div_i%)): stringmathb$ = d1divisor$
            m_product$ = "": GOSUB string_multiply_new: m_product$ = runningtotal$
            tempcutd$ = divremainder$ ' divremainder$ can be 00 or other leading zero values.
            DO
                IF LEN(tempcutd$) = 1 THEN EXIT DO
                IF LEFT$(tempcutd$, 1) = "0" THEN
                    tempcutd$ = MID$(tempcutd$, 2)
                ELSE
                    EXIT DO
                END IF
            LOOP
            IF LEN(tempcutd$) > LEN(m_product$) OR LEN(tempcutd$) = LEN(m_product$) AND m_product$ <= tempcutd$ THEN EXIT FOR
        NEXT
        quotient$ = quotient$ + LTRIM$(STR$(div_i%))
        stringmatha$ = LTRIM$(STR$(div_i%)): stringmathb$ = d1divisor$
        m_product$ = "": GOSUB string_multiply: m_product$ = runningtotal$
        operator$ = "-"
        stringmatha$ = divremainder$
        stringmathb$ = m_product$
        GOSUB string_add_subtract_new
        stringmatha$ = runningtotal$ '*'
        divremainder$ = stringmatha$
        operator$ = "/"
    LOOP

    IF divplace& = 0 AND divplace2& = 0 THEN divplace& = divplace3&
    IF divplace2& THEN divplace& = divplace& + divplace2& - 1
    IF quotient$ = "" THEN divplace& = 0 ' dividend is zero.
    IF divplace& OR divplace2& THEN
        quotient$ = MID$(quotient$, 1, divplace&) + "." + MID$(quotient$, divplace& + 1)
        DO UNTIL RIGHT$(quotient$, 1) <> "0"
            quotient$ = MID$(quotient$, 1, LEN(quotient$) - 1) ' Strip off trailing zeros
        LOOP
        IF RIGHT$(quotient$, 1) = "." THEN quotient$ = MID$(quotient$, 1, LEN(quotient$) - 1) ' Strip off abandoned decimal.
    END IF
    DO UNTIL LEFT$(quotient$, 1) <> "0"
        quotient$ = MID$(quotient$, 2) ' Strip off leading zeros
    LOOP
    IF quotient$ = "" THEN quotient$ = "0": divsign% = 0
    operationdivision% = 0
    stringmathb$ = quotient$: quotient$ = ""

    IF stringmathb$ = "overflow" THEN divsign% = 0: operationdivision% = 0: EXIT SUB

    runningtotal$ = stringmathb$: stringmathb$ = ""
    IF divsign% THEN runningtotal$ = "-" + runningtotal$

    IF stringmathround$ <> "" THEN runningtotal$ = runningtotal$ + stringmathround$
    operationdivision% = 0

    EXIT SUB
    '------------------------------------------------------------------------
    string_multiply:
    m_decimal_places& = 0: m_product$ = ""
    fac1$ = stringmatha$: fac2$ = stringmathb$ ' Make numbers whole numbers and remove any - sign.
    IF LEFT$(fac1$, 1) = "-" THEN fac1$ = MID$(fac1$, 2): m_sign% = -1
    IF LEFT$(fac2$, 1) = "-" THEN fac2$ = MID$(fac2$, 2): IF m_sign% THEN m_sign% = 0 ELSE m_sign% = -1
    IF INSTR(fac1$, ".") <> 0 THEN m_decimal_places& = LEN(fac1$) - INSTR(fac1$, "."): fac1$ = MID$(fac1$, 1, INSTR(fac1$, ".") - 1) + MID$(fac1$, INSTR(fac1$, ".") + 1)
    IF INSTR(fac2$, ".") <> 0 THEN m_decimal_places& = m_decimal_places& + LEN(fac2$) - INSTR(fac2$, "."): fac2$ = MID$(fac2$, 1, INSTR(fac2$, ".") - 1) + MID$(fac2$, INSTR(fac2$, ".") + 1)
    FOR m_i& = LEN(fac2$) TO 1 STEP -1 ' Multiply each charater top and bottom.
        m_k& = m_l&
        m_x2$ = MID$(fac2$, m_i&, 1)
        FOR m_j& = LEN(fac1$) TO 1 STEP -1
            m_x1$ = MID$(fac1$, m_j&, 1)
            IF m_product$ <> "" THEN
                m_add$ = LTRIM$(STR$(VAL(m_x1$) * VAL(m_x2$))) + STRING$(m_k&, "0")
                m_t& = 0: m_xproduct$ = "": m_carry% = 0
                DO ' Add multiplied characters together.
                    m_x3$ = MID$(m_add$, LEN(m_add$) - m_t&, 1)
                    m_x4$ = MID$(m_product$, LEN(m_product$) - m_t&, 1)
                    IF m_x3$ = "" AND m_x4$ = "" THEN
                        IF m_carry% THEN m_xproduct$ = "1" + m_xproduct$
                        EXIT DO
                    END IF
                    m_g% = VAL(m_x3$) + VAL(m_x4$) + m_carry%
                    IF m_g% >= 10 THEN m_g% = m_g% - 10: m_carry% = 1 ELSE m_carry% = 0
                    m_xproduct$ = LTRIM$(STR$(m_g%)) + m_xproduct$
                    m_t& = m_t& + 1
                LOOP
                m_product$ = m_xproduct$: m_xproduct$ = ""
            ELSE
                m_product$ = LTRIM$(STR$(VAL(m_x1$) * VAL(m_x2$))) + STRING$(m_k&, "0") ' First loop makes variable here.
            END IF
            m_k& = m_k& + 1 ' Adds trailing zeros multiplication
        NEXT
        m_l& = m_l& + 1 ' Used to reset value for m_k& adding one trailing zer for each loop.
    NEXT
    fac1$ = "": fac2$ = "": m_l& = 0: m_k& = 0: m_t& = 0
    IF m_decimal_places& > LEN(m_product$) THEN m_product$ = STRING$(m_decimal_places& - LEN(m_product$), "0") + m_product$ ' Add any leading zeros to a decimal. Ex: .02 * .01 is factored as 002. It needs one leading zero before adding the decimal point, .0002.
    IF m_decimal_places& AND m_product$ <> "0" THEN ' Replace any decimal point.
        m_product$ = MID$(m_product$, 1, LEN(m_product$) - m_decimal_places&) + "." + MID$(m_product$, LEN(m_product$) - m_decimal_places& + 1)
    END IF
    DO UNTIL LEFT$(m_product$, 1) <> "0" ' Remove leading zeros.
        m_product$ = MID$(m_product$, 2)
    LOOP
    IF m_decimal_places& THEN
        DO UNTIL RIGHT$(m_product$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
            m_product$ = MID$(m_product$, 1, LEN(m_product$) - 1)
        LOOP
    END IF
    IF m_product$ = "" THEN m_product$ = "0": m_sign% = 0
    IF RIGHT$(m_product$, 1) = "." THEN m_product$ = MID$(m_product$, 1, LEN(m_product$) - 1) ' Remove decimal from the end of an integer total.
    IF operationdivision% THEN m_sign% = 0: RETURN
    stringmathb$ = m_product$: m_product$ = ""

    IF stringmathb$ = "overflow" THEN EXIT SUB

    runningtotal$ = stringmathb$: stringmathb$ = ""
    IF m_sign% THEN runningtotal$ = "-" + runningtotal$: m_sign% = 0
    EXIT SUB

    string_add_subtract:
    IF INSTR(stringmatha$, ".") <> 0 THEN ' Evaluate sum for decimal fraction.
        sumplace& = LEN(stringmatha$) - INSTR(stringmatha$, ".")
        stringmatha$ = MID$(stringmatha$, 1, INSTR(stringmatha$, ".") - 1) + MID$(stringmatha$, INSTR(stringmatha$, ".") + 1) ' Strip out decimal
    END IF
    IF INSTR(stringmathb$, ".") <> 0 THEN ' Evaluate number for decimal fraction.
        numplace& = LEN(stringmathb$) - INSTR(stringmathb$, ".")
        stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1) ' Strip out decimal
    END IF
    IF sumplace& > numplace& THEN addsubplace& = sumplace& ELSE addsubplace& = numplace&
    IF sumplace& > addsubplace& THEN
        stringmatha$ = stringmatha$ + STRING$(sumplace& - addsubplace&, "0")
    ELSEIF addsubplace& > sumplace& THEN
        stringmatha$ = stringmatha$ + STRING$(addsubplace& - sumplace&, "0")
    END IF
    IF numplace& > addsubplace& THEN
        stringmathb$ = stringmathb$ + STRING$(numplace& - addsubplace&, "0")
    ELSEIF addsubplace& > numplace& THEN
        stringmathb$ = stringmathb$ + STRING$(addsubplace& - numplace&, "0")
    END IF ' END Decimal evaluations.

    IF LEFT$(stringmatha$, 1) = "-" THEN sign_input$ = "-" ELSE sign_input$ = "+"
    IF LEFT$(stringmathb$, 1) = "-" THEN sign_total$ = "-" ELSE sign_total$ = "+"

    addsubsign% = 0
    SELECT CASE sign_input$ + operator$ + sign_total$
        CASE "+++", "+--"
            operator$ = "+"
            IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
        CASE "++-", "+-+"
            operator$ = "-"
            IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
            GOSUB string_comp
            IF gl% < 0 THEN SWAP stringmatha$, stringmathb$: addsubsign% = -1
        CASE "---", "-++"
            operator$ = "-"
            IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
            IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
            GOSUB string_comp
            IF gl% < 0 THEN SWAP stringmatha$, stringmathb$: addsubsign% = -1
        CASE "--+", "-+-"
            operator$ = "+"
            IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
            IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
            addsubsign% = -1
    END SELECT

    IF LEN(stringmatha$) > LEN(stringmathb$) THEN
        stringmathb$ = STRING$(LEN(stringmatha$) - LEN(stringmathb$), "0") + stringmathb$
    ELSEIF LEN(stringmatha$) < LEN(stringmathb$) THEN
        stringmatha$ = STRING$(LEN(stringmathb$) - LEN(stringmatha$), "0") + stringmatha$
    END IF
    addsubx1$ = ""

    SELECT CASE operator$
        CASE "+", "="
            FOR addsubii& = LEN(stringmatha$) TO 1 STEP -1
                addsubx1% = VAL(MID$(stringmatha$, addsubii&, 1)) + VAL(MID$(stringmathb$, addsubii&, 1)) + addsubcarry%
                IF addsubx1% > 9 THEN addsubx1% = addsubx1% - 10: addsubcarry% = 1 ELSE addsubcarry% = 0
                addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
            NEXT
            IF addsubcarry% THEN addsubx1$ = "1" + addsubx1$: addsubcarry% = 0
            GOSUB replace_decimal
        CASE "-"
            FOR addsubii& = LEN(stringmatha$) TO 1 STEP -1
                addsubx1% = VAL(MID$(stringmatha$, addsubii&, 1)) - VAL(MID$(stringmathb$, addsubii&, 1)) + addsubcarry%
                IF addsubx1% < 0 THEN addsubx1% = addsubx1% + 10: addsubcarry% = -1 ELSE addsubcarry% = 0
                addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
            NEXT
            IF addsubx1$ <> "" AND addsubx1$ <> STRING$(LEN(addsubx1$), "0") THEN GOSUB replace_decimal
            DO UNTIL LEFT$(addsubx1$, 1) <> "0" ' Remove leading zeros.
                addsubx1$ = MID$(addsubx1$, 2)
            LOOP
            IF addsubx1$ = "" THEN
                addsubx1$ = "0": addsubsign% = 0
            ELSE
                IF addsubcarry% THEN addsubx1$ = "-" + addsubx1$: addsubcarry% = 0
            END IF
    END SELECT

    IF addsubsign% THEN
        IF LEFT$(addsubx1$, 1) = "-" THEN addsubx1$ = MID$(addsubx1$, 2) ELSE addsubx1$ = "-" + addsubx1$
    END IF
    stringmatha$ = addsubx1$: addsubx1$ = ""
    IF operationdivision% THEN RETURN
    stringmathb$ = stringmatha$: stringmatha$ = ""
    IF LEFT$(stringmathb$, 1) = "-" THEN
        stringmathb$ = MID$(stringmathb$, 2)
        n2sign$ = "-"
    ELSE
        n2sign$ = ""
    END IF

    IF stringmathb$ = "overflow" THEN n2sign$ = "": EXIT SUB

    runningtotal$ = n2sign$ + stringmathb$: n2sign$ = ""
    EXIT SUB


    '------------------------------------------------------------------------
    string_add_subtract_new:
    a1$ = stringmatha$: b1$ = stringmathb$
    s = 18: i&& = 0: c = 0

    a$ = stringmatha$: b$ = stringmathb$: op$ = operator$

    IF op$ = "-" THEN
        IF LEFT$(b$, 1) = "-" THEN b$ = MID$(b$, 2) ELSE b$ = "-" + b$
    END IF

    IF INSTR(a$, ".") <> 0 OR INSTR(b$, ".") <> 0 THEN
        decimal% = -1
        IF INSTR(a$, ".") <> 0 THEN
            dec_a&& = LEN(MID$(a$, INSTR(a$, ".") + 1))
            a$ = MID$(a$, 1, INSTR(a$, ".") - 1) + MID$(a$, INSTR(a$, ".") + 1)
        END IF
        IF INSTR(b$, ".") <> 0 THEN
            dec_b&& = LEN(MID$(b$, INSTR(b$, ".") + 1))
            b$ = MID$(b$, 1, INSTR(b$, ".") - 1) + MID$(b$, INSTR(b$, ".") + 1)
        END IF
        ' Line up decimal places by inserting trailing zeros.
        IF dec_b&& > dec_a&& THEN
            j&& = dec_b&&
            a$ = a$ + STRING$(dec_b&& - dec_a&&, "0")
        ELSE
            j&& = dec_a&&
            b$ = b$ + STRING$(dec_a&& - dec_b&&, "0")
        END IF
    END IF

    IF LEFT$(a$, 1) = "-" OR LEFT$(b$, 1) = "-" THEN
        IF LEFT$(a$, 1) = "-" AND LEFT$(b$, 1) = "-" THEN
            sign$ = "--": a$ = MID$(a$, 2): b$ = MID$(b$, 2)
        ELSE
            IF LEFT$(a$, 1) = "-" THEN a$ = MID$(a$, 2): sign_a$ = "-"
            IF LEFT$(b$, 1) = "-" THEN b$ = MID$(b$, 2): sign_b$ = "-"

            IF LEFT$(a1$, 1) = "-" THEN a1_x$ = MID$(a1$, 2) ELSE a1_x$ = a1$
            IF LEFT$(b1$, 1) = "-" THEN b1_x$ = MID$(b1$, 2) ELSE b1_x$ = b1$

            string_compare a1_x$, b1_x$, gl%

            IF gl% < 0 THEN
                IF LEN(sign_b$) THEN sign$ = "-": SWAP a$, b$
            ELSE
                IF LEN(sign_a$) THEN sign$ = "-": SWAP sign_a$, sign_b$
            END IF
        END IF
    END IF

    z$ = ""

    DO
        i&& = i&& + s
        x1$ = MID$(a$, LEN(a$) - i&& + 1, s)
        x2$ = MID$(b$, LEN(b$) - i&& + 1, s)
        a = VAL(sign_a$ + x1$) + VAL(sign_b$ + x2$) + c
        IF x1$ + x2$ = "" AND c = 0 THEN EXIT DO
        c = 0
        IF a > VAL(STRING$(s, "9")) THEN a = a - 10 ^ s: c = 1
        IF a < 0 THEN a = a + 10 ^ s: c = -1
        tmp$ = LTRIM$(STR$(a))
        z$ = STRING$(LEN(x1$) - LEN(tmp$), "0") + tmp$ + z$
    LOOP

    IF decimal% THEN
        z$ = MID$(z$, 1, LEN(z$) - j&&) + "." + MID$(z$, LEN(z$) - j&& + 1)
    END IF

    ' Remove any leading zeros.
    DO
        IF LEFT$(z$, 1) = "0" THEN z$ = MID$(z$, 2) ELSE EXIT DO
    LOOP

    IF z$ = "" OR z$ = "0" THEN z$ = "0" ELSE z$ = LEFT$(sign$, 1) + z$

    runningtotal$ = z$ '*'

    sign$ = "": sign_a$ = "": sign_b$ = "": i&& = 0: j&& = 0: decimal% = 0: c = 0
    IF operationdivision% THEN RETURN
    EXIT SUB

    '------------------------------------------------------------------------
    string_multiply_new:
    z$ = "": sign$ = "": mult&& = 0: h&& = 0: i&& = 0: j&& = 0: c = 0: decimal% = 0
    zz$ = "": ii&& = 0: jj&& = 0
    s = 8: ss = 18

    a$ = stringmatha$: b$ = stringmathb$

    IF INSTR(a$, "-") <> 0 OR INSTR(b$, "-") <> 0 THEN
        IF INSTR(a$, "-") <> 0 AND INSTR(b$, "-") <> 0 THEN
            a$ = MID$(a$, 2): b$ = MID$(b$, 2)
        ELSE
            IF INSTR(a$, "-") <> 0 THEN a$ = MID$(a$, 2) ELSE b$ = MID$(b$, 2)
            sign$ = "-"
        END IF
    END IF

    IF INSTR(a$, ".") <> 0 OR INSTR(b$, ".") <> 0 THEN
        decimal% = -1
        IF INSTR(a$, ".") <> 0 THEN
            dec_a&& = LEN(MID$(a$, INSTR(a$, ".") + 1))
            a$ = MID$(a$, 1, INSTR(a$, ".") - 1) + MID$(a$, INSTR(a$, ".") + 1)
        END IF
        IF INSTR(b$, ".") <> 0 THEN
            dec_b&& = LEN(MID$(b$, INSTR(b$, ".") + 1))
            b$ = MID$(b$, 1, INSTR(b$, ".") - 1) + MID$(b$, INSTR(b$, ".") + 1)
        END IF
    END IF

    IF LEN(a$) < LEN(b$) THEN SWAP a$, b$

    DO
        h&& = h&& + s: i&& = 0
        x2$ = MID$(b$, LEN(b$) - h&& + 1, s)
        WHILE -1
            i&& = i&& + s
            x1$ = MID$(a$, LEN(a$) - i&& + 1, s)
            a = VAL(sign_a$ + x1$) * VAL(sign_b$ + x2$) + c
            c = 0
            tmp$ = LTRIM$(STR$(a))
            IF LEN(tmp$) > s THEN c = VAL(MID$(tmp$, 1, LEN(tmp$) - s)): tmp$ = MID$(tmp$, LEN(tmp$) - s + 1)
            z$ = STRING$(LEN(x1$) - LEN(tmp$), "0") + tmp$ + z$
            IF i&& >= LEN(a$) AND c = 0 THEN EXIT WHILE
        WEND

        jj&& = jj&& + 1

        IF jj&& > 1 THEN
            ii&& = 0: cc = 0
            aa$ = holdaa$
            bb$ = z$ + STRING$((jj&& - 1) * s, "0")

            DO
                ii&& = ii&& + ss
                xx1$ = MID$(aa$, LEN(aa$) - ii&& + 1, ss)
                xx2$ = MID$(bb$, LEN(bb$) - ii&& + 1, ss)
                aa = VAL(xx1$) + VAL(xx2$) + cc
                IF xx1$ + xx2$ = "" AND cc = 0 THEN EXIT DO ' Prevents leading zeros.
                cc = 0
                IF aa > VAL(STRING$(ss, "9")) THEN aa = aa - 10 ^ ss: cc = 1
                tmp$ = LTRIM$(STR$(aa))
                zz$ = STRING$(LEN(xx1$) - LEN(tmp$), "0") + tmp$ + zz$
            LOOP

            DO WHILE LEFT$(zz$, 1) = "0"
                IF LEFT$(zz$, 1) = "0" THEN zz$ = MID$(zz$, 2)
            LOOP
            IF zz$ = "" THEN zz$ = "0"

            holdaa$ = zz$
        ELSE
            holdaa$ = z$ + STRING$(jj&& - 1, "0")
        END IF

        z$ = "": zz$ = ""

    LOOP UNTIL h&& >= LEN(b$)

    z$ = holdaa$

    IF decimal% THEN
        DO UNTIL LEN(z$) >= dec_a&& + dec_b&&
            z$ = "0" + z$
        LOOP

        z$ = MID$(z$, 0, LEN(z$) - (dec_a&& + dec_b&& - 1)) + "." + MID$(z$, LEN(z$) - (dec_a&& + dec_b&&) + 1)

        DO UNTIL RIGHT$(z$, 1) <> "0" AND RIGHT$(z$, 1) <> "."
            z$ = MID$(z$, 1, LEN(z$) - 1)
        LOOP
    END IF

    IF z$ = "" OR z$ = "0" THEN z$ = "0": ELSE z$ = sign$ + z$

    decimal% = 0: sign$ = ""

    runningtotal$ = z$
    IF operationdivision% THEN RETURN
    EXIT SUB

    replace_decimal:
    IF addsubplace& THEN
        addsubx1$ = STRING$(addsubplace& - LEN(addsubx1$), "0") + addsubx1$
        addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - addsubplace&) + "." + MID$(addsubx1$, LEN(addsubx1$) - addsubplace& + 1)
        DO UNTIL RIGHT$(addsubx1$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
            addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1)
            addsubplace& = addsubplace& - 1
        LOOP
        IF RIGHT$(addsubx1$, 1) = "." THEN addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1) ' Number is now an integer.
    END IF
    RETURN

    string_comp:
    DO
        ' Remove trailing zeros after a decimal point.
        IF INSTR(acomp$, ".") THEN
            DO UNTIL RIGHT$(acomp$, 1) <> "0" AND RIGHT$(acomp$, 1) <> "." AND RIGHT$(acomp$, 1) <> "-"
                acomp$ = MID$(acomp$, 1, LEN(acomp$) - 1)
            LOOP
        END IF
        IF INSTR(bcomp$, ".") THEN
            DO UNTIL RIGHT$(bcomp$, 1) <> "0" AND RIGHT$(bcomp$, 1) <> "." AND RIGHT$(bcomp$, 1) <> "-"
                bcomp$ = MID$(bcomp$, 1, LEN(bcomp$) - 1)
            LOOP
        END IF

        IF MID$(acomp$, 1, 2) = "-0" OR acomp$ = "" OR acomp$ = "-" THEN acomp$ = "0"
        IF MID$(bcomp$, 1, 2) = "-0" OR bcomp$ = "" OR bcomp$ = "-" THEN bcomp$ = "0"

        ' A - and +
        IF LEFT$(acomp$, 1) = "-" THEN j% = -1
        IF LEFT$(bcomp$, 1) = "-" THEN k% = -1
        IF k% = 0 AND j% THEN gl% = -1: EXIT DO
        IF j% = 0 AND k% THEN gl% = 1: EXIT DO

        ' A decimal and non-decimal.
        j% = INSTR(acomp$, ".")
        k% = INSTR(bcomp$, ".")
        IF j% = 0 AND k% THEN
            IF acomp$ = "0" THEN gl% = -1 ELSE gl% = 1
            EXIT DO
        END IF
        IF k% = 0 AND j% THEN
            IF bcomp$ = "0" THEN gl% = 1 ELSE gl% = -1
            EXIT DO
        END IF

        ' Both decimals.
        IF j% THEN
            IF acomp$ > bcomp$ THEN
                gl% = 1
            ELSEIF acomp$ = bcomp$ THEN gl% = 0
            ELSEIF acomp$ < bcomp$ THEN gl% = -1
            END IF
            EXIT DO
        END IF

        ' Both positive or both negative whole numbers.
        SELECT CASE LEN(acomp$)
            CASE IS < LEN(bcomp$)
                gl% = -1
            CASE IS = LEN(bcomp$)
                IF acomp$ = bcomp$ THEN
                    gl% = 0
                ELSEIF acomp$ > bcomp$ THEN gl% = 1
                ELSEIF acomp$ < bcomp$ THEN gl% = -1
                END IF
            CASE IS > LEN(bcomp$)
                gl% = 1
        END SELECT
        EXIT DO
    LOOP
    RETURN











END SUB

SUB string_compare (compa$, compb$, gl%)
    DO
        ' Remove trailing zeros after a decimal point.
        IF INSTR(compa$, ".") THEN
            DO UNTIL RIGHT$(compa$, 1) <> "0" AND RIGHT$(compa$, 1) <> "." AND RIGHT$(compa$, 1) <> "-"
                compa$ = MID$(compa$, 1, LEN(compa$) - 1)
            LOOP
        END IF
        IF INSTR(compb$, ".") THEN
            DO UNTIL RIGHT$(compb$, 1) <> "0" AND RIGHT$(compb$, 1) <> "." AND RIGHT$(compb$, 1) <> "-"
                compb$ = MID$(compb$, 1, LEN(compb$) - 1)
            LOOP
        END IF

        IF MID$(compa$, 1, 2) = "-0" OR compa$ = "" OR compa$ = "-" THEN compa$ = "0"
        IF MID$(compb$, 1, 2) = "-0" OR compb$ = "" OR compb$ = "-" THEN compb$ = "0"

        ' A - and +
        IF LEFT$(compa$, 1) = "-" THEN j% = -1
        IF LEFT$(compb$, 1) = "-" THEN k% = -1
        IF k% = 0 AND j% THEN gl% = -1: PRINT "1*": EXIT DO
        IF j% = 0 AND k% THEN gl% = 1: PRINT "2*": EXIT DO

        ' A decimal and non-decimal.
        j% = INSTR(compa$, ".")
        k% = INSTR(compb$, ".")

        IF j% = 0 AND k% THEN
            IF compa$ = "0" THEN gl% = -1: PRINT "4*" ELSE gl% = 1: PRINT "5*"
            EXIT DO
        END IF
        IF k% = 0 AND j% THEN
            IF compb$ = "0" THEN gl% = 1: PRINT "6*" ELSE gl% = -1: PRINT "7*"
            EXIT DO
        END IF

        ' Both decimals.
        IF j% THEN
            IF compa$ > compb$ THEN
                gl% = 1: PRINT "8*"
            ELSEIF compa$ = compb$ THEN gl% = 0: PRINT "9*"
            ELSEIF compa$ < compb$ THEN gl% = -1: PRINT "10*"
            END IF
            EXIT DO
        END IF

        ' Both positive or both negative whole numbers.
        SELECT CASE LEN(compa$)
            CASE IS < LEN(compb$)
                gl% = -1
            CASE IS = LEN(compb$)
                IF compa$ = compb$ THEN
                    gl% = 0
                ELSEIF compa$ > compb$ THEN gl% = 1
                ELSEIF compa$ < compb$ THEN gl% = -1
                END IF
            CASE IS > LEN(compb$)
                gl% = 1
        END SELECT
        EXIT DO
    LOOP
END SUB

Pete

PS Sorry about the title, Steve. (I might have got his hopes up it meant I was de-partying!)

[Kernelpanic]

Something may be wrong with your solution. Even after 2500 iterations, the result is still far from a correct result.

[Pete]

Well, if you rad the post, my routine calculates pi using Liebniz's method. My gripe with his method is it takes 10,000 iterations to get to 3.14149, which is close to 3.14159, but still not quite there yet. So what I don't like about his method is that by the time you get 10,000, you have hundreds of decimal places present in the output, but only the first 3 are correct. So his method may be valid if you can continue it over a few million iterations to what, maybe 20 or 30 decimal places? How many iterations before 128-digits can be produced correctly? Frankly, I conclude the Liebniz method to simple algorithm for a pi estimator, but not a good practical pi calculator. It certainly can't be used for any of the mega-math pi calculations we see with correct output to trillions of digits.

An issue I would have with Ramanujan's method is it depends on constantly using the square root of 2, which is an irrational number. So we have an irrational number essentially corrupting proper fractions to obtain a transcendental (irrational) number, pi. What I do like about his method is it approximates pi for the first 5-digits with many less iterations as Liebniz's method.

Out of curiosity, do you know the calculations needed to obtain the numerators and denominators in each iteration in that table of Ramanujan's method? My hunch is they are log created, which I could not use, as I have not yet created a string math log routine.

Pete

[Kernelpanic]

Out of curiosity, do you know the calculations needed to obtain the numerators and denominators in each iteration in that table of Ramanujan's method? My hunch is they are log created, which I could not use, as I have not yet created a string math log routine.

That's the problem, my problem, I can't get this damn formula converted into a computer program. There is a mistake somewhere in my implementation so far, but where?

The formula isn't any more complicated than the financial mathematical formulas that I implemented in C over 20 years ago.

Example - Now bplus gets upset again because it is a German text. 


beste bildersuche web

[Pete]

Hey, I did better than Mark (bplus), because I recognized one word... Damit. Well damn it, I never knew that was a German word!

Well my mad math skills are 40 years behind me, so that example is lost on me in present time, damit.

Pete

[Kernelpanic]

Hey, I did better than Mark (bplus), because I recognized one word... Damit. Well damn it, I never knew that was a German word!

Well my mad math skills are 40 years behind me, so that example is lost on me in present time, damit.

Pete

You enjoy math: It could be this formula conversion (photo), but I'm not sure.
Maybe I'll try to implement this in Basic.

Do you know what "gift" means in German?  

Code: (Select All)

void effektivZins( double nominal_zins, double kurs, double p_annu, int t_frei )
{
    int x, tz;
    double AZ, Co, q, t, n;
    double p, pi, g, r, rl;
    double fk1, fk2, fg1, fg2, pa;
    double pd1, pd2, qi1, qi2;
    double C1, C2, dy;
    char puffer[64];   //AZ=Abschluázahlung
                                       //Co=Ausgabekurs
                                       //p=Nominalzins
                                       //pi=Effektivzins
                                       //q=Aufzinsfaktor, q=1+i
                                       //fg=nachsch. Rentenbarwertfaktor
                                       //fk, fk2=Hilfsvariablen
                                       //r=Laufzeit
                                       //g=ganzzahliger Teil der Laufzeit
                                       //rl=restl. Laufzeit
                                       //t=Tilgungssatz
                                       //n=g+1
                                       //pa=Prozentannuit„t
                                       //pd1,2 qi1,2 C1,2 dy=Hilfsvariable

    
    printf( "\nDie Effektivverzinsung der Annuitaetenschuld mit %d tilgungsfreien ", t_frei);    
    printf( "Jahr(en) \nbetraegt : " );
    
    p = nominal_zins;
    pa = p_annu;
    tz = t_frei;
    Co = kurs;
    //------------------------------------
    q = 1 + (p / 100);
    t = pa - p;            //Tilgungssatz

    //Laufzeit (6-31) S.228
    r = (log(pa) - log(t)) / log(q);

    x = 1;
    //... und ganzzahlige Tilgungsdauer ermitteln
    rl = fmod(r, x);
    g = r - rl;

    //** Effektivzins bei P.-annuität mit tilgungsfreier Zeit S.232(77) **
    //====================================================================

    //Abschlußzahlung (6-30) und S.228
    AZ = ((100 * pow(q, g)) - (pa * ((pow(q, g) - 1) / (q - 1)))) * q;

    //Laufzeit mit Abschluázahlung S.230 unten
    n = g + 1;

    //Effektivzins nach Nährungsformel (6-7)  "Faustformel"
    pi = ((p + ((100 - Co) / n)) / Co) * 100;

    x = 1;
    //Zwei Zinsätze fr C1 und C2 ermitteln
    dy = fmod(pi, x);     //Nachkommarest ermitteln

    //Bandbreite der Zinss„tze z.B.: pi=7.2 -->  pd1=7.0 -- pd2=7.5
    if ( dy > 0.5 )
    {
        pd1 = pi - (dy / 2);
        pd2 = pi + (dy / 2);
    }
    else
    {
        pd1 = pi - dy;
        pd2 = pi + dy + 0.1;
    }
    //Effekt.- Aufzinsfaktoren der beiden Zinss„tze fr C1, C2 bestimmen
    qi1 = 1 + (pd1 / 100);
    qi2 = 1 + (pd2 / 100);

    //** Jeweils 2 (fk,fg) und nach! den Eff.-aufzinsfaktoren **

    //'fk' (6-32), wie nachschüssiger Rentenbarwertfaktor (6-18) S.215
    fk1 = (1 / pow(qi1, tz)) * ((pow(qi1, tz) - 1) / (qi1 - 1));
    fk2 = (1 / pow(qi2, tz)) * ((pow(qi2, tz) - 1) / (qi2 - 1));

    //'fg'(6-32), wie oben
    fg1 = (1 / pow(qi1, g)) * ((pow(qi1, g) - 1) / (qi1 - 1));
    fg2 = (1 / pow(qi2, g)) * ((pow(qi2, g) - 1) / (qi2 - 1));

    //Ausgabekurs (6-34) S.230, fr beide Zinss„tze
    C1 = p * fk1 + ((pa * fg1 + (AZ * (1 / pow(qi1, n)))) * (1 / pow(qi1, tz)));
    C2 = p * fk2 + ((pa * fg2 + (AZ * (1 / pow(qi2, n)))) * (1 / pow(qi2, tz)));

    //Eff.-zins Nährungslösung durch lineare Interpolation (Kopie S.642)
    pi = pd1 + ((pd2 - pd1) * ((C1 - Co) / (C1 - C2)));

    printf( "%7.5f", pi);    
    printf( " %%\n" );
    //getch();
}

[Pete]

Gift in German? As in the Democrat Party is a gift to America? Yeah, that's about as toxic as it gets.

So for math fun, I ran your code in the other pi post through my string math routines: https://qb64phoenix.com/forum/showthread...69#pid5669

I haven't got to the point of making it very user friendly yet, but you are welcome to use it if it helps you in your projects.

Pete

[Kernelpanic]

There is a misconception somewhere in the implementation of Rama's formula - but where? See screenshot.

That's right. Also the last digit is OK too. But how one get there with n = 1? (German Wiki) - I can't even do it with n = 0.

Code: (Select All)

Dim As Double pi

pi = Sqr(2) * (2510613731736 / 1130173253125)
Print pi

[Kernelpanic]

@Pete - You're thinking too complicated, I'm thinking mathematically wrong.

It's like the Gordian Knot! Where is an Alexander?  


Good night, and keep cool:

[SMcNeill]

Here's my little attempt at finding Pi.  This relies on some very impressive math formulas and such, but it can calculate up to a million digits of PI for us in about 1/10th of a second!  (Just expect QB64 to spend quite a bit longer to print the results to screen for you than that -- our print routine isn't very quick at all!)




The program here is a little too large to fit and play nicely inside a code box, so I'll attached it below for ease of download and reference.  

I hope you appreciate all the time and effort I put into this for you @Pete!  I doubt you'll ever find another method any more accurate or faster than this one!!