Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Very fast NEW division routine with string math...
#7
Well not much feedback so far on format, so here's the one I think most folks would agree on, provided you don't mind more than a single sub-routine running the show in whatever program it gets used in...

Code: (Select All)
DIM SHARED limit&&, betatest%
limit&& = 32: betatest% = 0
IF betatest% THEN WIDTH 170, 42: _SCREENMOVE 0, 0

DO
    WHILE -1
        LINE INPUT "1st Number: "; a$: IF sm_validate(a$) THEN PRINT a$: EXIT WHILE
        LINE INPUT "2nd Number: "; b$: IF sm_validate(b$) THEN PRINT b$: EXIT WHILE

        PRINT "a * b = "; sm_mult$(a$, b$)
        PRINT "a / b = "; sm_div$(a$, b$)
        PRINT "a + b = "; sm_add$(a$, b$)
        PRINT "a - b = "; sm_sub$(a$, b$)
        PRINT "srt a = "; sm_sqrt$(a$)
        PRINT "srt b = "; sm_sqrt$(b$)
        PRINT "sqr a = "; sm_sqr$(a$)
        PRINT "sqr b = "; sm_sqr$(b$)
        EXIT WHILE
    WEND
    PRINT STRING$(_WIDTH, "-")
LOOP

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 +
            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

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

            IF j% = 0 AND k% THEN
                IF compa$ = "0" THEN gl% = -1 ELSE gl% = 1
                EXIT DO
            END IF
            IF k% = 0 AND j% THEN
                IF compb$ = "0" THEN gl% = 1 ELSE gl% = -1
                EXIT DO
            END IF

            ' Both decimals.
            IF j% THEN
                SELECT CASE INSTR(compa$, ".")
                    CASE IS > INSTR(compb$, ".")
                        gl% = 1
                    CASE IS = INSTR(compb$, ".")
                        IF compa$ = compb$ THEN
                            gl% = 0
                        ELSEIF compa$ < compb$ THEN gl% = -1
                        ELSE
                            gl% = 1
                        END IF
                    CASE IS < INSTR(compb$, ".")
                        gl% = -1
                END SELECT
                EXIT DO
            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_validate (validate$)
    sm_validate = 0: vsn_negcnt& = 0: vsn_poscnt& = 0: vsn_depresent& = 0: decimalcnt& = 0: vsn_numberpresent& = 0: vsn_zerospresent& = 0
    IF LEFT$(validate$, 1) = "-" THEN validate$ = MID$(validate$, 2): sm_sign$ = "-" ELSE sm_sign$ = ""
    WHILE -1 ' Falx loop.
        IF LEFT$(validate$, 1) = "+" THEN IF sm_sign$ <> "-" THEN validate$ = MID$(validate$, 2) ELSE validate$ = "invalid number": EXIT WHILE
        IF INSTR(UCASE$(validate$), "D") OR INSTR(UCASE$(validate$), "E") THEN ' Evaluate for Scientific Notation.
            FOR sm_i& = 1 TO LEN(validate$)
                validatenum$ = MID$(UCASE$(validate$), sm_i&, 1)
                SELECT CASE validatenum$
                    CASE "+"
                        IF vsn_depresent& THEN vsn_poscnt& = vsn_poscnt& + 1 ELSE validate$ = "invalid number": EXIT WHILE
                    CASE "-"
                        IF vsn_depresent& THEN vsn_negcnt& = vsn_negcnt& + 1 ELSE validate$ = "invalid number": EXIT WHILE
                    CASE "0" TO "9"
                        vsn_numberpresent& = -1
                    CASE "D", "E"
                        vsn_depresent& = vsn_depresent& + 1
                        IF decimalcnt& = 0 AND sm_i& <> 2 OR vsn_depresent& > 1 OR vsn_numberpresent& = 0 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& = 1 AND vsn_poscnt& >= 1 THEN vsn_numberpresent& = 0: EXIT FOR
                        vsn_numberpresent& = 0
                        MID$(validate$, sm_i&, 1) = "e" ' Standardize
                    CASE "."
                        decimalcnt& = decimalcnt& + 1
                        IF sm_i& <> 2 THEN vsn_numberpresent& = 0: EXIT FOR
                    CASE ELSE
                        vsn_numberpresent& = 0: EXIT FOR
                END SELECT
            NEXT
            IF decimalcnt& = 0 THEN validate$ = MID$(validate$, 1, 1) + "." + MID$(validate$, 2) ' Standardize "."
            IF vsn_numberpresent& = 0 OR vsn_negcnt& = 1 AND vsn_poscnt& = 1 OR decimalcnt& > 1 OR INSTR(validate$, ".") <> 2 THEN validate$ = "invalid number": EXIT WHILE
            vsn_depresent& = INSTR(validate$, "e")
            sm_x$ = MID$(validate$, vsn_depresent& + 1, 1) ' Standardize exponent "+" these two lines.
            IF sm_x$ <> "+" AND sm_x$ <> "-" THEN validate$ = MID$(validate$, 1, vsn_depresent&) + "+" + MID$(validate$, vsn_depresent& + 1)
            IF MID$(validate$, vsn_depresent& + 2, 1) = "0" THEN
                IF MID$(validate$, vsn_depresent& + 3, 1) <> "" THEN validate$ = "invalid number": EXIT WHILE ' No leading zeros allowed in exponent notation.
            END IF
            jjed& = INSTR(validate$, "e") ' Get position of notation.
            valexpside$ = MID$(validate$, jjed&) ' These two lines break up into number and notation
            validate$ = MID$(validate$, 1, jjed& - 1) ' validate$ is +- single digit whole number, decimal point and decimal number. valexpside$ is notation, sign and exponent.
            DO UNTIL RIGHT$(validate$, 1) <> "0" ' Remove any trailing zeros for number. Example 1.0d3 or 1.0000d3, etc.
                validate$ = MID$(validate$, 1, LEN(validate$) - 1)
            LOOP
            IF VAL(MID$(validate$, 1, INSTR(validate$, ".") - 1)) = 0 THEN
                IF RIGHT$(validate$, 1) = "." THEN
                    validate$ = "0.e+0" ' Handles all types of zero entries.
                ELSE
                    validate$ = "invalid number": EXIT WHILE
                END IF
                EXIT WHILE
            END IF
            validate$ = sm_sign$ + validate$ + valexpside$
            EXIT WHILE
        ELSE
            FOR sm_i& = 1 TO LEN(validate$)
                validatenum$ = MID$(validate$, sm_i&, 1)
                SELECT CASE validatenum$
                    CASE "."
                        decimalcnt& = decimalcnt& + 1
                    CASE "0"
                        vsn_zerospresent& = -1
                    CASE "1" TO "9"
                        vsn_numberpresent& = -1
                    CASE "$"
                    CASE ELSE
                        validate$ = "invalid number": EXIT WHILE
                END SELECT
            NEXT
            IF decimalcnt& > 1 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& >= 1 AND vsn_poscnt& >= 1 THEN
                validate$ = "invalid number": EXIT WHILE
            END IF
            REM IF INSTR(validate$, "$") THEN GOSUB currency_validate
            IF INSTR(validate$, ",") THEN
                REM GOSUB comma_validation
                IF validate$ = "invalid number" THEN EXIT WHILE
                REM GOSUB comma_removal
            END IF
            IF RIGHT$(validate$, 1) = "." THEN validate$ = MID$(validate$, 1, LEN(validate$) - 1)
            DO UNTIL LEFT$(validate$, 1) <> "0" ' Strip off any leading zeros.
                validate$ = MID$(validate$, 2)
            LOOP
            validate$ = sm_sign$ + validate$
            IF INSTR(validate$, ".") THEN
                DO UNTIL RIGHT$(validate$, 1) <> "0" ' Strip off any trailing zeros in a decimal.
                    validate$ = MID$(validate$, 1, LEN(validate$) - 1)
                LOOP
            END IF
            IF RIGHT$(validate$, 1) = "." THEN validate$ = MID$(validate$, 1, LEN(validate$) - 1)
            IF vsn_numberpresent& = 0 THEN
                IF vsn_zerospresent& THEN
                    validate$ = "0"
                ELSE
                    validate$ = "invalid number"
                END IF
            END IF
        END IF
        EXIT WHILE
    WEND
    IF validate$ = "invalid number" THEN sm_validate = 1 ELSE sm_validate = 0
