+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Treebeard's String-Math (/showthread.php?tid=691)
RE: Treebeard's String-Math - Pete - 07-30-2022
(07-30-2022, 01:05 AM)Jack Wrote: Pete, I looked at your demo and I couldn't figure out how I would use your math engine to perform any math problem, it's horrifically complex
suppose that I wanted to code a simple factorial
show me how simple it is with your math-engineCode: (Select All)input "n ";n
f=1
for i=1 to n
f=f*i
next
print f
I am signing off for the weekend, see you Sunday
Well it ain't made to be easy. It was made to be a calculator, but I just got rid of the extra stuff and used the sub, so here you go...
Code: (Select All)
_SCREENMOVE 0, 0
WIDTH 170, 25
start:
operator$ = "*"
' snconvert% = -1
INPUT "n "; n
f = 1
stringmatha$ = LTRIM$(STR$(f))
FOR i = 1 TO n
stringmathb$ = LTRIM$(STR$(i))
CALL stringmath(stringmatha$, operator$, stringmathb$, runningtotal$, snconvert%, round_total%, show_rounding%, comma_display%, currency_display%, limit&&)
stringmatha$ = runningtotal$
NEXT
PRINT "String Total: "; runningtotal$
PRINT: CLEAR: GOTO start
SUB stringmath (stringmatha$, operator$, stringmathb$, runningtotal$, snconvert%, round_total%, show_rounding%, comma_display%, currency_display%, limit&&)
stringmathround$ = ""
IF limit&& > 2147483640 THEN limit&& = 2147483640
IF limit&& = 0 THEN limit&& = 1700 ' Default.
IF RIGHT$(UCASE$(runningtotal$), 1) = "R" THEN runningtotal$ = MID$(runningtotal$, 1, LEN(runningtotal$) - 1) 'Strip off rounding designation.
' Check running total. If S.N. convert to numeric for operations.
IF INSTR(runningtotal$, ",") <> 0 OR INSTR(runningtotal$, "e") <> 0 THEN
holdstringmathb$ = stringmathb$
stringmathb$ = runningtotal$
IF INSTR(runningtotal$, ",") <> 0 THEN GOSUB comma_removal ELSE GOSUB scientific_to_numeric
runningtotal$ = stringmathb$: stringmathb$ = holdstringmathb$: holdstringmathb$ = ""
END IF
' Check input number. If S.N. convert to numeric for operations.
IF INSTR(UCASE$(stringmathb$), "D") <> 0 OR INSTR(UCASE$(stringmathb$), "E") <> 0 THEN
'''GOSUB validate_string_number
IF stringmathb$ = "invalid number" THEN EXIT SUB
GOSUB scientific_to_numeric
END IF
IF runningtotal$ = "" THEN
'''GOSUB validate_string_number
IF stringmathb$ = "invalid number" THEN EXIT SUB
IF LEFT$(stringmathb$, 1) = "-" THEN
stringmathb$ = MID$(stringmathb$, 2)
n2sign$ = "-"
ELSE
n2sign$ = ""
END IF
GOSUB limit_round_convert
IF stringmathb$ = "overflow" THEN
n2sign$ = "": PRINT "Validated: "; stringmathb$: EXIT SUB
END IF
runningtotal$ = n2sign$ + stringmathb$: n2sign$ = ""
IF stringmathround$ <> "" THEN runningtotal$ = runningtotal$ + stringmathround$
'''PRINT "Validated: "; runningtotal$
IF INSTR(LCASE$(stringmathb$), "e") <> 0 THEN BEEP: GOSUB scientific_to_numeric
ELSE
''' GOSUB validate_string_number
'''PRINT "Validated: "; stringmathb$
IF stringmathb$ = "invalid number" THEN EXIT SUB
IF INSTR(UCASE$(stringmathb$), "e") <> 0 THEN GOSUB scientific_to_numeric
END IF
IF runningtotal$ <> "" THEN stringmatha$ = runningtotal$
SELECT CASE operator$
CASE "+", "-"
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)
IF VAL(stringmathb$) > VAL(stringmatha$) 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)
IF VAL(stringmathb$) > VAL(stringmatha$) THEN SWAP stringmatha$, stringmathb$ ELSE 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
GOSUB limit_round_convert
IF stringmathb$ = "overflow" THEN n2sign$ = "": EXIT SUB
GOSUB sm_converter
runningtotal$ = n2sign$ + stringmathb$: n2sign$ = ""
CASE "*"
string_multiply:
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 charter 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$ = "": GOSUB limit_round_convert
IF stringmathb$ = "overflow" THEN EXIT SUB
GOSUB sm_converter
runningtotal$ = stringmathb$: stringmathb$ = ""
IF m_sign% THEN runningtotal$ = "-" + runningtotal$: m_sign% = 0
CASE "/"
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.": END
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: EXIT DO
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$ = "": GOSUB limit_round_convert
IF stringmathb$ = "overflow" THEN divsign% = 0: EXIT SUB
GOSUB sm_converter
runningtotal$ = stringmathb$: stringmathb$ = ""
IF divsign% THEN runningtotal$ = "-" + runningtotal$
END SELECT
IF stringmathround$ <> "" THEN runningtotal$ = runningtotal$ + stringmathround$
EXIT SUB
validate_string_number:
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": RETURN
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": RETURN
CASE "-"
IF vsn_depresent& THEN vsn_negcnt& = vsn_negcnt& + 1 ELSE stringmathb$ = "invalid number": RETURN
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": RETURN
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": RETURN ' 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": RETURN
END IF
RETURN
END IF
stringmathb$ = sm_sign$ + stringmathb$ + valexpside$
RETURN
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": RETURN
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": RETURN
END IF
IF INSTR(stringmathb$, "$") THEN GOSUB currency_validate
IF INSTR(stringmathb$, ",") THEN
GOSUB comma_validation
IF stringmathb$ = "invalid number" THEN RETURN
GOSUB comma_removal
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
RETURN
' Convert to commas, currency, S.N., etc.
sm_converter:
IF comma_display% THEN GOSUB comma_placement
IF currency_display% THEN GOSUB currency_convert
IF snconvert% THEN GOSUB numeric_to_scientific
RETURN
' Add in commas.
comma_placement:
GOSUB comma_prep
sm_i& = 0: sm_j& = 0: sm_seed& = 0
sm_seed& = LEN(temp_stringmathb1$) MOD 3: IF sm_seed& = 0 THEN sm_seed& = 3
sm_m1& = LEN(temp_stringmathb1$)
sm_m2& = (LEN(temp_stringmathb1$) - 1) \ 3
sm_replace$ = SPACE$(sm_m1& + sm_m2&)
DO WHILE sm_i& < sm_m1&
MID$(sm_replace$, sm_j& + 1, sm_seed& + 1) = MID$(temp_stringmathb1$, sm_i& + 1, sm_seed&) + ","
sm_i& = sm_i& + sm_seed&: sm_j& = sm_j& + sm_seed& + 1: sm_seed& = 3
LOOP
sm_replace$ = RTRIM$(sm_replace$)
IF RIGHT$(sm_replace$, 1) = "," THEN
stringmathb$ = MID$(sm_replace$, 1, LEN(sm_replace$) - 1)
ELSE
stringmathb$ = sm_replace$
END IF
sm_replace$ = "": temp_stringmathb1$ = ""
RETURN
' Validate comma entry.
comma_validation:
GOSUB comma_prep
IF INSTR(temp_stringmathb2$, ",") <> 0 OR temp_stringmathb1$ = STRING$(LEN(temp_stringmathb1$), ",") THEN
stringmathb$ = "invalid number" ' Decimal part has comma or entry is all commas.
ELSE
FOR sm_i& = LEN(temp_stringmathb1$) TO 1 STEP -1
sm_j% = sm_j% + 1
IF sm_j% = 4 THEN
IF MID$(temp_stringmathb1$, sm_i&, 1) <> "," THEN stringmathb$ = "invalid number": EXIT FOR
sm_j% = 0
END IF
NEXT
IF stringmathb$ <> "invalid number" THEN
stringmathb$ = sm_sign$ + temp_stringmathb1$ + temp_stringmathb2$
END IF
END IF
temp_stringmathb1$ = "": temp_stringmathb2$ = "": sm_i& = 0: sm_j% = 0: sm_sign$ = "": sm_dollar$ = ""
RETURN
comma_removal:
sm_i& = 0: sm_j& = 0: sm_seed& = 0
sm_replace$ = SPACE$(LEN(stringmathb$))
DO
sm_i& = INSTR(sm_seed& + 1, stringmathb$, ",")
IF sm_i& = 0 THEN EXIT DO
MID$(sm_replace$, sm_j& + 1, sm_i& - sm_seed& + 1) = MID$(stringmathb$, sm_seed& + 1, sm_i& - sm_seed& - 1)
sm_j& = sm_j& + sm_i& - sm_seed& - 1
sm_seed& = sm_i&
LOOP
stringmathb$ = RTRIM$(sm_replace$) + MID$(stringmathb$, sm_seed& + 1): sm_replace$ = ""
RETURN
comma_prep:
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): sm_sign$ = "-"
temp_stringmathb1$ = stringmathb$: stringmathb$ = ""
IF INSTR(temp_stringmathb1$, ".") THEN
temp_stringmathb2$ = MID$(temp_stringmathb1$, INSTR(temp_stringmathb1$, ".")) ' Decimal part
temp_stringmathb1$ = MID$(temp_stringmathb1$, 1, INSTR(temp_stringmathb1$, ".") - 1) ' Non-decimal part
END IF
IF LEFT$(temp_stringmathb1$, 1) = "$" THEN temp_stringmathb1$ = MID$(temp_stringmathb1$, 2): sm_dollar$ = "$"
RETURN
currency_validate:
IF LEFT$(stringmathb$, 2) = "$-" OR LEFT$(stringmathb$, 2) = "$+" THEN stringmathb$ = "invalid number": RETURN
IF LEFT$(stringmathb$, 1) = "$" THEN stringmathb$ = MID$(stringmathb$, 2)
IF INSTR(stringmathb$, "$") THEN stringmathb$ = "invalid number": RETURN
sm_dollar$ = "$"
RETURN
currency_convert:
IF INSTR(UCASE$(stringmathb$), "D") <> 0 OR INSTR(UCASE$(stringmathb$), "E") <> 0 THEN GOSUB scientific_to_numeric
IF INSTR(stringmathb$, ",") = 0 THEN GOSUB comma_placement
IF INSTR(stringmathb$, ".") = 0 THEN stringmathb$ = stringmathb$ + ".00"
IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = stringmathb$ + "00"
IF MID$(stringmathb$, LEN(stringmathb$) - 2, 1) <> "." THEN stringmathb$ = stringmathb$ + "0"
IF MID$(stringmathb$, LEN(stringmathb$) - 2, 1) <> "." THEN stringmathb$ = "invalid number": RETURN
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
stringmathb$ = sm_sign$ + "$" + stringmathb$
RETURN
numeric_to_scientific:
IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): n2sign$ = "-"
IF INSTR(stringmathb$, ".") = 0 THEN exponentvalue&& = LEN(stringmathb$) - 1 ELSE exponentvalue&& = INSTR(stringmathb$, ".") - 2 ' Exponent is one less than number of digits for whole number an two less than the placement of the decimal point for a fraction.
stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1)
IF LEFT$(stringmathb$, 1) = "0" AND LEN(stringmathb$) > 1 OR exponentvalue&& = -1 THEN
DO UNTIL LEFT$(stringmathb$, 1) <> "0" ' Remove leading zeros to consider rounding.
stringmathb$ = MID$(stringmathb$, 2)
exponentvalue&& = exponentvalue&& - 1
LOOP
esign$ = "-"
ELSE
esign$ = "+"
END IF
DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Remove trailing zeros.
stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
LOOP
IF stringmathb$ = "" THEN stringmathb$ = "0": esign$ = "+": exponentvalue&& = 0
stringmathb$ = LEFT$(stringmathb$, 1) + "." + MID$(stringmathb$, 2)
IF stringmathb$ = "0." THEN n2sign$ = "": esign$ = "+"
stringmathb$ = stringmathb$ + "e" + esign$ + LTRIM$(STR$(ABS(exponentvalue&&))) ' S.N formed here.
IF stringmathb$ <> "overflow" THEN
stringmathb$ = n2sign$ + stringmathb$
END IF
n2sign$ = "": esign$ = "": exponentvalue&& = 0
RETURN
scientific_to_numeric:
IF INSTR(UCASE$(stringmathb$), "D") THEN MID$(stringmathb$, INSTR(UCASE$(stringmathb$), "D"), 1) = "e"
IF MID$(stringmathb$, INSTR(stringmathb$, "e") + 2) = "0" THEN ' The numeric value is the number without the zero exponent.
stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, "e") - 1)
IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
RETURN
ELSE
IF LEFT$(stringmathb$, 1) = "-" THEN stn_sign$ = "-": stringmathb$ = MID$(stringmathb$, 2)
stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1) ' Remove decimal point.
stn_i& = INSTR(stringmathb$, "e") - 1 ' Length of the numric part.
IF MID$(stringmathb$, INSTR(stringmathb$, "e") + 1, 1) = "-" THEN
stringmathb$ = "." + STRING$(VAL(MID$(stringmathb$, stn_i& + 3)) - 1, "0") + MID$(stringmathb$, 1, stn_i&) ' Decimal point followed by exponent value in zeros added in front of numeric part.
ELSE
IF stn_i& - 1 > VAL(MID$(stringmathb$, stn_i& + 3)) THEN stn_point$ = "." ' - 1 for decimal place. Ex 2.034d+2 is 2034 here where 3 places to the right . could be moved before . disappears. > so no trailing decimal results.
stringmathb$ = MID$(MID$(stringmathb$, 1, stn_i&), 1, VAL(MID$(stringmathb$, stn_i& + 3)) + 1) + stn_point$ + MID$(MID$(stringmathb$, 1, stn_i&), VAL(MID$(stringmathb$, stn_i& + 3)) + 2, stn_i& - VAL(MID$(stringmathb$, stn_i& + 3)) - 1) + STRING$(VAL(MID$(stringmathb$, stn_i& + 2)) - (stn_i& - 1), "0")
END IF
END IF
IF stringmathb$ = "0" THEN stn_sign$ = ""
stringmathb$ = stn_sign$ + stringmathb$
stn_sign$ = "": stn_point$ = ""
RETURN
limit_round_convert:
' Try SN if whole number is too large (as it may be trailing zeros) or decimal is beyond limit.
IF LEFT$(stringmathb$, 2) = ".0" AND LEN(stringmathb$) > limit&& + 1 OR INSTR(stringmathb$, ".") > limit&& + 1 OR INSTR(stringmathb$, ".") = 0 AND LEN(stringmathb$) > limit&& THEN
IF limit&& > 1 THEN
GOSUB numeric_to_scientific ' Retry as S.N.
IF LEN(stringmathb$) > limit&& + 3 THEN ' Needs rounding.
snotation$ = MID$(stringmathb$, INSTR(UCASE$(stringmathb$), "E"))
exponentvalue&& = VAL(MID$(snotation$, 2)) ' Get positive or negative sign.
snexponent$ = MID$(stringmathb$, INSTR(UCASE$(stringmathb$), "E") + 2)
stringmathb$ = MID$(stringmathb$, 1, INSTR(UCASE$(stringmathb$), "E") - 1)
'''IF LEN(stringmathb$) + LEN(snexponent$) > limit&& + 1 AND exponentvalue&& >= limit&& THEN BEEP
IF exponentvalue&& >= limit&& THEN
stringmathb$ = MID$(stringmathb$, 1, exponentvalue&& + 3)
ELSE
stringmathb$ = MID$(stringmathb$, 1, limit&& - LEN(snexponent$) + 2)
END IF
GOSUB string_rounding_method
IF LEFT$(stringmathb$, 3) = "10." THEN
stringmathb$ = "1." + MID$(stringmathb$, 4)
' Add one to the exponent.
FOR round_i& = LEN(snexponent$) TO 1 STEP -1
round_x$ = CHR$(ASC(MID$(snexponent$, round_i&, 1)) + 1)
IF round_x$ <> CHR$(47) THEN ' Decimal point + 1. Ignore.
IF round_x$ = CHR$(58) THEN
MID$(snexponent$, round_i&, 1) = "0": carry$ = "1"
ELSE
MID$(snexponent$, round_i&, 1) = round_x$: carry$ = "": EXIT FOR
END IF
END IF
NEXT
snexponent$ = carry$ + snexponent$: carry$ = ""
END IF
stringmathb$ = stringmathb$ + MID$(snotation$, 1, 2) + snexponent$
IF LEN(snexponent$) + LEN(MID$(stringmathb$, 1, INSTR(UCASE$(stringmathb$), "E") - 1)) > limit&& + 1 THEN
stringmathb$ = "overflow"
END IF
exponentvalue&& = 0
END IF
ELSE
IF INSTR(stringmathb$, ".") > 0 AND INSTR(stringmathb$, ".") <= limit&& THEN
stringmathb$ = MID$(stringmathb$, 1, limit&& + 2)
IF round_total% = -1 AND RIGHT$(stringmathb$, 1) > "4" THEN
GOSUB string_rounding_method
ELSE
stringmathb$ = MID$(stringmathb$, 1, limit&& + 1)
IF show_rounding% THEN stringmathround$ = "r"
END IF
ELSE
stringmathb$ = "overflow"
END IF
END IF
RETURN
END IF
IF LEN(stringmathb$) > limit&& AND INSTR(stringmathb$, ".") = 0 OR LEN(stringmathb$) > limit&& + 1 AND INSTR(stringmathb$, ".") <> 0 THEN
IF INSTR(stringmathb$, ".") = 0 THEN
stringmathb$ = MID$(stringmathb$, 1, limit&& + 1)
ELSE
stringmathb$ = MID$(stringmathb$, 1, limit&& + 2)
END IF
GOSUB string_rounding_method
IF LEN(stringmathb$) > limit&& + lrc_decimalpoint& THEN ' Ex: limit&& = 4 9999.9 1.e+4
GOSUB numeric_to_scientific
ELSE
IF LEN(stringmathb$) > limit&& + lrc_decimalpoint& THEN stringmathb$ = "overflow"
END IF
END IF
RETURN
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_rounding_method:
IF INSTR(stringmathb$, ".") THEN lrc_decimalpoint& = 1 ELSE lrc_decimalpoint& = 0
IF MID$(stringmathb$, LEN(stringmathb$), 1) > "4" THEN
FOR round_i& = LEN(stringmathb$) - 1 TO 1 STEP -1
round_x$ = CHR$(ASC(MID$(stringmathb$, round_i&, 1)) + 1)
IF round_x$ <> CHR$(47) THEN ' Decimal point + 1. Ignore.
IF round_x$ = CHR$(58) THEN
MID$(stringmathb$, round_i&, 1) = "0": carry$ = "1"
ELSE
MID$(stringmathb$, round_i&, 1) = round_x$: carry$ = "": EXIT FOR
END IF
END IF
NEXT
stringmathb$ = carry$ + MID$(stringmathb$, 1, LEN(stringmathb$) - 1): carry$ = ""
IF show_rounding% THEN stringmathround$ = "R"
ELSE
stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
IF show_rounding% THEN stringmathround$ = "r"
END IF
IF lrc_decimalpoint& THEN
DO UNTIL RIGHT$(stringmathb$, 1) <> "0"
stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
LOOP
IF stringmathb$ = "" OR stringmathb$ = "." THEN stringmathb$ = "0": lrc_decimalpoint& = 0
IF RIGHT$(stringmathb$, 1) = "." AND exponentvalue&& = 0 THEN
stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1): lrc_decimalpoint& = 0
END IF
END IF
RETURN
END SUBI set the default limit&& (number of digits to display) to 1700.
You can unremark the scientific notation variable, if you want results in SN.
Have a great weekend!
Pete
RE: Treebeard's String-Math - Jack - 07-31-2022
thanks Pete
it works as advertised, you are not the first person that has tried to fix the annoyance of floating-point round errors, just search for "exact real arithmetic"
RE: Treebeard's String-Math - bplus - 07-31-2022
@Jack aren't you the one who was giving me pointers in my string math on the old forum? Eg doing square roots with string math and Fibonacci sequence from inverse with the 999... 8 9999 thing?
We do string math because regular math sucks either in precision or decimal point crap.
RE: Treebeard's String-Math - Jack - 07-31-2022
bplus, the reason I posted Treebeard's code was so that SierraKen might consider using string-math in his calculator, I only ported the basic 4 arithmetic functions, just enough to illustrate
RE: Treebeard's String-Math - Jack - 08-08-2022
Updated to include Sqr, Log, Exp and trig functions
RE: Treebeard's String-Math - bplus - 08-08-2022
(08-08-2022, 06:12 PM)Jack Wrote: Updated to include Sqr, Log, Exp and trig functions
Are these (Log, Exp and trig functions, I know about SQR as we worked on it at the old forum) using String math with the Taylor or Maclaurin Series?
RE: Treebeard's String-Math - Jack - 08-08-2022
bplus, I think so
the differences are that these string math routines are not mine, I only adapted them to QB64 also the sqr function seems to extract the root longhand rather than using the newton-raphson