Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Roots and powers playing nicely together...
#1
So I decided on the long division methods over the approximation methods for nth roots then thought, why not apply these to decimal powers? It worked, because of the inverse relationship. So this is really choppy right now, and needs more work, but it looks like it is getting the digits correct.

What does it do?

Nth roots for whole numbers greater than zero.
Decimal roots for whole numbers greater than zero.
Mixed roots (Number >1 with decimal) for whole numbers greater than zero.
Powers for whole numbers greater than zero.
Decimal powers for whole numbers greater than zero.
Mixed powers (Power >1 with decimal) for whole numbers greater than zero.

So after I debug this for a bit, I want to see if I can figure out what needs to be done to go from whole numbers to mixed numbers with decimals and negative numbers.

Code: (Select All)
$CONSOLE:ONLY
DIM SHARED limit&&
PRINT "Demo does not display decimal point yet, and fails with zero roots/powers.": PRINT
DO
    INPUT "Input 1 for general roots or 2 for decimal powers: "; k$

    SELECT CASE k$
        CASE "1"
            LINE INPUT "Whole number: "; n$
            LINE INPUT "Root: "; r$
            j&& = INSTR(r$, ".")
            IF j&& THEN ' Decimal or mixed whole and decimal.
                IF j&& = 1 THEN ' Decimal only root. OKAY
                    pow$ = "1" + STRING$(LEN(r$) - 1, "0")
                    r$ = MID$(r$, INSTR(r$, ".") + 1)
                    ''PRINT n$, r$, pow$
                    greatest_common_factor pow$, r$
                    ''PRINT n$, r$, pow$: SLEEP
                    IF r$ <> "1" THEN GOSUB root_calc ELSE d$ = n$
                    tmp$ = d$
                    FOR i&& = 1 TO VAL(pow$) - 1
                        d$ = sm_mult$(tmp$, d$)
                    NEXT
                    sm_rt$ = d$
                    EXIT DO
                ELSE ' Mixed whole and decimal root. OKAY
                    r_whole$ = MID$(r$, 1, INSTR(r$, ".") - 1)
                    r$ = MID$(r$, INSTR(r$, ".") + 1)
                    pow$ = "1" + STRING$(LEN(r$), "0")
                    ''PRINT n$, r$, pow$
                    greatest_common_factor pow$, r$
                    ''PRINT n$, r$, pow$
                    tmp$ = sm_mult$(r_whole$, pow$)
                    r$ = sm_add$(tmp$, r$)
                    ''PRINT n$, r$: SLEEP
                    IF r$ <> "1" THEN GOSUB root_calc ELSE d$ = n$
                    ''PRINT d$: SLEEP
                    tmp$ = d$ ' Combine both parts.
                    FOR i&& = 1 TO VAL(pow$) - 1
                        tmp$ = sm_mult$(tmp$, d$)
                    NEXT
                    sm_rt$ = tmp$
                    ''PRINT sm_rt$
                    EXIT DO
                END IF
            ELSE ' Whole root. OKAY
                IF r$ <> "1" THEN GOSUB root_calc ELSE d$ = n$
            END IF
            sm_rt$ = d$
            EXIT DO
        CASE "2"
            LINE INPUT "Number: "; n$
            LINE INPUT "Power: "; pow$
            j&& = INSTR(pow$, ".")
            IF j&& THEN ' Decimal or mixed whole and decimal.
                IF j&& = 1 THEN ' Decimal only. OKAY
                    r$ = "1" + STRING$(LEN(pow$) - 1, "0")
                    pow$ = MID$(pow$, INSTR(pow$, ".") + 1)
                    ''PRINT pow$, r$
                    greatest_common_factor pow$, r$
                    ''PRINT pow$, r$: SLEEP
                    IF r$ <> "1" THEN GOSUB root_calc ELSE d$ = n$
                    sm_rt$ = d$
                    EXIT DO
                ELSE ' Mixed whole number and decimal. OKAY
                    d_whole$ = n$
                    FOR i&& = 1 TO VAL(MID$(pow$, 1, INSTR(pow$, ".") - 1)) - 1
                        d_whole$ = sm_mult$(d_whole$, n$)
                    NEXT
                    pow$ = MID$(pow$, INSTR(pow$, ".") + 1)
                    r$ = "1" + STRING$(LEN(pow$), "0")
                    greatest_common_factor pow$, r$
                    ''PRINT n$, d_whole$, r$, pow$: SLEEP
                    IF r$ <> "1" THEN GOSUB root_calc ELSE d$ = n$
                    ''PRINT d$, d_whole$: SLEEP
                    d$ = sm_mult$(d_whole$, d$)
                    sm_rt$ = d$
                    EXIT DO
                END IF
            ELSE ' Whole number OKAY
                d$ = n$
                FOR i&& = 1 TO VAL(pow$) - 1
                    d$ = sm_mult$(d$, n$)
                NEXT
                sm_rt$ = d$
                EXIT DO
            END IF
    END SELECT
