QB64 Phoenix Edition
I'm adding SQR to my new faster string math routines... - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: I'm adding SQR to my new faster string math routines... (/showthread.php?tid=781)

Pages: 1 2


I'm adding SQR to my new faster string math routines... - Pete - 08-18-2022




RE: I might add SQR to my string math routines... - Jack - 08-18-2022

works ok with integers, are you going to add support for fixed/floating point?


RE: I might add SQR to my string math routines... - Pete - 08-18-2022

I'm looking into that now...


RE: I might add SQR to my string math routines... - Pete - 08-18-2022

@Jack

And here we go... floating points now supported...

Code: (Select All)
WIDTH 160, 42
_SCREENMOVE 0, 0
DO
    betatest% = -1
    loops# = 29
    INPUT "Number: "; x#
    IF x# = 0 THEN SYSTEM
    IF x# < 0 THEN PRINT "Negatives not allowed. Redo..": _DELAY 3: RUN

    oldy$ = ""
    x$ = LTRIM$(STR$(x#))

    IF INSTR(x$, ".") THEN
        decx$ = MID$(x$, 1, INSTR(x$, ".") - 1)
        x$ = MID$(x$, 1, INSTR(x$, ".") - 1) + MID$(x$, INSTR(x$, ".") + 1)
    ELSE
        decx$ = x$
    END IF

    j# = LEN(decx$)
    a$ = RIGHT$(LTRIM$(STR$(j#)), 1)

    IF VAL(a$) / 2 = VAL(a$) \ 2 THEN
        i# = 1 ' Even number length.
    ELSE
        i# = 0 ' Odd number length.
    END IF

    DO
        a$ = (MID$(x$, i#, 2))
        z$ = LTRIM$(STR$(VAL(z$) - k#)) + a$

        oldy$ = ""
        FOR j# = 1 TO 10
            IF i# > 1 THEN y$ = LTRIM$(STR$(VAL(sqrt$) * 2)) + LTRIM$(STR$(j#)) ELSE y$ = LTRIM$(STR$(j#))
            REM COLOR 8, 0: PRINT "y$ = "; y$, VAL(y$) * j#: COLOR 7, 0
            IF VAL(y$) * j# >= VAL(z$) THEN
                IF VAL(y$) * j# = VAL(z$) THEN
                    h% = 0: oldy$ = y$ ' Perfect square division.
                ELSE
                    h% = 1
                END IF

                IF VAL(z$) = 0 AND VAL(oldy$) * (j# - h%) = 0 AND i# >= LEN(decx$) THEN EXIT DO
                IF dp# = 0 THEN IF i# >= LEN(decx$) THEN dp# = INT(LEN(decx$) / 2 + .5)

                IF betatest% 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%))
                k# = VAL(oldy$) * (j# - h%)
                REM PRINT "oldy$ = "; oldy$; " h% ="; h%; "j#-h% ="; j# - h%, "k# ="; k#, "sqrt = "; sqrt$
                IF betatest% THEN PRINT "Remainder "; z$; " minus"; k#; "= ";
                EXIT FOR
            END IF
            oldy$ = y$
        NEXT

        IF betatest% THEN PRINT LTRIM$(STR$(VAL(z$) - k#)); " sqrt = "; sqrt$

        i# = i# + 2
        IF i# > loops# THEN EXIT DO
        x$ = x$ + "00"
    LOOP

    PRINT

    IF dp# THEN
        sqrt$ = MID$(sqrt$, 0, dp# + 1) + "." + MID$(sqrt$, dp# + 1)
    END IF

    PRINT "QB64 SQR:"; SQR(x#)
    PRINT "Pete SQR: "; sqrt$: _DELAY 1: CLEAR
    PRINT
LOOP


Also goof-proofed negs.

Pete


RE: I might add SQR to my string math routines... - Jack - 08-18-2022

Pete you are almost there but it fails if you enter for example .5


RE: I might add SQR to my string math routines... - Pete - 08-18-2022

My guess is it doesn't have a way to handle single digit floating points, probably because it isn't "blocking" it correctly for the initial routine.

I'm about half completed with the string conversion, but I'll go back to the other in a bit.

Thanks for catching that!

Pete


RE: I might add SQR to my string math routines... - Pete - 08-18-2022

Okay, this should fix that exception for single digit floating points...

Code: (Select All)
WIDTH 160, 42
_SCREENMOVE 0, 0
DO
    betatest% = -1
    loops# = 29
    INPUT "Number: "; x#
    IF x# = 0 THEN SYSTEM
    IF x# < 0 THEN PRINT "Negatives not allowed. Redo..": _DELAY 3: RUN

    oldy$ = ""
    x$ = LTRIM$(STR$(x#))

    IF INSTR(x$, ".") THEN
        decx$ = MID$(x$, 1, INSTR(x$, ".") - 1)
        x$ = MID$(x$, 1, INSTR(x$, ".") - 1) + MID$(x$, INSTR(x$, ".") + 1)
        IF LEN(x$) = 1 THEN x$ = x$ + "0"
    ELSE
        decx$ = x$
    END IF

    j&& = LEN(decx$)
    a$ = RIGHT$(LTRIM$(STR$(j&&)), 1)

    IF VAL(a$) / 2 = VAL(a$) \ 2 THEN
        i&& = 1 ' Even number length.
    ELSE
        i&& = 0 ' Odd number length.
    END IF

    DO
        a$ = (MID$(x$, i&&, 2))
        z$ = LTRIM$(STR$(VAL(z$) - k#)) + a$

        oldy$ = ""
        FOR j&& = 1 TO 10
            IF i&& > 1 THEN y$ = LTRIM$(STR$(VAL(sqrt$) * 2)) + LTRIM$(STR$(j&&)) ELSE y$ = LTRIM$(STR$(j&&))
            REM COLOR 8, 0: PRINT "y$ = "; y$, VAL(y$) * j&&: COLOR 7, 0
            IF VAL(y$) * j&& >= VAL(z$) THEN
                IF VAL(y$) * j&& = VAL(z$) THEN
                    h% = 0: oldy$ = y$ ' Perfect square division.
                ELSE
                    h% = 1
                END IF

                IF VAL(z$) = 0 AND VAL(oldy$) * (j&& - h%) = 0 AND i&& >= LEN(decx$) THEN EXIT DO
                IF dp&& = 0 THEN IF i&& >= LEN(decx$) THEN dp&& = INT(LEN(decx$) / 2 + .5): IF dp&& = 0 THEN dp&& = -1

                IF betatest% 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%))
                k# = VAL(oldy$) * (j&& - h%)
                REM PRINT "oldy$ = "; oldy$; " h% ="; h%; "j&&-h% ="; j&& - h%, "k# ="; k#, "sqrt = "; sqrt$
                IF betatest% THEN PRINT "Remainder "; z$; " minus"; k#; "= ";
                EXIT FOR
            END IF
            oldy$ = y$
        NEXT

        IF betatest% THEN PRINT LTRIM$(STR$(VAL(z$) - k#)); " sqrt = "; sqrt$

        i&& = i&& + 2
        IF i&& > loops# THEN EXIT DO
        x$ = x$ + "00"
    LOOP

    PRINT

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

    PRINT "QB64 SQR:"; SQR(x#)
    PRINT "Pete SQR: "; sqrt$: _DELAY 1: CLEAR
    PRINT
LOOP



RE: I might add SQR to my string math routines... - Pete - 08-18-2022

And now we can run the digits out a bit, thanks to string math...

Code: (Select All)
$CHECKING:OFF
WIDTH 160, 42
_SCREENMOVE 0, 0
DO
    limit&& = 32
    'betatest% = -1
    IF betatest% THEN loops&& = 29 ELSE loops&& = 99
    INPUT "Number: "; x#
    IF x# = 0 THEN SYSTEM
    IF x# < 0 THEN PRINT "Negatives not allowed. Redo..": _DELAY 3: RUN

    oldy$ = ""
    x$ = LTRIM$(STR$(x#))

    IF INSTR(x$, ".") THEN
        decx$ = MID$(x$, 1, INSTR(x$, ".") - 1)
        x$ = MID$(x$, 1, INSTR(x$, ".") - 1) + MID$(x$, INSTR(x$, ".") + 1)
        IF LEN(x$) = 1 THEN x$ = x$ + "0"
    ELSE
        decx$ = x$
    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
        stringmatha$ = z$: stringmathb$ = k$
        string_math z$, "-", k$, runningtotal$, terminating_decimal%, limit&&
        '''z$ = LTRIM$(STR$(VAL(z$) - k#)) + (MID$(x$, i&&, 2))
        z$ = runningtotal$ + (MID$(x$, 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$ = LTRIM$(STR$(VAL(sqrt$) * 2)) + LTRIM$(STR$(j&&))
                string_math sqrt$, "*", "2", y$, terminating_decimal%, limit&&
                y$ = y$ + LTRIM$(STR$(j&&))
            ELSE
                y$ = LTRIM$(STR$(j&&))
            END IF

            string_math y$, "*", LTRIM$(STR$(j&&)), runningtotal$, terminating_decimal%, limit&&

            string_compare runningtotal$, z$, gl%
            IF gl% > -1 THEN
                IF gl% = 0 THEN
                    h% = 0: oldy$ = y$ ' Perfect square division.
                ELSE
                    h% = 1
                END IF

                string_math oldy$, "*", LTRIM$(STR$(j&& - h%)), runningtotal$, terminating_decimal%, limit&&
                IF STRING$(LEN(z$), "0") = z$ AND runningtotal$ = "0" AND i&& >= LEN(decx$) THEN EXIT DO

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

                IF betatest% 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%))

                string_math oldy$, "*", LTRIM$(STR$(j&& - h%)), runningtotal$, terminating_decimal%, limit&&
                k$ = runningtotal$

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

        IF betatest% THEN
            string_math stringmatha$, "-", stringmathb$, runningtotal$, terminating_decimal%, limit&&
            ''PRINT LTRIM$(STR$(VAL(z$) - k#)); " sqrt = "; sqrt$
            PRINT runningtotal$; " sqrt = "; sqrt$
        END IF

        i&& = i&& + 2
        IF i&& > loops&& THEN EXIT DO
        x$ = x$ + "00"
    LOOP

    PRINT

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

    PRINT "QB64 SQR:"; SQR(x#)
    PRINT "Pete SQR: "; sqrt$: _DELAY 1: CLEAR
    PRINT
LOOP

SUB string_math (stringmatha$, operator$, stringmathb$, runningtotal$, terminating_decimal%, limit&&)
    SELECT CASE operator$
        CASE "+", "-"
            GOTO string_add_subtract
        CASE "*"
            GOTO string_multiply
        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
            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
        operator$ = "-"
        stringmatha$ = divremainder$
        stringmathb$ = m_product$
        GOSUB string_add_subtract
        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

    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
        REM 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
        REM 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
            IF compa$ > compb$ THEN
                gl% = 1
            ELSEIF compa$ = compb$ THEN gl% = 0
            ELSEIF compa$ < compb$ THEN gl% = -1
            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


RE: I might add SQR to my string math routines... - Jack - 08-18-2022

it works ok as far as I tested, only that limit&& has no effect but loops&& does


RE: I might add SQR to my string math routines... - Pete - 08-18-2022

(08-18-2022, 09:53 AM)Jack Wrote: it works ok as far as I tested, only that limit&& has no effect but loops&& does

Correct. limit&& is not employed here, but is used in other string math sub-routines. These two variables are similar in function, but since square root processes blocks of numbers depending on odd or even digits, I didn't feel comfortable in a limit&& * 2 loop exit for this workup. What I will probably end up with is a loop that exits when the decimal places reach the limit&& length, and then do away with the loops&& variable.

My biggest concern is speed. This routine works great on decimal place of 16 or less, fair at 32 or less, and is slow at lengths of 50+. The division string math takes the longest to process, especially with very large numbers divided by very large numbers, like in the higher loop pi calculations. My guess is professionally made calculator routines have special algorithms that don't rely on long division. So while figuring out how to build an algorithm with the classic math models is fun, it isn't necessarily practical for use in say a 500-digit precision calculator program where the user might have to wait a few minutes to get the answer. Ironic that string math can be used to take precision to infinity, provided you have eternity to wait for the answer!

Pete

Edit: The good news about why to use string math over qb64 SQR is see in accuracy tests like finding SQR(78)...

8.831760866327848 (QB64 is 848 while string math, which is correct as tested on precision online calculators, is 846. This is more than a rounding situation.)
8.8317608663278468547640427269592539641746394809314