Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
I'm adding SQR to my new faster string math routines...
#8
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
Reply


Messages In This Thread
RE: I might add SQR to my string math routines... - by Pete - 08-18-2022, 04:17 AM



Users browsing this thread: 7 Guest(s)