LOOP

PRINT "Answer: "; sm_rt$: PRINT
RUN

root_calc:
' Decimal root conversion.
r = VAL(r$)
nu&& = INSTR(n$, ".") - 1: IF nu&& < 0 THEN nu&& = LEN(n$)
h&& = (r - (r - nu&& MOD r)) + 1
t$ = MID$(n$, 1, h&& - 1): d$ = "0"
limit&& = 16
' Calculate Pascal's Triangle.
REDIM p$(r + 1)
FOR i1&& = 1 TO r + 1
    p&& = 1
    FOR j1&& = 1 TO i1&&
        p$(j1&&) = LTRIM$(STR$(p&&))
        p&& = p&& * (i1&& - j1&&) \ j1&&
    NEXT
NEXT

DO
    oldx$ = "0"
    lcnt&& = lcnt&& + 1
    FOR j = 1 TO 10
        x$ = "0"
        FOR i&& = 1 TO r
            REM PRINT "(10 ^"; (i&& - 1); "*"; p$(i&&); "* d ^"; i&& - 1; " * j ^"; (r + 1 - i&&); ") + ";
            REM x = x + 10 ^ (i&& - 1) * VAL(p$(i&&)) * d ^ (i&& - 1) * j ^ (r + 1 - i&&)
            tmp$ = "1"
            FOR k% = 1 TO i&& - 1
                tmp$ = sm_mult$(tmp$, "10")
            NEXT
            tmp$ = sm_mult$(tmp$, p$(i&&))
            tmp2$ = "1"
            FOR k% = 1 TO i&& - 1
                tmp2$ = sm_mult$(tmp2$, d$)
            NEXT
            IF d$ = "0" AND k% = 1 THEN tmp2$ = "1" ' zero^0 = 1
            tmp3$ = sm_mult$(tmp$, tmp2$)
            tmp$ = "1"
            FOR k% = 1 TO r + 1 - i&&
                tmp$ = sm_mult$(tmp$, LTRIM$(STR$(j)))
            NEXT
            tmp2$ = sm_mult$(tmp3$, tmp$)
            x$ = sm_add(x$, tmp2$)
        NEXT
        IF LEN(x$) > LEN(t$) OR LEN(x$) = LEN(t$) AND x$ > t$ THEN EXIT FOR
        oldx$ = x$
    NEXT
    d$ = d$ + LTRIM$(STR$(j - 1))
    IF LEFT$(d$, 1) = "0" THEN d$ = MID$(d$, 2) ' Remove leading zero.
    tmp1$ = sm_sub$(t$, oldx$)
    tmp2$ = MID$(n$, h&&, r) + STRING$(r - LEN(MID$(n$, h&&, r)), "0")
    t$ = tmp1$ + tmp2$
    IF LEFT$(t$, 1) = "0" THEN t$ = MID$(t$, 2) 'Remove leading zero.
    h&& = h&& + r
    IF t$ = STRING$(LEN(t$), "0") AND h&& >= LEN(n$) OR lcnt&& = limit&& THEN EXIT DO
    IF dpx&& = 0 THEN ' Decimal point relocator. Limited to && size unless converted to string.
        IF h&& >= nu&& THEN
            dpx&& = INT(nu&& / 2 + .5)
            IF dpx&& = 0 THEN dpx&& = -1 ' Do not set to zero as -1 accomplishes the same thing and prevents ongoing loops here.
        END IF
    END IF
