09-15-2022, 07:27 PM
Okay, so here is the stripped down version. I gave up on using Treebeard's routines, as they are too slow, but they are great for checking.
Just leave the first input statement blank to do Jack's 1001 number and then enter "3" for the root input; otherwise, enter any number and root combination.
Now what's next is to figure out a better exit routine so I can get better speed with accurate digits up to the output limit. That aspect is still out of reach at the moment.
Pete
Just leave the first input statement blank to do Jack's 1001 number and then enter "3" for the root input; otherwise, enter any number and root combination.
Now what's next is to figure out a better exit routine so I can get better speed with accurate digits up to the output limit. That aspect is still out of reach at the moment.
Code: (Select All)
$CONSOLE:ONLY
DIM SHARED limit&&, betatest%: betatest% = 0 '-1
test$ = "31415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055596446229489549303819644288109756659334461284756482337867831652712019091456485669234603486104543266482133936072602491412737245870066063155881748815209209628292540917153643678925903600113305305488204665213841469519415116094330572703657595919530921861173819326117931051185480744623799627495673518857527248912279381830119491298336733624406566430860213949463952247371907021798609437027705392171762931767523846748184676694051320005681271452635608277857713427577896091736371787214684409012249534301465495853710507922796892589235420199561121290219608640344181598136297747713099605187072113499999983729780499510597317328160963185950244594553469083026425223082533446850352619311881710100031378387528865875332083814206171776691473035982534904287554687311595628638823537875937519577818577805321712268066130019278766111959092164201989"
REM Newton's Square Root Algorithm expanded for general roots...
REM a - ((a) ^ root - n) / (root * a ^ (root - 1))
DO
LINE INPUT "Number: "; n$
LINE INPUT "Root: "; root$
IF n$ = "" THEN n$ = test$
limit&& = LEN(n$) + 8
' Approximate first iteration.
xnum&& = LEN(n$) - 1
IF INSTR(n$, ".") THEN xnum&& = xnum&& - 1
IF INSTR(n$, "-") THEN xnum&& = xnum&& - 1
a$ = "1" + STRING$(xnum&& \ VAL(root$), "0") ' Set seed root.
seed$ = a$
DO
temp1$ = sm_sub$(root$, "1")
IF betatest% = 1 THEN PRINT "root - 1 ="; temp1$
i&& = 1: temp2$ = a$
DO UNTIL LTRIM$(STR$(i&&)) = temp1$
i&& = i&& + 1
temp2$ = sm_mult$(a$, temp2$)
LOOP
IF betatest% = 1 THEN PRINT "a$, temp2$: "; a$; " * "; temp2$
sqrt_divisor$ = sm_mult$(temp2$, root$)
IF betatest% = 1 THEN PRINT "divisor$ = "; sqrt_divisor$
temp2$ = a$: i&& = 1
DO UNTIL LTRIM$(STR$(i&&)) = root$
i&& = i&& + 1
temp2$ = sm_mult$(a$, temp2$)
LOOP
IF betatest% = 1 THEN PRINT "a^root, n$: "; temp2$; " - "; n$
sqrt_dividend$ = sm_sub$(temp2$, n$)
IF betatest% = 1 THEN PRINT "dividend$ = "; sqrt_dividend$
temp1$ = sm_div$(sqrt_dividend$, sqrt_divisor$)
IF betatest% = 1 THEN COLOR 15: PRINT "a$ = "; a$; " - "; "temp1$ = "; temp1$, sqrt_dividend$, sqrt_divisor$: COLOR 7
IF betatest% = 1 THEN PRINT "a$, dividend$, divisor$: "; a$; " - "; sqrt_dividend$; " / "; sqrt_divisor$
a$ = sm_sub$(a$, temp1$)
z = z + 1
IF v THEN v = v + 1 ELSE IF MID$(a$, 1, 10) = MID$(olda$, 1, 10) THEN v = 1
olda$ = a$
LOOP UNTIL v = 30 OR z = 100
PRINT "Iterations:"; z; "Results: "; a$: PRINT
IF betatest% = 1 THEN COLOR 8: PRINT LEN(seed$); seed$: COLOR 7
_CLIPBOARD$ = a$
PRINT STRING$(_WIDTH, "-")
z = 0: v = 0: olda$ = ""
LOOP
SUB sm_greater_lesser (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 +
j% = 0: k% = 0
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
j&& = INSTR(compa$, ".")
k&& = INSTR(compb$, ".")
' A starting decimal and non-decimal.
IF j&& = 0 AND k&& = 1 THEN
IF compa$ = "0" THEN gl% = -1 ELSE gl% = 1
EXIT DO
END IF
IF k&& = 0 AND j&& = 1 THEN
IF compb$ = "0" THEN gl% = 1 ELSE gl% = -1
EXIT DO
END IF
' remove decimals and align.
j2&& = 0: k2&& = 0
IF j&& <> 0 OR k&& <> 0 THEN
IF j&& THEN compa$ = MID$(compa$, 1, INSTR(compa$, ".") - 1) + MID$(compa$, INSTR(compa$, ".") + 1): j2&& = LEN(compa$) - j&& + 1
IF k&& THEN compb$ = MID$(compb$, 1, INSTR(compb$, ".") - 1) + MID$(compb$, INSTR(compb$, ".") + 1): k2&& = LEN(compb$) - k&& + 1
compa$ = compa$ + STRING$(k2&& - j2&&, "0")
compb$ = compb$ + STRING$(j2&& - k2&&, "0")
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
'''PRINT "<> gl% ="; gl%; " "; compa$; " "; compb$; " "; stringmatha$; " "; stringmathb$ '''''''
'''IF gl% = 1 AND VAL(compa$) <= VAL(compb$) THEN BEEP: SLEEP ''''''
'''IF gl% = -1 AND VAL(compa$) >= VAL(compb$) THEN BEEP: SLEEP '''''
END SUB
SUB sm_add_subtract_router (stringmatha$, operator$, stringmathb$, runningtotal$)
DIM AS _INTEGER64 a, c, s
a1$ = stringmatha$: b1$ = stringmathb$
s = 18: i&& = 0: c = 0
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$
sm_greater_lesser 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$
runningtotal$ = z$
sign$ = "": sign_a$ = "": sign_b$ = "": i&& = 0: j&& = 0: decimal% = 0: c = 0
END SUB
FUNCTION sm_validate (validate$)
sm_validate = 0: vsn_negcnt& = 0: vsn_poscnt& = 0: vsn_depresent& = 0: decimalcnt& = 0: vsn_numberpresent& = 0: vsn_zerospresent& = 0
IF LEFT$(validate$, 1) = "-" THEN validate$ = MID$(validate$, 2): sm_sign$ = "-" ELSE sm_sign$ = ""
WHILE -1 ' Falx loop.
IF LEFT$(validate$, 1) = "+" THEN IF sm_sign$ <> "-" THEN validate$ = MID$(validate$, 2) ELSE validate$ = "invalid number": EXIT WHILE
IF INSTR(UCASE$(validate$), "D") OR INSTR(UCASE$(validate$), "E") THEN ' Evaluate for Scientific Notation.
FOR sm_i& = 1 TO LEN(validate$)
validatenum$ = MID$(UCASE$(validate$), sm_i&, 1)
SELECT CASE validatenum$
CASE "+"
IF vsn_depresent& THEN vsn_poscnt& = vsn_poscnt& + 1 ELSE validate$ = "invalid number": EXIT WHILE
CASE "-"
IF vsn_depresent& THEN vsn_negcnt& = vsn_negcnt& + 1 ELSE validate$ = "invalid number": EXIT WHILE
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$(validate$, 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 validate$ = MID$(validate$, 1, 1) + "." + MID$(validate$, 2) ' Standardize "."
IF vsn_numberpresent& = 0 OR vsn_negcnt& = 1 AND vsn_poscnt& = 1 OR decimalcnt& > 1 OR INSTR(validate$, ".") <> 2 THEN validate$ = "invalid number": EXIT WHILE
vsn_depresent& = INSTR(validate$, "e")
sm_x$ = MID$(validate$, vsn_depresent& + 1, 1) ' Standardize exponent "+" these two lines.
IF sm_x$ <> "+" AND sm_x$ <> "-" THEN validate$ = MID$(validate$, 1, vsn_depresent&) + "+" + MID$(validate$, vsn_depresent& + 1)
IF MID$(validate$, vsn_depresent& + 2, 1) = "0" THEN
IF MID$(validate$, vsn_depresent& + 3, 1) <> "" THEN validate$ = "invalid number": EXIT WHILE ' No leading zeros allowed in exponent notation.
END IF
jjed& = INSTR(validate$, "e") ' Get position of notation.
valexpside$ = MID$(validate$, jjed&) ' These two lines break up into number and notation
validate$ = MID$(validate$, 1, jjed& - 1) ' validate$ is +- single digit whole number, decimal point and decimal number. valexpside$ is notation, sign and exponent.
DO UNTIL RIGHT$(validate$, 1) <> "0" ' Remove any trailing zeros for number. Example 1.0d3 or 1.0000d3, etc.
validate$ = MID$(validate$, 1, LEN(validate$) - 1)
LOOP
IF VAL(MID$(validate$, 1, INSTR(validate$, ".") - 1)) = 0 THEN
IF RIGHT$(validate$, 1) = "." THEN
validate$ = "0.e+0" ' Handles all types of zero entries.
ELSE
validate$ = "invalid number": EXIT WHILE
END IF
EXIT WHILE
END IF
validate$ = sm_sign$ + validate$ + valexpside$
EXIT WHILE
ELSE
FOR sm_i& = 1 TO LEN(validate$)
validatenum$ = MID$(validate$, 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
validate$ = "invalid number": EXIT WHILE
END SELECT
NEXT
IF decimalcnt& > 1 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& >= 1 AND vsn_poscnt& >= 1 THEN
validate$ = "invalid number": EXIT WHILE
END IF
REM IF INSTR(validate$, "$") THEN GOSUB currency_validate
IF INSTR(validate$, ",") THEN
REM GOSUB comma_validation
IF validate$ = "invalid number" THEN EXIT WHILE
REM GOSUB comma_removal
END IF
IF RIGHT$(validate$, 1) = "." THEN validate$ = MID$(validate$, 1, LEN(validate$) - 1)
DO UNTIL LEFT$(validate$, 1) <> "0" ' Strip off any leading zeros.
validate$ = MID$(validate$, 2)
LOOP
validate$ = sm_sign$ + validate$
IF INSTR(validate$, ".") THEN
DO UNTIL RIGHT$(validate$, 1) <> "0" ' Strip off any trailing zeros in a decimal.
validate$ = MID$(validate$, 1, LEN(validate$) - 1)
LOOP
END IF
IF RIGHT$(validate$, 1) = "." THEN validate$ = MID$(validate$, 1, LEN(validate$) - 1)
IF vsn_numberpresent& = 0 THEN
IF vsn_zerospresent& THEN
validate$ = "0"
ELSE
validate$ = "invalid number"
END IF
END IF
END IF
EXIT WHILE
WEND
IF validate$ = "invalid number" THEN sm_validate = 1 ELSE sm_validate = 0
END FUNCTION
FUNCTION sm_add$ (stringmatha$, stringmathb$)
operator$ = "+"
sm_add_subtract_router stringmatha$, operator$, stringmathb$, runningtotal$
sm_add$ = runningtotal$
END FUNCTION
FUNCTION sm_sub$ (stringmatha$, stringmathb$)
operator$ = "-"
sm_add_subtract_router stringmatha$, operator$, stringmathb$, runningtotal$
sm_sub$ = runningtotal$
END FUNCTION
FUNCTION sm_mult$ (stringmatha$, stringmathb$)
DIM AS _INTEGER64 a, c, aa, cc, s, ss
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$ ' 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
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 STRING$(LEN(z$), "0") = z$ OR z$ = "" OR z$ = "0" THEN z$ = "0" ELSE z$ = sign$ + z$
decimal% = 0: sign$ = ""
runningtotal$ = z$
sm_mult$ = z$
END FUNCTION
FUNCTION sm_div$ (stringmatha$, stringmathb$)
hold_stringmatha$ = stringmatha$: hold_stringmathb$ = stringmathb$
q$ = "": divisor$ = stringmathb$: dividend$ = stringmatha$
DO ' Falx loop.
'Strip off neg(s) and determine quotent sign.
IF LEFT$(divisor$, 1) = "-" THEN divisor$ = MID$(divisor$, 2): q$ = "-"
IF LEFT$(dividend$, 1) = "-" THEN dividend$ = MID$(dividend$, 2): IF q$ = "-" THEN q$ = "" ELSE q$ = "-"
' Quick results for divisor 1 or 0.
IF dividend$ = "0" THEN q$ = "0": EXIT DO
IF divisor$ = "1" THEN q$ = dividend$: EXIT DO
IF divisor$ = "0" THEN q$ = "Division by zero not possible.": EXIT DO
' Determine decimal direction. -1 to left, +1 to right.
gl% = 0: sm_greater_lesser divisor$, dividend$, gl%
IF betatest% AND gl% = 1 THEN PRINT divisor$; " > "; dividend$; " Move decimal to the left"
IF betatest% AND gl% = 0 THEN PRINT divisor$; " = "; dividend$
IF betatest% AND gl% = -1 THEN PRINT divisor$; " < "; dividend$; " Move deciml to the right."
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(divisor$, ".")
IF temp&& THEN
divisor$ = MID$(divisor$, 1, temp&& - 1) + MID$(divisor$, temp&& + 1)
IF temp&& = 1 THEN
DO UNTIL LEFT$(divisor$, 1) <> "0" ' Strip off any leading zeros on divisor only.
divisor$ = MID$(divisor$, 2)
dp&& = dp&& + 1
LOOP
dp&& = dp&& + 1
ELSE
dp&& = -(temp&& - 2)
END IF
ELSE
dp&& = -(LEN(divisor$) - 1)
END IF
temp&& = INSTR(dividend$, ".")
IF temp&& THEN
dividend$ = MID$(dividend$, 1, temp&& - 1) + MID$(dividend$, temp&& + 1)
IF temp&& = 1 THEN
DO UNTIL LEFT$(dividend$, 1) <> "0" ' Strip off any leading zeros on divisor only.
dividend$ = MID$(dividend$, 2)
dp2&& = dp2&& + 1
LOOP
dp2&& = dp2&& + 1
ELSE
dp2&& = -(temp&& - 2)
END IF
ELSE
dp2&& = -(LEN(dividend$) - 1)
END IF
IF betatest% THEN COLOR 11: PRINT "Divisor decimal moves "; LTRIM$(STR$(dp&&)); ". Dividend decimal moves"; LTRIM$(STR$(dp2&&)); ". Quotent decimal ABS("; LTRIM$(STR$(dp&&)); " - "; LTRIM$(STR$(dp2&&)); ") =";: COLOR 14: PRINT ABS(dp&& - dp2&&);: COLOR 11: PRINT "+ any adjustment.": COLOR 7
dp&& = ABS(dp&& - dp2&&)
IF betatest% THEN PRINT "Divisor 1st# = "; MID$(divisor$, 1, 1); " Remainder 1st# = "; MID$(dividend$, 1, 1)
' Adjust decimal place for instances when divisor is larger than remainder the length of the divisor.
j% = 0
IF MID$(divisor$, 1, 1) > MID$(dividend$, 1, 1) THEN
j% = 1
IF betatest% THEN PRINT "Larger divisor, so move quotent decimal one place back to: ";: COLOR 14: PRINT LTRIM$(STR$(dp&&)): COLOR 7
ELSEIF MID$(divisor$, 1, 1) = MID$(dividend$, 1, 1) THEN
IF LEN(divisor$) = LEN(dividend$) THEN
IF divisor$ > dividend$ THEN j% = 1
ELSE
IF LEN(divisor$) > LEN(dividend$) THEN
temp$ = dividend$ + STRING$(LEN(divisor$) - LEN(dividend$), "0")
ELSE
temp$ = MID$(dividend$, 1, LEN(divisor$))
END IF
IF divisor$ > temp$ THEN j% = 1
END IF
IF j% THEN
dp&& = dp&& - div_decimal%
IF betatest% THEN PRINT "Larger divisor than dividend at LEN(divisor$), so move quotent decimal one place back to: ";: COLOR 14: PRINT LTRIM$(STR$(dp&&)): COLOR 7
ELSE
IF betatest% THEN PRINT "Smaller divisor than dividend at LEN(divisor$), so no quotent decimal place adjustment needed. Quotent decimal place = ";: COLOR 14: PRINT LTRIM$(STR$(dp&&)): COLOR 7
END IF
ELSE
j% = 0
IF betatest% THEN PRINT "Smaller divisor, so no quotent decimal place adjustment needed. Quotent decimal place = ";: COLOR 14: PRINT LTRIM$(STR$(dp&&)): COLOR 7
END IF
IF j% THEN dp&& = dp&& - div_decimal%
origdividend$ = dividend$
' Determine length of divisor and dividend to begin initial long divison step.
gl% = 2: sm_greater_lesser divisor$, MID$(dividend$, 1, LEN(divisor$)) + STRING$(LEN(divisor$) - LEN(dividend$), "0"), gl%
divisor_ratio_dividend% = gl%
IF gl% = 1 AND MID$(dividend$, 1, 1) <> "0" THEN
dividend$ = MID$(dividend$, 1, LEN(divisor$) + 1) + STRING$(LEN(divisor$) + 1 - LEN(dividend$), "0")
ELSE
dividend$ = MID$(dividend$, 1, LEN(divisor$)) + STRING$(LEN(divisor$) - LEN(dividend$), "0")
END IF
' Long divison loop. Mult and subtraction of dividend and remainder.
k&& = 0
IF betatest% THEN PRINT "Begin long divison loop..."
DO
SELECT CASE MID$(divisor$, 1, 1)
CASE IS < MID$(dividend$, 1, 1)
adj_rem_len% = 0
CASE IS = MID$(dividend$, 1, 1)
gl% = 2: sm_greater_lesser divisor$, MID$(dividend$, 1, LEN(divisor$)), gl%
IF gl% = 1 THEN adj_rem_len% = 1 ELSE adj_rem_len% = 0
CASE IS > MID$(dividend$, 1, 1)
adj_rem_len% = 1
END SELECT
IF j2&& = 0 THEN j2&& = LEN(divisor$) + adj_rem_len%
DO
IF LEN(divisor$) > LEN(dividend$) THEN
w3&& = 0: runningtotal$ = dividend$: stringmathb$ = "0"
IF betatest% THEN PRINT: COLOR 3: PRINT "Divisor is larger so "; dividend$; " \ "; divisor$; " =";: COLOR 5: PRINT w3&&: COLOR 7
EXIT DO
END IF
IF LEN(divisor$) = LEN(dividend$) THEN
gl% = 2: sm_greater_lesser divisor$, dividend$, gl%
IF gl% = 1 THEN
w3&& = 0: runningtotal$ = dividend$: stringmathb$ = "0"
IF betatest% THEN COLOR 9: PRINT "Length of divisor is the same as remainder but remainder is smaller so w3&& = ";: COLOR 5: PRINT "0": COLOR 7
EXIT DO
END IF
END IF
SELECT CASE LEN(dividend$)
CASE IS > 2
w3&& = VAL(MID$(dividend$, 1, 2 + adj_rem_len%)) \ VAL(MID$(divisor$, 1, 2))
IF betatest% THEN PRINT MID$(dividend$, 1, 2 + adj_rem_len%); " \ "; MID$(divisor$, 1, 2); " =";
CASE ELSE
w3&& = VAL(MID$(dividend$, 1, 1 + adj_rem_len%)) \ VAL(MID$(divisor$, 1, 1))
IF betatest% THEN PRINT MID$(dividend$, 1, 1 + adj_rem_len%); " \ "; MID$(divisor$, 1, 1); " =";
END SELECT
IF betatest% THEN COLOR 5: PRINT " " + LTRIM$(STR$(w3&&));: COLOR 7: PRINT ". Begin mult est. at or one above this number."
IF w3&& < 9 THEN w3&& = w3&& + 1 ELSE IF w3&& = 10 THEN w3&& = 9
DO
stringmatha$ = divisor$: stringmathb$ = LTRIM$(STR$(w3&&))
runningtotal$ = sm_mult$(divisor$, LTRIM$(STR$(w3&&)))
gl% = 2: sm_greater_lesser runningtotal$, dividend$, gl%
IF gl% <= 0 OR w3&& = 0 THEN EXIT DO
IF betatest% THEN COLOR 8: PRINT "Mult loop:"; w3&&; "* "; divisor$; " = "; runningtotal$: COLOR 7
w3&& = w3&& - 1
LOOP
stringmatha$ = dividend$: stringmathb$ = runningtotal$
sm_add_subtract_router dividend$, "-", stringmathb$, runningtotal$
EXIT DO
LOOP
IF betatest% THEN PRINT LTRIM$(STR$(w3&&)); " * "; divisor$; " = "; stringmathb$; " | "; stringmatha$; " - "; stringmathb$; " = "; runningtotal$; " Remainder and drop-down = ";
j2&& = j2&& + 1
drop$ = "0": MID$(drop$, 1, 1) = MID$(origdividend$, j2&&, 1)
IF runningtotal$ <> "0" THEN remainder$ = runningtotal$ ELSE remainder$ = ""
dividend$ = 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$
IF betatest% AND remainder$ = "" THEN betatemp$ = CHR$(34) + CHR$(34) ELSE IF betatest% THEN betatemp$ = remainder$
IF betatest% AND MID$(origdividend$, j2&&, 1) = "" THEN betatemp2$ = CHR$(34) + CHR$(34) ELSE IF betatest% THEN betatemp2$ = MID$(origdividend$, j2&&, 1)
IF betatest% THEN PRINT dividend$; " ("; betatemp$; " + "; drop$; ") at:"; j2&&; "of "; origdividend$; " Loop"; k&& + 1; "Quotent = ";: COLOR 14, 4: PRINT q$;: COLOR 7, 0: PRINT: SLEEP
' Check to terminate
IF div_decimal% = -1 THEN
' Decimal to left.
IF remainder$ = "" AND MID$(origdividend$, j2&&, 1) = "" OR LEN(q$) >= limit&& THEN EXIT DO
ELSE
' Decimal to right.
IF remainder$ = "" AND MID$(origdividend$, j2&&, 1) = "" AND k&& >= dp&& OR LEN(q$) >= limit&& THEN EXIT DO
END IF
IF INKEY$ = " " THEN EXIT DO
k&& = k&& + 1
LOOP
EXIT DO
LOOP
IF RIGHT$(q$, 1) = "." AND divisor$ <> "0" THEN runningtotal$ = MID$(q$, 1, LEN(q$) - 1) ELSE runningtotal$ = q$
sm_div$ = runningtotal$
stringmatha$ = hold_stringmatha$: stringmathb$ = hold_stringmathb$
END FUNCTION
FUNCTION sm_sqrt$ (sm_var$)
oldy$ = "": sqrt$ = "": IF limit&& < 150 THEN custom_limit&& = 150 ELSE custom_limit&& = limit&&
sqrt_a$ = sm_var$
IF INSTR(sqrt_a$, ".") THEN
decx$ = MID$(sqrt_a$, 1, INSTR(sqrt_a$, ".") - 1)
sqrt_a$ = MID$(sqrt_a$, 1, INSTR(sqrt_a$, ".") - 1) + MID$(sqrt_a$, INSTR(sqrt_a$, ".") + 1)
IF LEN(sqrt_a$) = 1 THEN sqrt_a$ = sqrt_a$ + "0"
ELSE
decx$ = sqrt_a$
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
runningtotal$ = sm_sub$(z$, k$) ''''' sm z$, "-", k$, runningtotal$
z$ = runningtotal$ + (MID$(sqrt_a$, i&&, 2))
IF LEFT$(z$, 1) = "0" THEN z$ = MID$(z$, 2) ' Remove leading zeros
oldy$ = ""
FOR j&& = 1 TO 10
IF i&& > 1 THEN
y$ = sm_mult$(sqrt$, "2") '''' sm sqrt$, "*", "2", y$
y$ = y$ + LTRIM$(STR$(j&&))
ELSE
y$ = LTRIM$(STR$(j&&))
END IF
runningtotal$ = sm_mult$(y$, LTRIM$(STR$(j&&))) '''''sm y$, "*", LTRIM$(STR$(j&&)), runningtotal$
sm_greater_lesser runningtotal$, z$, gl%
IF gl% > -1 THEN
IF gl% = 0 THEN
h% = 0: oldy$ = y$ ' Perfect square division.
ELSE
h% = 1
END IF
runningtotal$ = sm_mult$(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
IF betatest% < -1 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%))
runningtotal$ = sm_mult$(oldy$, LTRIM$(STR$(j&& - h%))) '''', runningtotal$
k$ = runningtotal$
IF betatest% < -1 THEN PRINT "Remainder "; z$; " minus "; k$; " = ";
EXIT FOR
END IF
oldy$ = y$
NEXT
i&& = i&& + 2
IF LEN(z$) >= custom_limit&& THEN EXIT DO
sqrt_a$ = sqrt_a$ + "00"
LOOP
IF dpx&& THEN sqrt$ = MID$(sqrt$, 0, dpx&& + 1) + "." + MID$(sqrt$, dpx&& + 1)
sm_sqrt$ = sqrt$
END FUNCTION
FUNCTION sm_sqr$ (sm_var$)
runningtotal$ = sm_mult$(sm_var$, sm_var$)
sm_sqr$ = runningtotal$
END FUNCTIONPete