"Actually, 8 new correct digits should appear with each run"
you need high precision arithmetic for that, perhaps you were thinking of the spigot algorithm? http://www.cs.williams.edu/~heeringa/cla...spigot.pdf page 9 has code that you can convert to QB64
(08-16-2022, 05:42 PM)Jack Wrote: "Actually, 8 new correct digits should appear with each run"
you need high precision arithmetic for that, perhaps you were thinking of the spigot algorithm? http://www.cs.williams.edu/~heeringa/cla...spigot.pdf page 9 has code that you can convert to QB64
Thanks for trusting my math skills, but I've never heard of that until now.
For me, "programming" is just a distraction, something to take my mind off things for a while. To do this, I choose something, or I come across something, and then try to solve it. Sometimes it works, but often it doesn't. Well, what the heck.
here's a translation and mod of this c spigot program https://cs.fit.edu/~mmahoney/cse3101/pi.c.txtall credit goes to that author
the program compiled with -O2 runs in about half a second
you could use this in your string-math by changing the printpi sub to simply convert to string
Code: (Select All)
Const maxdigits = 10000
Dim n As Long: n = ((maxdigits + 3) / 12) + 3
Dim As _Unsigned _Integer64 pi(n)
Dim As Long i, j
Dim As _Unsigned _Integer64 t, m, dq, dm
Dim As Double tm
tm = Timer
pi(1) = 4
i = CLng((3.321928094887362 * 12) * n)
While i > 0
t = 0
j = n - 1
While j >= 0
t = t + pi(j) * i
pi(j) = t Mod 1000000000000~&&
t = t \ 1000000000000~&&
j = j - 1
Wend
dq = 0
dm = 0
j = 0
While j < n
m = pi(j) + (dm * 1000000000000~&&)
dq = m \ ((i + i) + 1)
dm = m Mod ((i + i) + 1)
pi(j) = dq
j = j + 1
Wend
pi(1) = pi(1) + 2
i = i - 1
Wend
tm = Timer - tm
printpi pi(), n
Print tm
Sub printpi (pi() As _Unsigned _Integer64, n As Long)
Dim As Long i, l
Dim As String s
Print pi(1); ".";
i = 2
While i < (n - 1)
s = _Trim$(Str$(pi(i)))
l = Len(s)
s = String$(12 - l, "0") + s
Print s;
i = i + 1
Wend
Print
End Sub
(08-15-2022, 04:40 PM)Kernelpanic Wrote: @Pete, I think your path is a dead end. There are several formulas for calculating pi, one of which seems quite workable to me - if the program works. It is the formel by Ramanujan.
Maybe someone will find the error in the calculation?
COLOR 2, 0: PRINT "Ramanu ausgerechnet pi: "; runningtotal$: COLOR 7, 0
_CLIPBOARD$ = runningtotal$ ' Save pi to clipboard.
END
SUB square_root (x$, sqrt$, limit&&)
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_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 "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$
END SUB
SUB string_math (stringmatha$, operator$, stringmathb$, runningtotal$, terminating_decimal%, limit&&)
DIM AS _INTEGER64 a, c, aa, cc, s, ss
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: m_product$ = runningtotal$
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: m_product$ = runningtotal$
operator$ = "-"
stringmatha$ = divremainder$
stringmathb$ = m_product$
GOSUB string_add_subtract_new
stringmatha$ = runningtotal$ '*'
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
'------------------------------------------------------------------------
string_add_subtract_new:
a1$ = stringmatha$: b1$ = stringmathb$
s = 18: i&& = 0: c = 0
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
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
IF operationdivision% THEN RETURN
EXIT SUB
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
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 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")
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$
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
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$
IF operationdivision% THEN RETURN
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: 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
(08-16-2022, 05:11 PM)Kernelpanic Wrote: Thanks! This works, but only once. "n" and "m" apparently have no meaning.
Actually, 8 new correct digits should appear with each run.
The screenshot of the code indicates you've declared nothing AS DOUBLE or AS _FLOAT. They're all SINGLE-precision, that's why the output quickly comes up with incorrect values. It wouldn't be really useful anyway, requires more horsepower as @Pete has cleverly displayed. ::u:
Well guess what? I've been away for a bit. Straight jackets aren't as simple to slip out of as they used to be. Lucky for me, mine was made in China.
So I've been fiddling around with a new improved method of string division. My hunch was it would be about twice as fast on calculating pi in this thread. That would have made it about 35% faster than treebeard's routine. Well that hunch was exceeded significantly, to a 700% speed increase! My old code ran pi in the last loop of 160 digits in 14 seconds on my clunky machine, [b]but this new routine can do it in just 2![/]
Code: (Select All)
'Jack's Ramanujan's Pi Estimator with Pete's String Math Routines.
WIDTH 175, 42
_SCREENMOVE 0, 0
DIM SHARED sqrt$, limit&&, betatest%
betatest% = 0
DIM AS STRING sum, f, f4, f4k, c1, c2, c3, c34k, t1, t2, t3
DIM AS LONG k, k4
DIM t AS DOUBLE
limit&& = 150: square_root "8", sqrt$ ' Limit must be as many or more digits than the max digits of the returned value for pi.
FOR pete% = 0 TO 16
limit&& = pete% + 10 + pete% * 8
t = TIMER
c1 = "1103"
c2 = "26390"
c3 = "396"
f = "1"
f4k = "1"
sum = "1103"
c34k = "1"
k4 = 0
t1 = c3
t2 = c3
sm t1, "*", t2, c3
t1 = c3
t2 = c3
sm t1, "*", t2, c3
FOR k = 1 TO limit&& / (7.984)
t1 = f
sm STR$(k), "*", t1, f
IF betatest% THEN PRINT "results = "; f: SLEEP
t1 = f: t2 = f
sm t1, "*", t2, f4
IF betatest% THEN PRINT "results = "; f4: SLEEP
t1 = f4: t2 = f4
sm t1, "*", t2, f4
IF betatest% THEN PRINT "results = "; f4: SLEEP
t1 = c34k
sm c3, "*", t1, c34k
IF betatest% THEN PRINT "results = "; c34k: SLEEP
t1 = STR$(k4 + 1)
t2 = f4k
sm t1, "*", t2, f4k
IF betatest% THEN PRINT "results = "; f4k: SLEEP
t1 = STR$(k4 + 2)
t2 = f4k
sm t1, "*", t2, f4k
IF betatest% THEN PRINT "results = "; f4k: SLEEP
t1 = STR$(k4 + 3)
t2 = f4k
sm t1, "*", t2, f4k
IF betatest% THEN PRINT "results = "; f4k: SLEEP
t1 = STR$(k4 + 4)
t2 = f4k
sm t1, "*", t2, f4k
IF betatest% THEN PRINT "results = "; f4k: SLEEP
k4 = k4 + 4
t1 = STR$(k)
sm t1, "*", c2, t2
IF betatest% THEN PRINT "results = "; t2: SLEEP
sm c1, "+", t2, t1
IF betatest% THEN PRINT "results = "; t1: SLEEP
sm f4k, "*", t1, t2
IF betatest% THEN PRINT "results = "; t2: SLEEP
sm f4, "*", c34k, t1
IF betatest% THEN PRINT "results = "; t1: SLEEP
sm t2, "/", t1, t3
IF betatest% THEN PRINT "divide results = "; t3: SLEEP
t1 = sum
sm t1, "+", t3, sum
IF betatest% THEN PRINT "sum = "; sum: SLEEP
CALL pi(t1, sum, k)
NEXT
COLOR 14, 0: PRINT "Ramanujan pi = "; MID$("3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481", 1, 11 + (k - 2) * 8)
COLOR 7, 0
t = TIMER - t
PRINT "Time:"; t: PRINT
NEXT pete%
END
SUB pi (t1$, sum$, k)
REM square_root "8", sqrt$
IF betatest% THEN PRINT "sqrt Pi # = "; sqrt$: SLEEP
t2$ = "9801"
sm sqrt$, "/", t2$, t3$
IF betatest% THEN PRINT "Pi # = "; t3$: SLEEP
sm t3$, "*", sum$, t2$
IF betatest% THEN PRINT "Pi # = "; t2$: SLEEP
sm t1$, "/", t2$, t3$
IF betatest% THEN PRINT "Pi # = "; t3$: SLEEP
sm "1", "/", t2$, t1$
IF betatest% THEN PRINT "Pi # = "; t1$: SLEEP
PRINT "loop #"; LTRIM$(STR$(k));: LOCATE , 10: PRINT " pi = "; MID$(t1$, 1, 11 + (k - 1) * 8);: COLOR 8, 0: PRINT MID$(t1$, 11 + (k - 1) * 8 + 1, 4): COLOR 7, 0
END SUB
DEFINT A-Z
SUB sm (s_var1$, operator$, s_var2$, runningtotal$)
DIM AS _INTEGER64 a, c, aa, cc, s, ss
stringmatha$ = s_var1$: stringmathb$ = s_var2$
SELECT CASE operator$
CASE "+", "-"
GOSUB string_add_subtract_new
CASE "*"
GOSUB string_multiply_new
CASE "/"
GOSUB string_divide_new
CASE ELSE
PRINT "Error, no operator selected. operator$ = "; operator$: END
END SELECT
EXIT SUB
string_divide_new:
q$ = "": az$ = stringmathb$: bz$ = stringmatha$
DO ' Falx loop.
'Strip off neg(s) and determine quotent sign.
IF LEFT$(az$, 1) = "-" THEN az$ = MID$(az$, 2): q$ = "-"
IF LEFT$(bz$, 1) = "-" THEN bz$ = MID$(bz$, 2): IF q$ = "-" THEN q$ = "" ELSE q$ = "-"
' Quick results for divisor 1 or 0.
IF az$ = "0" THEN q$ = "0": EXIT DO
IF az$ = "1" THEN q$ = bz$: EXIT DO
IF bz$ = "0" THEN q$ = "Division by zero not possible.": EXIT DO
' Determine decimal direction. -1 to left, +1 to right.
gl% = 0: string_compare az$, bz$, gl%
IF gl% = 1 THEN ' Divisor is larger than dividend so decimal moves to the left.
div_decimal% = -1 ' Move decimal point to the left.
ELSEIF gl% = -1 THEN
div_decimal% = 1 ' Move decimal point to the right.
ELSE
' Divisor and dividend are the same number.
q$ = q$ + "1": EXIT DO
END IF
divisor_ratio_dividend% = gl%
' Strip off decimal point(s) and determine places in these next 2 routines.
dp&& = 0: dp2&& = 0: j2&& = 0
temp&& = INSTR(az$, ".")
IF temp&& THEN
az$ = MID$(az$, 1, temp&& - 1) + MID$(az$, temp&& + 1)
IF temp&& = 1 THEN
DO UNTIL LEFT$(az$, 1) <> "0" ' Strip off any leading zeros on divisor only.
az$ = MID$(az$, 2)
dp&& = dp&& + 1
LOOP
dp&& = dp&& + 1
ELSE
dp&& = -(temp&& - 2)
END IF
ELSE
dp&& = -(LEN(az$) - 1)
END IF
temp&& = INSTR(bz$, ".")
IF temp&& THEN
bz$ = MID$(bz$, 1, temp&& - 1) + MID$(bz$, temp&& + 1)
IF temp&& = 1 THEN
DO UNTIL LEFT$(bz$, 1) <> "0" ' Strip off any leading zeros on divisor only.
bz$ = MID$(bz$, 2)
dp2&& = dp2&& + 1
LOOP
dp2&& = dp2&& + 1
ELSE
dp2&& = -(temp&& - 2)
END IF
ELSE
dp2&& = -(LEN(bz$) - 1)
END IF
dp&& = ABS(dp&& - dp2&&)
' Adjust decimal place for instances when divisor is larger than remainder.
IF MID$(az$, 1, 1) > MID$(bz$, 1, 1) THEN
dp&& = dp&& - div_decimal%
ELSEIF MID$(az$, 1, 1) = MID$(bz$, 1, 1) THEN
IF divisor_ratio_dividend% = 1 THEN
dp&& = dp&& - div_decimal%
END IF
END IF
origbz$ = bz$
' Determine length of divisor and dividend to begin initial long divison step.
gl% = 2: string_compare az$, MID$(bz$, 1, LEN(az$)) + STRING$(LEN(az$) - LEN(bz$), "0"), gl%
divisor_ratio_dividend% = gl%
IF gl% = 1 AND MID$(bz$, 1, 1) <> "0" THEN
bz$ = MID$(bz$, 1, LEN(az$) + 1) + STRING$(LEN(az$) + 1 - LEN(bz$), "0")
ELSE
bz$ = MID$(bz$, 1, LEN(az$)) + STRING$(LEN(az$) - LEN(bz$), "0")
END IF
' Long divison loop. Mult and subtraction of dividend and remainder.
k&& = 0
DO
SELECT CASE MID$(az$, 1, 1)
CASE IS < MID$(bz$, 1, 1)
adj_rem_len% = 0
CASE IS = MID$(bz$, 1, 1)
gl% = 2: string_compare az$, MID$(bz$, 1, LEN(az$)), gl%
IF gl% = 1 THEN adj_rem_len% = 1 ELSE adj_rem_len% = 0
CASE IS > MID$(bz$, 1, 1)
adj_rem_len% = 1
END SELECT
IF j2&& = 0 THEN j2&& = LEN(az$) + adj_rem_len%
DO
IF LEN(az$) > LEN(bz$) THEN
w3&& = 0: runningtotal$ = bz$: stringmathb$ = "0"
EXIT DO
END IF
IF LEN(az$) = LEN(bz$) THEN
gl% = 2: string_compare az$, bz$, gl%
IF gl% = 1 THEN
w3&& = 0: runningtotal$ = bz$: stringmathb$ = "0"
EXIT DO
END IF
END IF
SELECT CASE LEN(bz$)
CASE IS > 2
w3&& = VAL(MID$(bz$, 1, 2 + adj_rem_len%)) \ VAL(MID$(az$, 1, 2))
CASE ELSE
w3&& = VAL(MID$(bz$, 1, 1 + adj_rem_len%)) \ VAL(MID$(az$, 1, 1))
END SELECT
IF w3&& < 9 THEN w3&& = w3&& + 1 ELSE IF w3&& = 10 THEN w3&& = 9
DO
stringmatha$ = az$: stringmathb$ = LTRIM$(STR$(w3&&))
GOSUB string_multiply_new
IF bz$ = "" THEN BEEP: BEEP
gl% = 2: string_compare runningtotal$, bz$, gl%
IF gl% <= 0 OR w3&& = 0 THEN EXIT DO
w3&& = w3&& - 1
LOOP
stringmatha$ = bz$: stringmathb$ = runningtotal$
operator$ = "-": GOSUB string_add_subtract_new
EXIT DO
LOOP
j2&& = j2&& + 1
drop$ = "0": MID$(drop$, 1, 1) = MID$(origbz$, j2&&, 1)
IF runningtotal$ <> "0" THEN remainder$ = runningtotal$ ELSE remainder$ = ""
bz$ = remainder$ + drop$
w3$ = LTRIM$(STR$(w3&&))
temp$ = ""
IF div_decimal% = -1 THEN
IF dp&& AND k&& = 0 THEN
q$ = q$ + "." + STRING$(dp&& - 1, "0")
IF w3&& = 0 THEN w3$ = ""
END IF
END IF
IF div_decimal% >= 0 THEN
IF dp&& = k&& THEN
temp$ = "."
END IF
END IF
q$ = q$ + w3$ + temp$
' Check to terminate
IF div_decimal% = -1 THEN
' Decimal to left.
IF remainder$ = "" AND MID$(origbz$, j2&&, 1) = "" OR LEN(q$) >= limit&& + 8 THEN EXIT DO
ELSE
' Decimal to right.
IF remainder$ = "" AND MID$(origbz$, j2&&, 1) = "" AND k&& >= dp&& OR LEN(q$) >= limit&& + 8 THEN EXIT DO
END IF
IF INKEY$ = " " THEN EXIT DO
k&& = k&& + 1
LOOP
EXIT DO
LOOP
IF RIGHT$(q$, 1) = "." THEN runningtotal$ = MID$(q$, 1, LEN(q$) - 1) ELSE runningtotal$ = q$
RETURN
string_add_subtract_new:
a1$ = stringmatha$: b1$ = stringmathb$
s = 18: i&& = 0: c = 0
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
z$ = ""
' Addition and subtraction of digits.
DO
i&& = i&& + s
x1$ = MID$(a$, LEN(a$) - i&& + 1, s)
x2$ = MID$(b$, LEN(b$) - i&& + 1, s)
IF LEN(x2$) > LEN(x1$) THEN SWAP x1$, x2$
a = VAL(sign_a$ + x1$) + VAL(sign_b$ + x2$) + c
IF x1$ + x2$ = "" AND c = 0 THEN EXIT DO
c = 0
IF a > VAL(STRING$(s, "9")) THEN a = a - 10 ^ s: c = 1
IF a < 0 THEN a = a + 10 ^ s: c = -1 ' a will never be less than 0.
tmp$ = LTRIM$(STR$(a))
z$ = STRING$(LEN(x1$) - LEN(tmp$), "0") + tmp$ + z$
LOOP
IF decimal% THEN
z$ = MID$(z$, 1, LEN(z$) - j&&) + "." + MID$(z$, LEN(z$) - j&& + 1)
END IF
' Remove any leading zeros.
DO
IF LEFT$(z$, 1) = "0" THEN z$ = MID$(z$, 2) ELSE EXIT DO
LOOP
IF z$ = "" OR z$ = "0" THEN z$ = "0" ELSE z$ = LEFT$(sign$, 1) + z$
IF INSTR(a$, "-") <> 0 OR INSTR(b$, "-") <> 0 THEN
IF INSTR(a$, "-") <> 0 AND INSTR(b$, "-") <> 0 THEN
a$ = MID$(a$, 2): b$ = MID$(b$, 2)
ELSE
IF INSTR(a$, "-") <> 0 THEN a$ = MID$(a$, 2) ELSE b$ = MID$(b$, 2)
sign$ = "-"
END IF
END IF
IF INSTR(a$, ".") <> 0 OR INSTR(b$, ".") <> 0 THEN
decimal% = -1
IF INSTR(a$, ".") <> 0 THEN
dec_a&& = LEN(MID$(a$, INSTR(a$, ".") + 1))
a$ = MID$(a$, 1, INSTR(a$, ".") - 1) + MID$(a$, INSTR(a$, ".") + 1)
END IF
IF INSTR(b$, ".") <> 0 THEN
dec_b&& = LEN(MID$(b$, INSTR(b$, ".") + 1))
b$ = MID$(b$, 1, INSTR(b$, ".") - 1) + MID$(b$, INSTR(b$, ".") + 1)
END IF
END IF
IF LEN(a$) < LEN(b$) THEN SWAP a$, b$ ' Needed so x1$ is always the largest for leading zero replacements.
' Multiplication of digits.
DO
h&& = h&& + s: i&& = 0
x2$ = MID$(b$, LEN(b$) - h&& + 1, s)
DO
i&& = i&& + s
x1$ = MID$(a$, LEN(a$) - i&& + 1, s)
a = VAL(x1$) * VAL(x2$) + c
c = 0
tmp$ = LTRIM$(STR$(a))
IF LEN(tmp$) > s THEN c = VAL(MID$(tmp$, 1, LEN(tmp$) - s)): tmp$ = MID$(tmp$, LEN(tmp$) - s + 1)
z$ = STRING$(LEN(x1$) - LEN(tmp$), "0") + tmp$ + z$
LOOP UNTIL i&& >= LEN(a$) AND c = 0
jj&& = jj&& + 1
IF jj&& > 1 THEN
ii&& = 0: cc = 0
aa$ = holdaa$
bb$ = z$ + STRING$((jj&& - 1) * s, "0")
' Addition only of digits.
DO
ii&& = ii&& + ss
xx1$ = MID$(aa$, LEN(aa$) - ii&& + 1, ss)
xx2$ = MID$(bb$, LEN(bb$) - ii&& + 1, ss)
IF LEN(xx1$) < LEN(xx2$) THEN SWAP xx1$, xx2$
aa = VAL(xx1$) + VAL(xx2$) + cc
IF xx1$ + xx2$ = "" AND cc = 0 THEN EXIT DO ' Prevents leading zeros.
cc = 0
IF aa > VAL(STRING$(ss, "9")) THEN aa = aa - 10 ^ ss: cc = 1
tmp$ = LTRIM$(STR$(aa))
zz$ = STRING$(LEN(xx1$) - LEN(tmp$), "0") + tmp$ + zz$
LOOP
DO WHILE LEFT$(zz$, 1) = "0"
IF LEFT$(zz$, 1) = "0" THEN zz$ = MID$(zz$, 2)
LOOP
IF zz$ = "" THEN zz$ = "0"
holdaa$ = zz$
ELSE
holdaa$ = z$ + STRING$(jj&& - 1, "0")
END IF
z$ = "": zz$ = ""
LOOP UNTIL h&& >= LEN(b$)
z$ = holdaa$
IF decimal% THEN
DO UNTIL LEN(z$) >= dec_a&& + dec_b&&
z$ = "0" + z$
LOOP
DO UNTIL RIGHT$(z$, 1) <> "0" AND RIGHT$(z$, 1) <> "."
z$ = MID$(z$, 1, LEN(z$) - 1)
LOOP
END IF
IF STRING$(LEN(z$), "0") = z$ OR z$ = "" OR z$ = "0" THEN z$ = "0" ELSE z$ = sign$ + z$
decimal% = 0: sign$ = ""
runningtotal$ = z$
RETURN
END SUB
SUB string_compare (stringmatha$, stringmathb$, gl%)
compa$ = stringmatha$: compb$ = stringmathb$ ' So original variables do not get changed.
DO
WHILE -1 ' Falx loop.
IF gl% = 2 THEN EXIT WHILE ' For bypassing sign and decimal adjustments when only positive non-decimal numbers are being evaluated.
' Remove trailing zeros after a decimal point.
IF INSTR(compa$, ".") THEN
DO UNTIL RIGHT$(compa$, 1) <> "0" AND RIGHT$(compa$, 1) <> "." AND RIGHT$(compa$, 1) <> "-"
compa$ = MID$(compa$, 1, LEN(compa$) - 1)
LOOP
END IF
IF INSTR(compb$, ".") THEN
DO UNTIL RIGHT$(compb$, 1) <> "0" AND RIGHT$(compb$, 1) <> "." AND RIGHT$(compb$, 1) <> "-"
compb$ = MID$(compb$, 1, LEN(compb$) - 1)
LOOP
END IF
IF MID$(compa$, 1, 2) = "-0" OR compa$ = "" OR compa$ = "-" THEN compa$ = "0"
IF MID$(compb$, 1, 2) = "-0" OR compb$ = "" OR compb$ = "-" THEN compb$ = "0"
' A - and +
IF LEFT$(compa$, 1) = "-" THEN j% = -1
IF LEFT$(compb$, 1) = "-" THEN k% = -1
IF k% = 0 AND j% THEN gl% = -1: EXIT DO
IF j% = 0 AND k% THEN gl% = 1: EXIT DO
' A decimal and non-decimal.
j% = INSTR(compa$, ".")
k% = INSTR(compb$, ".")
IF j% = 0 AND k% THEN
IF compa$ = "0" THEN gl% = -1 ELSE gl% = 1
EXIT DO
END IF
IF k% = 0 AND j% THEN
IF compb$ = "0" THEN gl% = 1 ELSE gl% = -1
EXIT DO
END IF
' Both decimals.
IF j% THEN
SELECT CASE INSTR(compa$, ".")
CASE IS > INSTR(compb$, ".")
gl% = 1
CASE IS = INSTR(compb$, ".")
IF compa$ = compb$ THEN
gl% = 0
ELSEIF compa$ < compb$ THEN gl% = -1
ELSE
gl% = 1
END IF
CASE IS < INSTR(compb$, ".")
gl% = -1
END SELECT
EXIT DO
END IF
EXIT WHILE
WEND
' Remove leading zeros if any.
DO UNTIL LEFT$(compa$, 1) <> "0"
compa$ = MID$(compa$, 2)
LOOP
IF compa$ = "" THEN compa$ = "0"
DO UNTIL LEFT$(compb$, 1) <> "0"
compb$ = MID$(compb$, 2)
LOOP
IF compb$ = "" THEN compb$ = "0"
' Both positive or both negative whole numbers.
SELECT CASE LEN(compa$)
CASE IS < LEN(compb$)
gl% = -1
CASE IS = LEN(compb$)
IF compa$ = compb$ THEN
gl% = 0
ELSEIF compa$ > compb$ THEN gl% = 1
ELSEIF compa$ < compb$ THEN gl% = -1
END IF
CASE IS > LEN(compb$)
gl% = 1
END SELECT
EXIT DO
LOOP
END SUB
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
sm z$, "-", k$, runningtotal$
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
sm sqrt$, "*", "2", y$
y$ = y$ + LTRIM$(STR$(j&&))
ELSE
y$ = LTRIM$(STR$(j&&))
END IF
sm y$, "*", LTRIM$(STR$(j&&)), runningtotal$
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
sm oldy$, "*", LTRIM$(STR$(j&& - h%)), runningtotal$
IF STRING$(LEN(z$), "0") = z$ AND runningtotal$ = "0" AND i&& >= LEN(decx$) THEN EXIT DO
IF dpx&& = 0 THEN ' Limited to && size unless converted to string.
IF i&& >= LEN(decx$) THEN
dpx&& = INT(LEN(decx$) / 2 + .5)
IF dpx&& = 0 THEN dpx&& = -1
END IF
END IF
I kept a beta version of it that prints out what it is doing. I'm thinking I might post it in a new discussion thread on string math division. Basically what I did was to shortcut zero and 1 divisors, chop out leading zeros in small decimal numbers making less digits to calculate, estimate the mult loop by using just the first one or two digits of the divisor and the dividend or remainder so it usually only takes two tries to get the right multiplier before subtracting to obtain the remainder and, of course, working with chunks of numbers with multiplication and subtraction in the long division process.
I knew it would be faster, I'm just amazed it's so much faster.
Now I'm wondering how much faster it could be if I switched from string concatenation to fixed string replacement? I did that once with a c keyboard WP routine (about the only complicated C/C++ prog I've ever written) and the speed increase was pretty impressive. Converting for string math might be a bit of a challenge, and if too many conditions need to be added, it might end up being a push.
The only miss I had on this new routine was the bloat of about 40 more lines than my previous division code. I really wanted to do this one in about the same number of lines but no dice. In contrast, I think I cut code in both the multiplication and add/subtract routines.
(09-11-2022, 01:48 AM)Pete Wrote: I kept a beta version of it that prints out what it is doing. I'm thinking I might post it in a new discussion thread on string math division. Basically what I did was to shortcut zero and 1 divisors, chop out leading zeros in small decimal numbers making less digits to calculate, estimate the mult loop by using just the first one or two digits of the divisor and the dividend or remainder so it usually only takes two tries to get the right multiplier before subtracting to obtain the remainder and, of course, working with chunks of numbers with multiplication and subtraction in the long division process.
I knew it would be faster, I'm just amazed it's so much faster.
Now I'm wondering how much faster it could be if I switched from string concatenation to fixed string replacement? I did that once with a c keyboard WP routine (about the only complicated C/C++ prog I've ever written) and the speed increase was pretty impressive. Converting for string math might be a bit of a challenge, and if too many conditions need to be added, it might end up being a push.
The only miss I had on this new routine was the bloat of about 40 more lines than my previous division code. I really wanted to do this one in about the same number of lines but no dice. In contrast, I think I cut code in both the multiplication and add/subtract routines.
Thanks,
Pete
@Pete Hmm, that sounds pretty straight-forward! I was gunna try that next!
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.)