LOOP
dpx&& = 0 ' Remove this when all decimal situations are included.
IF dpx&& THEN
    sm_rt$ = MID$(d$, 0, dpx&& + 1) + "." + MID$(d$, dpx&& + 1)
ELSE
    sm_rt$ = d$
END IF

RETURN

SUB sm_greater_lesser (stringmatha$, stringmathb$, gl%)
    compa$ = stringmatha$: compb$ = stringmathb$ ' So original variables do not get changed.
    DO
        WHILE -1 ' Falx loop.
            IF gl% = 2 THEN EXIT WHILE ' For bypassing sign and decimal adjustments when only positive non-decimal numbers are being evaluated.
            ' 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 +
            j% = 0: k% = 0
            IF LEFT$(compa$, 1) = "-" THEN j% = -1
            IF LEFT$(compb$, 1) = "-" THEN k% = -1
            IF k% = 0 AND j% THEN gl% = -1: EXIT DO
            IF j% = 0 AND k% THEN gl% = 1: EXIT DO

            j&& = INSTR(compa$, ".")
            k&& = INSTR(compb$, ".")

            ' A starting decimal and non-decimal.
            IF j&& = 0 AND k&& = 1 THEN
                IF compa$ = "0" THEN gl% = -1 ELSE gl% = 1
                EXIT DO
            END IF
            IF k&& = 0 AND j&& = 1 THEN
                IF compb$ = "0" THEN gl% = 1 ELSE gl% = -1
                EXIT DO
            END IF

            ' remove decimals and align.
            j2&& = 0: k2&& = 0
            IF j&& <> 0 OR k&& <> 0 THEN
                IF j&& THEN compa$ = MID$(compa$, 1, INSTR(compa$, ".") - 1) + MID$(compa$, INSTR(compa$, ".") + 1): j2&& = LEN(compa$) - j&& + 1
                IF k&& THEN compb$ = MID$(compb$, 1, INSTR(compb$, ".") - 1) + MID$(compb$, INSTR(compb$, ".") + 1): k2&& = LEN(compb$) - k&& + 1
                compa$ = compa$ + STRING$(k2&& - j2&&, "0")
                compb$ = compb$ + STRING$(j2&& - k2&&, "0")
            END IF
            EXIT WHILE
        WEND

        ' Remove leading zeros if any.
        DO UNTIL LEFT$(compa$, 1) <> "0"
            compa$ = MID$(compa$, 2)
        LOOP
        IF compa$ = "" THEN compa$ = "0"
        DO UNTIL LEFT$(compb$, 1) <> "0"
            compb$ = MID$(compb$, 2)
        LOOP
        IF compb$ = "" THEN compb$ = "0"

        ' 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

SUB sm_add_subtract_router (stringmatha$, operator$, stringmathb$, runningtotal$)
    DIM AS _INTEGER64 a, c, s
    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$

            sm_greater_lesser 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$ = ""
    ' Addition and subtraction of digits.
    DO
        i&& = i&& + s
        x1$ = MID$(a$, LEN(a$) - i&& + 1, s)
        x2$ = MID$(b$, LEN(b$) - i&& + 1, s)
        IF LEN(x2$) > LEN(x1$) THEN SWAP x1$, x2$
        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 ' a will never be less than 0.
        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
END SUB

FUNCTION sm_add$ (stringmatha$, stringmathb$)
    operator$ = "+"
    sm_add_subtract_router stringmatha$, operator$, stringmathb$, runningtotal$
    sm_add$ = runningtotal$
END FUNCTION

FUNCTION sm_sub$ (stringmatha$, stringmathb$)
    operator$ = "-"
    sm_add_subtract_router stringmatha$, operator$, stringmathb$, runningtotal$
    sm_sub$ = runningtotal$
END FUNCTION

