Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
I'm adding SQR to my new faster string math routines...
#14
Okay math fans... How about the square root of 2 to 5,000 places in under a minute...

Code: (Select All)
WIDTH 160, 42
_SCREENMOVE 0, 0
DO
    limit&& = 5000 ' Set to something smaller like 128 for instant results.
    'betatest% = -1
    IF betatest% THEN limit&& = 16

    DO
        INPUT "Number: "; x$: PRINT

        IF x$ = "" THEN SYSTEM

        IF LEFT$(x$, 1) = "-" THEN
            PRINT "Negatives not allowed. Redo..": _DELAY 2: PRINT
        ELSE
            validate_string x$
            IF INSTR(x$, "invalid") = 0 THEN EXIT DO
            PRINT "Sorry, "; x$: _DELAY 1: PRINT
        END IF
    LOOP

    x# = VAL(x$) ' Needed for QB64 SQR() comparison only.
    oldy$ = ""

    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$ = 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
                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 runningtotal$; " sqrt = "; sqrt$
        END IF

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

    PRINT

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

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

SUB string_math (stringmatha$, operator$, stringmathb$, runningtotal$, terminating_decimal%, limit&&)
    DIM AS _INTEGER64 a, b, c, aa, bb, cc, s, ss
    a1$ = stringmatha$: b1$ = stringmathb$

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

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

    IF INSTR(d2dividend$, ".") <> 0 THEN
        d2dividend$ = d2dividend$ + STRING$(divplace& - LEN(d2dividend$) - INSTR(d2dividend$, "."), "0") ' Add any zeros based on the length of dividend at decimal - length of divisor at decimal. If less than zero, nothing added.
        divplace2& = INSTR(d2dividend$, ".")
        DO UNTIL RIGHT$(d2dividend$, 1) <> "0"
            d2dividend$ = MID$(d2dividend$, 1, LEN(d2dividend$) - 1) ' Strip off trailing zeros
        LOOP
        d2dividend$ = MID$(d2dividend$, 1, INSTR(d2dividend$, ".") - 1) + MID$(d2dividend$, INSTR(d2dividend$, ".") + 1) ' Strip off decimal point.
    ELSE
        d2dividend$ = d2dividend$ + STRING$(divplace&, "0") ' Add any zeros based on the length of dividend at decimal - length of divisor at decimal. If less than zero, nothing added.
        divplace& = 0
    END IF
    DO
        DO
            divremainder& = divremainder& + 1: divremainder$ = divremainder$ + MID$(d2dividend$, divremainder&, 1)
            IF MID$(d2dividend$, divremainder&, 1) = "" THEN
                IF divremainder$ = STRING$(LEN(divremainder$), "0") AND LEN(quotient$) > LEN(d2dividend$) THEN
                    divflag% = -1
                    terminating_decimal% = -1
                    EXIT DO
                END IF
                divcarry& = divcarry& + 1
                IF divcarry& = 1 THEN divplace3& = divremainder& - 1
                IF divcarry& > limit&& + 1 + divbuffer& THEN
                    divflag% = -2: EXIT DO
                END IF
                divremainder$ = divremainder$ + "0" ' No more digits to bring down.
            END IF
            IF LEN(divremainder$) > LEN(d1divisor$) OR LEN(divremainder$) = LEN(d1divisor$) AND divremainder$ >= d1divisor$ THEN EXIT DO
            quotient$ = quotient$ + "0"
        LOOP
        IF divflag% THEN divflag% = 0: EXIT DO
        FOR div_i% = 9 TO 1 STEP -1
            stringmatha$ = LTRIM$(STR$(div_i%)): stringmathb$ = d1divisor$
            m_product$ = "": GOSUB string_multiply_new
            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_new
        operator$ = "-"
        stringmatha$ = divremainder$
        stringmathb$ = m_product$
        GOSUB string_add_subtract_new
        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_add_subtract_new:
    s = 18

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

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

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

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

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

            string_compare a1_x$, b1_x$, gl%

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

    s = 18: z$ = ""

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

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

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

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

    runningtotal$ = z$ '*'
    sign$ = "": sign_a$ = "": sign_b$ = "": i&& = 0: j&& = 0: decimal% = 0: c = 0
    EXIT SUB

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

    a$ = stringmatha$: b$ = stringmathb$

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

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

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

    DO
        h&& = h&& + s: i&& = 0
        x2$ = MID$(b$, LEN(b$) - h&& + 1, s)
        WHILE -1
            i&& = i&& + s
            x1$ = MID$(a$, LEN(a$) - i&& + 1, s)
            a = VAL(sign_a$ + x1$) * VAL(sign_b$ + x2$) + c
            IF betatest% THEN PRINT "x1$ = "; x1$;: LOCATE , 20: PRINT "x2$ = "; x2$;: LOCATE , 35: PRINT VAL(x1$) * VAL(x2$) + c;: LOCATE , 55: PRINT "c = "; c;: LOCATE , 75: PRINT "val = "; a,
            c = 0
            tmp$ = LTRIM$(STR$(a))
            IF LEN(tmp$) > s THEN c = VAL(MID$(tmp$, 1, LEN(tmp$) - s)): tmp$ = MID$(tmp$, LEN(tmp$) - s + 1)
            z$ = STRING$(LEN(x1$) - LEN(tmp$), "0") + tmp$ + z$
            IF betatest% THEN LOCATE , 100: PRINT a;: LOCATE , 120: PRINT z$
            IF i&& >= LEN(a$) AND c = 0 THEN EXIT WHILE
        WEND

        jj&& = jj&& + 1

        IF jj&& > 1 THEN
            ii&& = 0: cc = 0
            aa$ = holdaa$
            bb$ = z$ + STRING$((jj&& - 1) * s, "0")
            IF betatest% THEN PRINT "aa$ "; aa$; " + bb$ "; z$;: COLOR 14, 0: PRINT STRING$(jj&& - 1, "0"); " = ";: COLOR 7, 0: SLEEP
            DO
                ii&& = ii&& + ss
                xx1$ = MID$(aa$, LEN(aa$) - ii&& + 1, ss)
                xx2$ = MID$(bb$, LEN(bb$) - ii&& + 1, ss)
                aa = VAL(xx1$) + VAL(xx2$) + cc
                IF xx1$ + xx2$ = "" AND cc = 0 THEN EXIT DO ' Prevents leading zeros.
                cc = 0
                IF aa > VAL(STRING$(ss, "9")) THEN aa = aa - 10 ^ ss: cc = 1
                tmp$ = LTRIM$(STR$(aa))
                zz$ = STRING$(LEN(xx1$) - LEN(tmp$), "0") + tmp$ + zz$
            LOOP

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

            holdaa$ = zz$
            IF betatest% THEN COLOR 2, 0: PRINT holdaa$: COLOR 7, 0
        ELSE
            holdaa$ = z$ + STRING$(jj&& - 1, "0")
        END IF

        z$ = "": zz$ = ""

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

    z$ = holdaa$

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

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

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

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

    decimal% = 0: sign$ = ""

    runningtotal$ = z$

    EXIT SUB

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

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

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

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

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

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

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

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

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

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

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

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

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

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