END FUNCTION

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.
        IF MID$(divisor$, 1, 1) > MID$(dividend$, 1, 1) THEN
            dp&& = dp&& - div_decimal%
            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 divisor_ratio_dividend% = 1 THEN
                dp&& = dp&& - div_decimal%
                IF betatest% THEN PRINT "Larger divisor, so move quotent decimal one place back to: ";: COLOR 14: PRINT LTRIM$(STR$(dp&&)): COLOR 7
            ELSE
                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
        ELSE
            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
        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

FUNCTION sm_sqrt$ (sm_var$)
    oldy$ = "": sqrt$ = "": IF limit&& < 150 THEN custom_limit&& = 150 ELSE custom_limit&& = limit&&
    sqrt_a$ = sm_var$
    IF INSTR(sqrt_a$, ".") THEN
        decx$ = MID$(sqrt_a$, 1, INSTR(sqrt_a$, ".") - 1)
        sqrt_a$ = MID$(sqrt_a$, 1, INSTR(sqrt_a$, ".") - 1) + MID$(sqrt_a$, INSTR(sqrt_a$, ".") + 1)
        IF LEN(sqrt_a$) = 1 THEN sqrt_a$ = sqrt_a$ + "0"
    ELSE
        decx$ = sqrt_a$
    END IF

    j&& = LEN(decx$)

    ' VAL() okay, one character eval.
    IF VAL(RIGHT$(LTRIM$(STR$(j&&)), 1)) / 2 = VAL(RIGHT$(LTRIM$(STR$(j&&)), 1)) \ 2 THEN
        i&& = 1 ' Even number length.
    ELSE
        i&& = 0 ' Odd number length.
    END IF

    DO
        runningtotal$ = sm_sub$(z$, k$) '''''         sm z$, "-", k$, runningtotal$
        z$ = runningtotal$ + (MID$(sqrt_a$, i&&, 2))
        IF LEFT$(z$, 1) = "0" THEN z$ = MID$(z$, 2) ' Remove leading zeros

        oldy$ = ""
        FOR j&& = 1 TO 10
            IF i&& > 1 THEN
                y$ = sm_mult$(sqrt$, "2") '''' sm sqrt$, "*", "2", y$
                y$ = y$ + LTRIM$(STR$(j&&))
            ELSE
                y$ = LTRIM$(STR$(j&&))
            END IF

            runningtotal$ = sm_mult$(y$, LTRIM$(STR$(j&&))) '''''sm y$, "*", LTRIM$(STR$(j&&)), runningtotal$

            sm_greater_lesser runningtotal$, z$, gl%
            IF gl% > -1 THEN
                IF gl% = 0 THEN
                    h% = 0: oldy$ = y$ ' Perfect square division.
                ELSE
                    h% = 1
                END IF
                runningtotal$ = sm_mult$(oldy$, LTRIM$(STR$(j&& - h%))) '''', runningtotal$

                IF STRING$(LEN(z$), "0") = z$ AND runningtotal$ = "0" AND i&& >= LEN(decx$) THEN EXIT DO

                IF dpx&& = 0 THEN ' Limited to && size unless converted to string.
                    IF i&& >= LEN(decx$) THEN
                        dpx&& = INT(LEN(decx$) / 2 + .5)
                        IF dpx&& = 0 THEN dpx&& = -1
                    END IF
                END IF

                IF betatest% < -1 THEN PRINT "Sqrt "; sqrt$; " * 2 = ";: COLOR 2, 0: PRINT LTRIM$(STR$(VAL(sqrt$) * 2));: COLOR 7, 0: PRINT LTRIM$(STR$(j&& - h%)); " * "; LTRIM$(STR$(j&& - h%)); " ="; VAL(oldy$) * (j&& - h%)
                sqrt$ = sqrt$ + LTRIM$(STR$(j&& - h%))

                runningtotal$ = sm_mult$(oldy$, LTRIM$(STR$(j&& - h%))) '''', runningtotal$
                k$ = runningtotal$

                IF betatest% < -1 THEN PRINT "Remainder "; z$; " minus "; k$; " = ";
                EXIT FOR
            END IF
            oldy$ = y$
        NEXT

        i&& = i&& + 2
        IF LEN(z$) >= custom_limit&& THEN EXIT DO
        sqrt_a$ = sqrt_a$ + "00"
    LOOP

    IF dpx&& THEN sqrt$ = MID$(sqrt$, 0, dpx&& + 1) + "." + MID$(sqrt$, dpx&& + 1)
    sm_sqrt$ = sqrt$
END FUNCTION

FUNCTION sm_sqr$ (sm_var$)
    runningtotal$ = sm_mult$(sm_var$, sm_var$)
    sm_sqr$ = runningtotal$
END FUNCTION

EDITED to correct a glitch Jack uncovered. Thanks Jack! +2

Note: A variable could be easily substituted for the PRINT function statements for progressive calculations.

Pete
Reply


Messages In This Thread
RE: Very fast NEW division routine with string math... - by Pete - 09-11-2022, 10:05 PM



Users browsing this thread: 2 Guest(s)