FUNCTION sm_mult$ (stringmatha$, stringmathb$)
    DIM AS _INTEGER64 a, c, aa, cc, s, ss
    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$ ' Needed so x1$ is always the largest for leading zero replacements.
    ' Multiplication of digits.
    DO
        h&& = h&& + s: i&& = 0
        x2$ = MID$(b$, LEN(b$) - h&& + 1, s)
        DO
            i&& = i&& + s
            x1$ = MID$(a$, LEN(a$) - i&& + 1, s)
            a = VAL(x1$) * VAL(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$
        LOOP UNTIL i&& >= LEN(a$) AND c = 0

        jj&& = jj&& + 1

        IF jj&& > 1 THEN
            ii&& = 0: cc = 0
            aa$ = holdaa$
            bb$ = z$ + STRING$((jj&& - 1) * s, "0")
            ' Addition only of digits.
            DO
                ii&& = ii&& + ss
                xx1$ = MID$(aa$, LEN(aa$) - ii&& + 1, ss)
                xx2$ = MID$(bb$, LEN(bb$) - ii&& + 1, ss)
                IF LEN(xx1$) < LEN(xx2$) THEN SWAP xx1$, xx2$
                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 STRING$(LEN(z$), "0") = z$ OR z$ = "" OR z$ = "0" THEN z$ = "0" ELSE z$ = sign$ + z$

    decimal% = 0: sign$ = ""

    runningtotal$ = z$
    sm_mult$ = z$
END FUNCTION

FUNCTION sm_div$ (stringmatha$, stringmathb$)
    hold_stringmatha$ = stringmatha$: hold_stringmathb$ = stringmathb$
    q$ = "": divisor$ = stringmathb$: dividend$ = stringmatha$
    DO ' Falx loop.
        'Strip off neg(s) and determine quotent sign.
        IF LEFT$(divisor$, 1) = "-" THEN divisor$ = MID$(divisor$, 2): q$ = "-"
        IF LEFT$(dividend$, 1) = "-" THEN dividend$ = MID$(dividend$, 2): IF q$ = "-" THEN q$ = "" ELSE q$ = "-"

        ' Quick results for divisor 1 or 0.
        IF dividend$ = "0" THEN q$ = "0": EXIT DO
        IF divisor$ = "1" THEN q$ = dividend$: EXIT DO
        IF divisor$ = "0" THEN q$ = "Division by zero not possible.": EXIT DO

        ' Determine decimal direction. -1 to left, +1 to right.
        gl% = 0: sm_greater_lesser divisor$, dividend$, gl%
        IF betatest% AND gl% = 1 THEN PRINT divisor$; " > "; dividend$; " Move decimal to the left"
        IF betatest% AND gl% = 0 THEN PRINT divisor$; " = "; dividend$
        IF betatest% AND gl% = -1 THEN PRINT divisor$; " < "; dividend$; " Move deciml to the right."
        IF gl% = 1 THEN ' Divisor is larger than dividend so decimal moves to the left.
            div_decimal% = -1 ' Move decimal point to the left.
        ELSEIF gl% = -1 THEN
            div_decimal% = 1 ' Move decimal point to the right.
        ELSE
            ' Divisor and dividend are the same number.
            q$ = q$ + "1": EXIT DO
        END IF
        divisor_ratio_dividend% = gl%

        ' Strip off decimal point(s) and determine places in these next 2 routines.
        dp&& = 0: dp2&& = 0: j2&& = 0
        temp&& = INSTR(divisor$, ".")
        IF temp&& THEN
            divisor$ = MID$(divisor$, 1, temp&& - 1) + MID$(divisor$, temp&& + 1)
            IF temp&& = 1 THEN
                DO UNTIL LEFT$(divisor$, 1) <> "0" ' Strip off any leading zeros on divisor only.
                    divisor$ = MID$(divisor$, 2)
                    dp&& = dp&& + 1
                LOOP
                dp&& = dp&& + 1
            ELSE
                dp&& = -(temp&& - 2)
            END IF
        ELSE
            dp&& = -(LEN(divisor$) - 1)
        END IF
        temp&& = INSTR(dividend$, ".")
        IF temp&& THEN
            dividend$ = MID$(dividend$, 1, temp&& - 1) + MID$(dividend$, temp&& + 1)
            IF temp&& = 1 THEN
                DO UNTIL LEFT$(dividend$, 1) <> "0" ' Strip off any leading zeros on divisor only.
                    dividend$ = MID$(dividend$, 2)
                    dp2&& = dp2&& + 1
                LOOP
                dp2&& = dp2&& + 1
            ELSE
                dp2&& = -(temp&& - 2)
            END IF
        ELSE
            dp2&& = -(LEN(dividend$) - 1)
        END IF
        IF betatest% THEN COLOR 11: PRINT "Divisor decimal moves "; LTRIM$(STR$(dp&&)); ". Dividend decimal moves"; LTRIM$(STR$(dp2&&)); ". Quotent decimal ABS("; LTRIM$(STR$(dp&&)); " - "; LTRIM$(STR$(dp2&&)); ") =";: COLOR 14: PRINT ABS(dp&& - dp2&&);: COLOR 11: PRINT "+ any adjustment.": COLOR 7
        dp&& = ABS(dp&& - dp2&&)

        IF betatest% THEN PRINT "Divisor 1st# = "; MID$(divisor$, 1, 1); "  Remainder 1st# = "; MID$(dividend$, 1, 1)

        ' Adjust decimal place for instances when divisor is larger than remainder the length of the divisor.
        j% = 0
        IF MID$(divisor$, 1, 1) > MID$(dividend$, 1, 1) THEN
            j% = 1
            IF betatest% THEN PRINT "Larger divisor, so move quotent decimal one place back to: ";: COLOR 14: PRINT LTRIM$(STR$(dp&&)): COLOR 7
        ELSEIF MID$(divisor$, 1, 1) = MID$(dividend$, 1, 1) THEN
            IF LEN(divisor$) = LEN(dividend$) THEN
                IF divisor$ > dividend$ THEN j% = 1
            ELSE
                IF LEN(divisor$) > LEN(dividend$) THEN
                    temp$ = dividend$ + STRING$(LEN(divisor$) - LEN(dividend$), "0")
                ELSE
                    temp$ = MID$(dividend$, 1, LEN(divisor$))
                END IF
                IF divisor$ > temp$ THEN j% = 1
            END IF
            IF betatest% THEN
                IF j% THEN PRINT "Larger divisor than dividend at LEN(divisor$), so move quotent decimal one place back to: ";: COLOR 14: PRINT LTRIM$(STR$(dp&&)): COLOR 7
                IF j% = 0 THEN PRINT "Smaller divisor than dividend at LEN(divisor$), so no quotent decimal place adjustment needed. Quotent decimal place = ";: COLOR 14: PRINT LTRIM$(STR$(dp&&)): COLOR 7
            END IF
        ELSE
            j% = 0
            IF betatest% THEN PRINT "Smaller divisor, so no quotent decimal place adjustment needed. Quotent decimal place = ";: COLOR 14: PRINT LTRIM$(STR$(dp&&)): COLOR 7
        END IF
        IF j% THEN dp&& = dp&& - div_decimal%

        origdividend$ = dividend$
        ' Determine length of divisor and dividend to begin initial long divison step.
        gl% = 2: sm_greater_lesser divisor$, MID$(dividend$, 1, LEN(divisor$)) + STRING$(LEN(divisor$) - LEN(dividend$), "0"), gl%
        divisor_ratio_dividend% = gl%
        IF gl% = 1 AND MID$(dividend$, 1, 1) <> "0" THEN
            dividend$ = MID$(dividend$, 1, LEN(divisor$) + 1) + STRING$(LEN(divisor$) + 1 - LEN(dividend$), "0")
        ELSE
            dividend$ = MID$(dividend$, 1, LEN(divisor$)) + STRING$(LEN(divisor$) - LEN(dividend$), "0")
        END IF

        ' Long divison loop. Mult and subtraction of dividend and remainder.
        k&& = 0
        IF betatest% THEN PRINT "Begin long divison loop..."
        DO
            SELECT CASE MID$(divisor$, 1, 1)
                CASE IS < MID$(dividend$, 1, 1)
                    adj_rem_len% = 0
                CASE IS = MID$(dividend$, 1, 1)
                    gl% = 2: sm_greater_lesser divisor$, MID$(dividend$, 1, LEN(divisor$)), gl%
                    IF gl% = 1 THEN adj_rem_len% = 1 ELSE adj_rem_len% = 0
                CASE IS > MID$(dividend$, 1, 1)
                    adj_rem_len% = 1
            END SELECT
            IF j2&& = 0 THEN j2&& = LEN(divisor$) + adj_rem_len%
            DO
                IF LEN(divisor$) > LEN(dividend$) THEN
                    w3&& = 0: runningtotal$ = dividend$: stringmathb$ = "0"
                    IF betatest% THEN PRINT: COLOR 3: PRINT "Divisor is larger so "; dividend$; " \ "; divisor$; " =";: COLOR 5: PRINT w3&&: COLOR 7
                    EXIT DO
                END IF
                IF LEN(divisor$) = LEN(dividend$) THEN
                    gl% = 2: sm_greater_lesser divisor$, dividend$, gl%
                    IF gl% = 1 THEN
                        w3&& = 0: runningtotal$ = dividend$: stringmathb$ = "0"
                        IF betatest% THEN COLOR 9: PRINT "Length of divisor is the same as remainder but remainder is smaller so w3&& = ";: COLOR 5: PRINT "0": COLOR 7
                        EXIT DO
                    END IF
                END IF
                SELECT CASE LEN(dividend$)
                    CASE IS > 2
                        w3&& = VAL(MID$(dividend$, 1, 2 + adj_rem_len%)) \ VAL(MID$(divisor$, 1, 2))
                        IF betatest% THEN PRINT MID$(dividend$, 1, 2 + adj_rem_len%); " \ "; MID$(divisor$, 1, 2); " =";
                    CASE ELSE
                        w3&& = VAL(MID$(dividend$, 1, 1 + adj_rem_len%)) \ VAL(MID$(divisor$, 1, 1))
                        IF betatest% THEN PRINT MID$(dividend$, 1, 1 + adj_rem_len%); " \ "; MID$(divisor$, 1, 1); " =";
                END SELECT
                IF betatest% THEN COLOR 5: PRINT " " + LTRIM$(STR$(w3&&));: COLOR 7: PRINT ". Begin mult est. at or one above this number."
                IF w3&& < 9 THEN w3&& = w3&& + 1 ELSE IF w3&& = 10 THEN w3&& = 9
                DO
                    stringmatha$ = divisor$: stringmathb$ = LTRIM$(STR$(w3&&))
                    runningtotal$ = sm_mult$(divisor$, LTRIM$(STR$(w3&&)))
                    gl% = 2: sm_greater_lesser runningtotal$, dividend$, gl%
                    IF gl% <= 0 OR w3&& = 0 THEN EXIT DO
                    IF betatest% THEN COLOR 8: PRINT "Mult loop:"; w3&&; "* "; divisor$; " = "; runningtotal$: COLOR 7
                    w3&& = w3&& - 1
                LOOP
                stringmatha$ = dividend$: stringmathb$ = runningtotal$
                sm_add_subtract_router dividend$, "-", stringmathb$, runningtotal$
                EXIT DO
            LOOP
            IF betatest% THEN PRINT LTRIM$(STR$(w3&&)); " * "; divisor$; " = "; stringmathb$; " | "; stringmatha$; " - "; stringmathb$; " = "; runningtotal$; " Remainder and drop-down = ";
            j2&& = j2&& + 1
            drop$ = "0": MID$(drop$, 1, 1) = MID$(origdividend$, j2&&, 1)
            IF runningtotal$ <> "0" THEN remainder$ = runningtotal$ ELSE remainder$ = ""
            dividend$ = remainder$ + drop$
            w3$ = LTRIM$(STR$(w3&&))
            temp$ = ""
            IF div_decimal% = -1 THEN
                IF dp&& AND k&& = 0 THEN
                    q$ = q$ + "." + STRING$(dp&& - 1, "0")
                    IF w3&& = 0 THEN w3$ = ""
                END IF
            END IF
            IF div_decimal% >= 0 THEN
                IF dp&& = k&& THEN
                    temp$ = "."
                END IF
            END IF
            q$ = q$ + w3$ + temp$
            IF betatest% AND remainder$ = "" THEN betatemp$ = CHR$(34) + CHR$(34) ELSE IF betatest% THEN betatemp$ = remainder$
            IF betatest% AND MID$(origdividend$, j2&&, 1) = "" THEN betatemp2$ = CHR$(34) + CHR$(34) ELSE IF betatest% THEN betatemp2$ = MID$(origdividend$, j2&&, 1)
            IF betatest% THEN PRINT dividend$; " ("; betatemp$; " +  "; drop$; ") at:"; j2&&; "of "; origdividend$; "  Loop"; k&& + 1; "Quotent = ";: COLOR 14, 4: PRINT q$;: COLOR 7, 0: PRINT: SLEEP
            ' Check to terminate
            IF div_decimal% = -1 THEN
                ' Decimal to left.
                IF remainder$ = "" AND MID$(origdividend$, j2&&, 1) = "" OR LEN(q$) >= limit&& THEN EXIT DO
            ELSE
                ' Decimal to right.
                IF remainder$ = "" AND MID$(origdividend$, j2&&, 1) = "" AND k&& >= dp&& OR LEN(q$) >= limit&& THEN EXIT DO
            END IF

            IF INKEY$ = " " THEN EXIT DO
            k&& = k&& + 1
        LOOP
        EXIT DO
    LOOP
    IF RIGHT$(q$, 1) = "." AND divisor$ <> "0" THEN runningtotal$ = MID$(q$, 1, LEN(q$) - 1) ELSE runningtotal$ = q$
    sm_div$ = runningtotal$
    stringmatha$ = hold_stringmatha$: stringmathb$ = hold_stringmathb$
END FUNCTION

SUB greatest_common_factor (gfca$, gfcb$)
    IF betatest% THEN PRINT "Pre-GFC "; gfca$; " / "; gfcb$
    numerator$ = gfca$: denominator$ = gfcb$
    ' Make both numbers positive.
    IF MID$(gfca$, 1, 1) = "-" THEN gfca$ = MID$(gfca$, 2)
    IF MID$(gfcb$, 1, 1) = "-" THEN gfcb$ = MID$(gfcb$, 2)

    CALL sm_greater_lesser(gfca$, gfcb$, gl%)
    IF gl% THEN SWAP gfca$, gfcb$

    DO
        stringmatha$ = gfca$: stringmathb$ = gfcb$
        runningtotal$ = sm_div$(stringmatha$, stringmathb$)
        IF INSTR(runningtotal$, ".") THEN runningtotal$ = MID$(runningtotal$, 1, INSTR(runningtotal$, ".") - 1)
        stringmatha$ = runningtotal$: stringmathb$ = gfcb$
        runningtotal$ = sm_mult$(stringmatha$, stringmathb$)
        stringmatha$ = gfca$: stringmathb$ = runningtotal$
        runningtotal$ = sm_sub$(stringmatha$, stringmathb$)
        SWAP gfca$, gfcb$: gfcb$ = runningtotal$
        IF runningtotal$ = "0" THEN EXIT DO
    LOOP

    stringmatha$ = numerator$: stringmathb$ = gfca$
    IF betatest% THEN PRINT "GFC = "; gfca$
    numerator$ = sm_div$(stringmatha$, stringmathb$)
    stringmatha$ = denominator$: stringmathb$ = gfca$
    denominator$ = sm_div$(stringmatha$, stringmathb$)
    gfca$ = numerator$: gfcb$ = denominator$ ' Needed to pass back.
    IF betatest% THEN PRINT "Fraction: "; numerator$; " / "; denominator$
END SUB

Wat I like is this format reduces fractions, which helps eliminates some rounding errors. For example, if the computation requires something like find the .2 root of 6, well,  2/10 root of 6 would be square root of 6 = 2.449489742783178 ^ 10 = 7,775.9999999999968826892081723528 whereas reducing 2/10 to 1/5 leaves us with 6^5 = 7,776.

Again, to solve for the discrepancy if reducing the fraction is not possible, or just doesn't matter, means I would have to get numbers lik the square root of 6 in either enough digits to reach the terminating decimal or convert the remainder and digits calculated to a fraction. So yes, Virginia, there is a Santa Clause, and I'd bet he'd rather shove his fat ascii down chimneys all night than mess with stuff.


Pete

EDIT: Screwy forum didn't register post contents.
Reply


Messages In This Thread
Roots and powers playing nicely together... - by Pete - 09-28-2022, 01:00 AM



Users browsing this thread: 6 Guest(s)