SUB validate_string (stringmathb$)
    DO ' Faux loop.
        vsn_negcnt& = 0: vsn_poscnt& = 0: vsn_depresent& = 0: decimalcnt& = 0: vsn_numberpresent& = 0: vsn_zerospresent& = 0
        IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): sm_sign$ = "-" ELSE sm_sign$ = ""
        IF LEFT$(stringmathb$, 1) = "+" THEN IF sm_sign$ <> "-" THEN stringmathb$ = MID$(stringmathb$, 2) ELSE stringmathb$ = "invalid number": EXIT DO
        IF INSTR(UCASE$(stringmathb$), "D") OR INSTR(UCASE$(stringmathb$), "E") THEN ' Evaluate for Scientific Notation.
            FOR sm_i& = 1 TO LEN(stringmathb$)
                validatenum$ = MID$(UCASE$(stringmathb$), sm_i&, 1)
                SELECT CASE validatenum$
                    CASE "+"
                        IF vsn_depresent& THEN vsn_poscnt& = vsn_poscnt& + 1 ELSE stringmathb$ = "invalid number": EXIT DO
                    CASE "-"
                        IF vsn_depresent& THEN vsn_negcnt& = vsn_negcnt& + 1 ELSE stringmathb$ = "invalid number": EXIT DO
                    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$(stringmathb$, 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 stringmathb$ = MID$(stringmathb$, 1, 1) + "." + MID$(stringmathb$, 2) ' Standardize "."
            IF vsn_numberpresent& = 0 OR vsn_negcnt& = 1 AND vsn_poscnt& = 1 OR decimalcnt& > 1 OR INSTR(stringmathb$, ".") <> 2 THEN stringmathb$ = "invalid number": EXIT DO
            vsn_depresent& = INSTR(stringmathb$, "e")
            sm_x$ = MID$(stringmathb$, vsn_depresent& + 1, 1) ' Standardize exponent "+" these two lines.
            IF sm_x$ <> "+" AND sm_x$ <> "-" THEN stringmathb$ = MID$(stringmathb$, 1, vsn_depresent&) + "+" + MID$(stringmathb$, vsn_depresent& + 1)
            IF MID$(stringmathb$, vsn_depresent& + 2, 1) = "0" THEN
                IF MID$(stringmathb$, vsn_depresent& + 3, 1) <> "" THEN stringmathb$ = "invalid number": EXIT DO ' No leading zeros allowed in exponent notation.
            END IF
            jjed& = INSTR(stringmathb$, "e") ' Get position of notation.
            valexpside$ = MID$(stringmathb$, jjed&) ' These two lines break up into number and notation
            stringmathb$ = MID$(stringmathb$, 1, jjed& - 1) ' stringmathb$ is +- single digit whole number, decimal point and decimal number. valexpside$ is notation, sign and exponent.
            DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Remove any trailing zeros for number. Example 1.0d3 or 1.0000d3, etc.
                stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
            LOOP
            IF VAL(MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1)) = 0 THEN
                IF RIGHT$(stringmathb$, 1) = "." THEN
                    stringmathb$ = "0.e+0" ' Handles all types of zero entries.
                ELSE
                    stringmathb$ = "invalid number": EXIT DO
                END IF
                EXIT DO
            END IF
            stringmathb$ = sm_sign$ + stringmathb$ + valexpside$
            EXIT DO
        ELSE
            FOR sm_i& = 1 TO LEN(stringmathb$)
                validatenum$ = MID$(stringmathb$, 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
                        stringmathb$ = "invalid number": EXIT DO
                END SELECT
            NEXT
            IF decimalcnt& > 1 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& >= 1 AND vsn_poscnt& >= 1 THEN
                stringmathb$ = "invalid number": EXIT DO
            END IF

            REM IF INSTR(stringmathb$, "$") THEN GOSUB currency_validate
            REM IF INSTR(stringmathb$, ",") THEN
            REM GOSUB comma_validation
            REM IF stringmathb$ = "invalid number" THEN exit do
            REM GOSUB comma_removal
            REM END IF

            IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
            DO UNTIL LEFT$(stringmathb$, 1) <> "0" ' Strip off any leading zeros.
                stringmathb$ = MID$(stringmathb$, 2)
            LOOP
            stringmathb$ = sm_sign$ + stringmathb$
            IF INSTR(stringmathb$, ".") THEN
                DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Strip off any trailing zeros in a decimal.
                    stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
                LOOP
            END IF
            IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
            IF vsn_numberpresent& = 0 THEN
                IF vsn_zerospresent& THEN
                    stringmathb$ = "0"
                ELSE
                    stringmathb$ = "invalid number"
                END IF
            END IF
        END IF
        EXIT DO
    LOOP
END SUB
Reply


Messages In This Thread
RE: I might add SQR to my string math routines... - by Pete - 08-21-2022, 09:37 PM



Users browsing this thread: 7 Guest(s)