String Math

[bplus]

Just thought of a great way to test mult$ function. How about first 500 factorials check?

If the 500th is correct then it is pretty good assumption that all that went before it is correct.
1135 digits all good! And done in a sneeze.

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "String Math Factorial test" 'b+ started 2020-08-15 using to add$() and mult$ for Factorials
3. ' 2020-08-14 start with add 2 arbitrary long strings
4. ' 2020-08-14 add$ posted 5 PM or so
5. ' 2020-08-14 opt explicit, start subtr$ function
6. ' 2020-08-15 1 AM subst$ function looking good!
7. ' 2020-08-15 fix some code from previous subs then attempt mult$ sub
8. ' 2020-08-15 Factorials! a wonderful test for String Math mult$
9. ' 2020-08-15 WOW! 500 factorials in an instant and it's matching 500!
10. '            at  https://www.calculatorsoup.com/calculators/discretemathematics/factorials.php
11.  
12. RANDOMIZE TIMER 'now that it's seems to be running silent
13. SCREEN _NEWIMAGE(1024, 700, 32)
14. _DELAY .25
15. _SCREENMOVE _MIDDLE
16.  
17. FactorialSetup
18.  
19.  
20. FUNCTION Factorial$ (n AS INTEGER)
21.     DIM top AS INTEGER, fline$
22.     'find the highest factorial we have so far
23.     OPEN "Factorial Data.txt" FOR INPUT AS #1
24.     WHILE EOF(1) = 0
25.         LINE INPUT #1, fline$
26.         top = top + 1
27.         IF n = top THEN Factorial$ = rightOf$(fline$, "="): EXIT FUNCTION
28.     WEND
29.  
30.     'finish later
31.  
32. END FUNCTION
33.  
34. SUB FactorialSetup
35.     DIM i AS INTEGER, fac$
36.     IF _FILEEXISTS("Factorial Data.txt") THEN 'assume its started and correct
37.         EXIT SUB
38.     ELSE
39.         OPEN "Factorial Data.txt" FOR OUTPUT AS #1
40.         fac$ = "1"
41.         PRINT #1, "1=1"
42.         FOR i = 2 TO 500
43.             fac$ = mult$(_TRIM$(STR$(i)), fac$)
44.             PRINT #1, _TRIM$(STR$(i)) + "=" + fac$
45.             PRINT i, fac$
46.         NEXT
47.         CLOSE #1
48.     END IF
49. END SUB
50.  
51. FUNCTION mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
52.     DIM la AS INTEGER, lb AS INTEGER, m AS INTEGER, g AS INTEGER, i AS INTEGER, find AS INTEGER, dp AS INTEGER
53.     DIM v18 AS _UNSIGNED _INTEGER64, sd AS _UNSIGNED _INTEGER64, co AS _UNSIGNED _INTEGER64
54.     DIM f18$, f1$, t$, build$, accum$
55.  
56.     'find the longer number and make it a mult of 18 to take 18 digits at a time from it
57.     la = LEN(a$): lb = LEN(b$)
58.     IF la > lb THEN
59.         m = INT(la / 18) + 1
60.         f18$ = RIGHT$(STRING$(m * 18, "0") + a$, m * 18)
61.         f1$ = b$
62.     ELSE
63.         m = INT(lb / 18) + 1
64.         f18$ = RIGHT$(STRING$(m * 18, "0") + b$, m * 18)
65.         f1$ = a$
66.     END IF
67.     FOR dp = LEN(f1$) TO 1 STEP -1 'dp = digit position of the f1$
68.         build$ = "" 'line builder
69.         co = 0
70.         'now taking 18 digits at a time Thanks Steve McNeill
71.         FOR g = 1 TO m
72.             v18 = VAL(MID$(f18$, m * 18 - g * 18 + 1, 18))
73.             sd = VAL(MID$(f1$, dp, 1))
74.             t$ = RIGHT$(STRING$(19, "0") + _TRIM$(STR$(v18 * sd + co)), 19)
75.             co = VAL(MID$(t$, 1, 1))
76.             build$ = MID$(t$, 2) + build$
77.         NEXT g
78.         IF co THEN build$ = _TRIM$(STR$(co)) + build$
79.         IF dp = LEN(f1$) THEN
80.             accum$ = build$
81.         ELSE
82.             accum$ = add$(accum$, build$ + STRING$(LEN(f1$) - dp, "0"))
83.         END IF
84.     NEXT dp
85.     'strip 0
86.     i = 1: find = 0
87.     WHILE i < LEN(accum$) AND MID$(accum$, i, 1) = "0"
88.         i = i + 1: find = 1
89.     WEND
90.     IF find = 1 THEN accum$ = MID$(accum$, i)
91.     mult$ = accum$
92. END FUNCTION
93.  
94. FUNCTION subtr$ (sum$, minus$) ' assume both numbers are positive all digits
95.     IF sum$ = minus$ THEN subtr$ = "0": EXIT SUB
96.  
97.     DIM ls AS INTEGER, lm AS INTEGER, m AS INTEGER, g AS INTEGER, i AS INTEGER, find AS INTEGER, p AS INTEGER
98.     DIM VB AS _UNSIGNED _INTEGER64, vs AS _UNSIGNED _INTEGER64, tenE18 AS _UNSIGNED _INTEGER64
99.     DIM sign$, LG$, sm$, t$, result$
100.  
101.     tenE18 = 1000000000000000000 'yes!!! no dang E's
102.     ' which is bigger?
103.     ls = LEN(sum$): lm = LEN(minus$)
104.     IF ls > lm THEN
105.         sign$ = ""
106.         m = INT(ls / 18) + 1
107.         LG$ = RIGHT$(STRING$(m * 18, "0") + sum$, m * 18)
108.         sm$ = RIGHT$(STRING$(m * 18, "0") + minus$, m * 18)
109.     ELSEIF ls < lm THEN
110.         sign$ = "-"
111.         m = INT(lm / 18) + 1
112.         LG$ = RIGHT$(STRING$(m * 18, "0") + minus$, m * 18)
113.         sm$ = RIGHT$(STRING$(m * 18, "0") + sum$, m * 18)
114.     ELSEIF ls = lm THEN
115.         FOR i = 1 TO LEN(sum$)
116.             IF VAL(MID$(sum$, i, 1)) > VAL(MID$(minus$, i, 1)) THEN
117.                 sign$ = ""
118.                 m = INT(ls / 8) + 1
119.                 LG$ = RIGHT$(STRING$(m * 18, "0") + sum$, m * 18)
120.                 sm$ = RIGHT$(STRING$(m * 18, "0") + minus$, m * 18)
121.                 EXIT FOR
122.             ELSEIF VAL(MID$(sum$, i, 1)) < VAL(MID$(minus$, i, 1)) THEN
123.                 sign$ = "-"
124.                 m = INT(lm / 18) + 1
125.                 LG$ = RIGHT$(STRING$(m * 18, "0") + minus$, m * 18)
126.                 sm$ = RIGHT$(STRING$(m * 18, "0") + sum$, m * 18)
127.                 EXIT FOR
128.             END IF
129.         NEXT
130.     END IF
131.     'now taking 18 digits at a time From Steve I learned we can do 18
132.     FOR g = 1 TO m
133.         VB = VAL(MID$(LG$, m * 18 - g * 18 + 1, 18))
134.         vs = VAL(MID$(sm$, m * 18 - g * 18 + 1, 18))
135.         IF vs > VB THEN
136.             t$ = RIGHT$(STRING$(18, "0") + _TRIM$(STR$(tenE18 - vs + VB)), 18)
137.  
138.             'debug
139.             'PRINT VB, tenE18, tenE18 - vs + VB, " t$ = "; t$
140.  
141.             ''borrow 1 = rewrite string
142.             p = (m - g) * 18
143.             WHILE p > 0 AND MID$(LG$, p, 1) = "0"
144.                 MID$(LG$, p, 1) = "9"
145.                 p = p - 1
146.             WEND
147.             IF p > 0 THEN MID$(LG$, p, 1) = _TRIM$(STR$(VAL(MID$(LG$, p, 1)) - 1))
148.         ELSE
149.             t$ = RIGHT$(STRING$(18, "0") + _TRIM$(STR$(VB - vs)), 18)
150.         END IF
151.         result$ = t$ + result$
152.     NEXT
153.     result$ = _TRIM$(result$)
154.     'strip 0
155.     i = 1: find = 0
156.     WHILE i < LEN(result$) AND MID$(result$, i, 1) = "0"
157.         i = i + 1: find = 1
158.     WEND
159.     IF find = 1 THEN result$ = MID$(result$, i)
160.     subtr$ = sign$ + result$
161. END FUNCTION
162.  
163. FUNCTION add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
164.     DIM la AS INTEGER, lb AS INTEGER, m AS INTEGER, g AS INTEGER, i AS INTEGER, find AS INTEGER
165.     DIM sa AS _UNSIGNED _INTEGER64, sb AS _UNSIGNED _INTEGER64, co AS _UNSIGNED _INTEGER64
166.     DIM fa$, fb$, t$, new$, result$
167.  
168.     'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
169.     la = LEN(a$): lb = LEN(b$)
170.     IF la > lb THEN m = INT(la / 18) + 1 ELSE m = INT(lb / 18) + 1
171.     fa$ = RIGHT$(STRING$(m * 18, "0") + a$, m * 18)
172.     fb$ = RIGHT$(STRING$(m * 18, "0") + b$, m * 18)
173.  
174.     'now taking 18 digits at a time Thanks Steve McNeill
175.     FOR g = 1 TO m
176.         sa = VAL(MID$(fa$, m * 18 - g * 18 + 1, 18))
177.         sb = VAL(MID$(fb$, m * 18 - g * 18 + 1, 18))
178.         t$ = RIGHT$(STRING$(36, "0") + _TRIM$(STR$(sa + sb + co)), 36)
179.         co = VAL(MID$(t$, 1, 18))
180.         new$ = MID$(t$, 19)
181.         result$ = new$ + result$
182.  
183.         'debug
184.         'DIM w$
185.         'PRINT a$, m * 18, sa, sb, t$, co, result$
186.         'INPUT "OK "; w$ 'OK
187.     NEXT
188.     IF co THEN result$ = STR$(co) + result$
189.     result$ = _TRIM$(result$)
190.     'strip 0
191.     i = 1: find = 0
192.     WHILE i < LEN(result$) AND MID$(result$, i, 1) = "0"
193.         i = i + 1: find = 1
194.     WEND
195.     IF find = 1 THEN result$ = MID$(result$, i)
196.     add$ = result$
197. END FUNCTION
198.  
199. FUNCTION leftOf$ (source$, of$)
200.     IF INSTR(source$, of$) > 0 THEN leftOf$ = MID$(source$, 1, INSTR(source$, of$) - 1)
201. END FUNCTION
202.  
203. FUNCTION rightOf$ (source$, of$)
204.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
205. END FUNCTION
206.  
207.  
208.  

 

[bplus]

Looks like I should change the code for subtr$() function.
Update, failed:

Code: QB64: [Select]

1. PRINT "9 minus 3 but 3 is tricky! "; subtr$("9", "00003")
2.  

Fix one thing and another goes bad:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "String Math subtr$" 'b+ started 2020-08-14
3. ' 2020-08-14 start with add 2 arbitrary long strings
4. ' 2020-08-14 add$ posted 5 PM or so
5. ' 2020-08-14 opt explicit, start subtr$ function
6. ' 2020-08-15 1 AM subst$ function looking good!
7. ' 2020-08-16 problem found with string compare and QB64 fails compare with longer strings
8.  
9. 'RANDOMIZE TIMER 'now that it's seems to be running silent
10. SCREEN _NEWIMAGE(1024, 700, 32)
11. _DELAY .25
12. _SCREENMOVE _MIDDLE
13.  
14. ' special or hard cases found while testing
15. PRINT subtr$("0", "0")
16. PRINT subtr$("11111111111111111375", "11111111111111111374")
17. PRINT subtr$("11111111111111111374", "11111111111111111375")
18. PRINT "9 minus 3 but 3 is tricky! "; subtr$("9", "00003")
19. PRINT subtr$("1" + STRING$(50, "0"), "1"), LEN(subtr$("1" + STRING$(50, "0"), "1"))
20. PRINT subtr$("980", "5")
21. PRINT " Answer supposed to be 1: "; subtr$("1" + STRING$(99, "0"), STRING$(99, "9"))
22. PRINT "Answer supposed to be -1: "; subtr$(STRING$(99, "9"), "1" + STRING$(99, "0"))
23. PRINT "press any for Random testing against QB64 math calculations..."
24. SLEEP
25.  
26. 'random testing
27. DIM al AS LONG, bl AS LONG, sum AS _INTEGER64, e1 AS INTEGER, e2 AS INTEGER, a$, b$, subtrStr$, qbCalc$
28. DO
29.     'pick two numbers
30.     e1 = INT(10 * RND): e2 = INT(10 * RND)
31.     al = RND * 10 ^ e1: bl = RND * 10 ^ e2: sum = al - bl
32.     a$ = _TRIM$(STR$(al)): b$ = _TRIM$(STR$(bl))
33.     PRINT
34.     PRINT a$; " minus "; b$; " ="
35.     subtrStr$ = subtr$(a$, b$)
36.     PRINT subtrStr$; " according to subtr$ function we are testing."
37.     qbCalc$ = _TRIM$(STR$(sum))
38.     PRINT qbCalc$; " according to QB64 math"
39.     IF qbCalc$ <> subtrStr$ THEN BEEP: SLEEP ' <<<<<<<<<< stop when find an discrepency
40.     PRINT "Next sum check in 10 secs, or press key,  press escape to quit..."
41.     SLEEP 10 '
42. LOOP UNTIL _KEYDOWN(27)
43.  
44. FUNCTION subtr$ (sum$, minus$) ' assume both numbers are positive all digits
45.     IF sum$ = minus$ THEN subtr$ = "0": EXIT SUB
46.  
47.     DIM ls AS INTEGER, lm AS INTEGER, m AS INTEGER, g AS INTEGER, i AS INTEGER, find AS INTEGER, p AS INTEGER
48.     DIM VB AS _UNSIGNED _INTEGER64, vs AS _UNSIGNED _INTEGER64, tenE18 AS _UNSIGNED _INTEGER64
49.     DIM sign$, LG$, sm$, t$, new$, result$
50.  
51.     tenE18 = 1000000000000000000 'yes!!! no dang E's
52.     ' which is bigger?
53.     ls = LEN(sum$): lm = LEN(minus$)
54.     IF sum$ > minus$ THEN ' QB64 seems to do great comaparing number strings as if unsigned integers
55.         sign$ = ""
56.         m = INT(ls / 18) + 1
57.         LG$ = RIGHT$(STRING$(m * 18, "0") + sum$, m * 18)
58.         sm$ = RIGHT$(STRING$(m * 18, "0") + minus$, m * 18)
59.     ELSE
60.         sign$ = "-"
61.         m = INT(lm / 18) + 1
62.         LG$ = RIGHT$(STRING$(m * 18, "0") + minus$, m * 18)
63.         sm$ = RIGHT$(STRING$(m * 18, "0") + sum$, m * 18)
64.     END IF
65.  
66.  
67.     'IF ls > lm THEN
68.     '    sign$ = ""
69.     '    m = INT(ls / 18) + 1
70.     '    LG$ = RIGHT$(STRING$(m * 18, "0") + sum$, m * 18)
71.     '    sm$ = RIGHT$(STRING$(m * 18, "0") + minus$, m * 18)
72.     'ELSEIF ls < lm THEN
73.     '    sign$ = "-"
74.     '    m = INT(lm / 18) + 1
75.     '    LG$ = RIGHT$(STRING$(m * 18, "0") + minus$, m * 18)
76.     '    sm$ = RIGHT$(STRING$(m * 18, "0") + sum$, m * 18)
77.     'ELSEIF ls = lm THEN
78.     '    FOR i = 1 TO LEN(sum$)
79.     '        IF VAL(MID$(sum$, i, 1)) > VAL(MID$(minus$, i, 1)) THEN
80.     '            sign$ = ""
81.     '            m = INT(ls / 8) + 1
82.     '            LG$ = RIGHT$(STRING$(m * 18, "0") + sum$, m * 18)
83.     '            sm$ = RIGHT$(STRING$(m * 18, "0") + minus$, m * 18)
84.     '            EXIT FOR
85.     '        ELSEIF VAL(MID$(sum$, i, 1)) < VAL(MID$(minus$, i, 1)) THEN
86.     '            sign$ = "-"
87.     '            m = INT(lm / 18) + 1
88.     '            LG$ = RIGHT$(STRING$(m * 18, "0") + minus$, m * 18)
89.     '            sm$ = RIGHT$(STRING$(m * 18, "0") + sum$, m * 18)
90.     '            EXIT FOR
91.     '        END IF
92.     '    NEXT
93.     'END IF
94.  
95.     'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
96.     FOR g = 1 TO m
97.         VB = VAL(MID$(LG$, m * 18 - g * 18 + 1, 18))
98.         vs = VAL(MID$(sm$, m * 18 - g * 18 + 1, 18))
99.         IF vs > VB THEN
100.             t$ = RIGHT$(STRING$(18, "0") + _TRIM$(STR$(tenE18 - vs + VB)), 18)
101.  
102.             'debug
103.             'PRINT VB, tenE18, tenE18 - vs + VB, " t$ = "; t$
104.  
105.             ''borrow 1 = rewrite string
106.             p = (m - g) * 18
107.             WHILE p > 0 AND MID$(LG$, p, 1) = "0"
108.                 MID$(LG$, p, 1) = "9"
109.                 p = p - 1
110.             WEND
111.             IF p > 0 THEN MID$(LG$, p, 1) = _TRIM$(STR$(VAL(MID$(LG$, p, 1)) - 1))
112.         ELSE
113.             t$ = RIGHT$(STRING$(18, "0") + _TRIM$(STR$(VB - vs)), 18)
114.         END IF
115.         result$ = t$ + result$
116.     NEXT
117.     result$ = _TRIM$(result$)
118.     'strip 0
119.     i = 1: find = 0
120.     WHILE i < LEN(result$) AND MID$(result$, i, 1) = "0"
121.         i = i + 1: find = 1
122.     WEND
123.     IF find = 1 THEN result$ = MID$(result$, i)
124.     subtr$ = sign$ + result$
125. END FUNCTION
126.  
127. FUNCTION add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
128.     'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
129.     DIM la AS INTEGER, lb AS INTEGER, m AS INTEGER, g AS INTEGER, i AS INTEGER, find AS INTEGER
130.     DIM sa AS _UNSIGNED _INTEGER64, sb AS _UNSIGNED _INTEGER64, co AS _UNSIGNED _INTEGER64
131.     DIM fa$, fb$, t$, new$, result$
132.     la = LEN(a$): lb = LEN(b$)
133.     IF la > lb THEN m = INT(la / 18) + 1 ELSE m = INT(lb / 18) + 1
134.     fa$ = RIGHT$(STRING$(m * 18, "0") + a$, m * 18)
135.     fb$ = RIGHT$(STRING$(m * 18, "0") + b$, m * 18)
136.  
137.     'now taking 18 digits at a time Thanks Steve McNeill
138.     FOR g = 1 TO m
139.         sa = VAL(MID$(fa$, m * 18 - g * 18 + 1, 18))
140.         sb = VAL(MID$(fb$, m * 18 - g * 18 + 1, 18))
141.         t$ = RIGHT$(STRING$(36, "0") + _TRIM$(STR$(sa + sb + co)), 36)
142.         co = VAL(MID$(t$, 1, 18))
143.         new$ = MID$(t$, 19)
144.         result$ = new$ + result$
145.  
146.         'debug
147.         'DIM w$
148.         'PRINT a$, m * 18, sa, sb, t$, co, result$
149.         'INPUT "OK "; w$ 'OK
150.     NEXT
151.     IF co THEN result$ = STR$(co) + result$
152.     result$ = _TRIM$(result$)
153.     'strip 0
154.     i = 1: find = 0
155.     WHILE i < LEN(result$) AND MID$(result$, i, 1) = "0"
156.         i = i + 1: find = 1
157.     WEND
158.     IF find = 1 THEN result$ = MID$(result$, i)
159.     add$ = result$
160. END FUNCTION
161.  

OK guess I have to roll my own.

[SMcNeill]

You need a sign checker routine in your subs.   (Cavet: I've been taking care of mama for the last several days and haven't looked at your code closely yet, so you may have the following already:)

First, a function to deal with doubles.  FUNCTION DWD (text$) searches text$ and converts double symbols to reverse symbols.  ++ becomes +, -- becomes +, -+ becomes -, +- becomes -.   

For example, 3 + -2 (Three plus negative two) becomes 3 - 2.

Then in your routines, check to make certain that your two values have the same sign.

-3 -4 -- this is addition, as the two values are both negative.  Just kick it from your subtraction routine to your addition routine and return the result from there.
-3 + 4 -- this is subtraction, even though the symbol between them in +.  Once again, just kick it to the appropriate function and return the result from there.

And a routine to convert scientific notion to string is nice as well, so you can add 3E+20 to 1234567899012345678987654321.

If you look in QB64.BAS, you'll find most of these little helper routines already worked up and in use inside there, as they're part of the CONST calculations we do.  (Also in my math evaluator, which works with strings as well.)

[bplus]

Hi Steve,

Yeah I am taking care of mom too (89), she can't remember anything new and plagued with aches and pains but old memories are hanging in there, she does crossword puzzles every day.

I am saving signs for later as well as decimal point handling. My first goal is the 4 main arithmetic subs going for arbitrary long positive integers. I save the best for last Division, then signs, then decimals...

I know I am reinventing the wheel but you learn inside stuff with DIY. Then if you have a bug or want to handle decimals different you know (maybe if you remember) how to get what you want without having to learn the whole thing anyway using someone else approach. Of course, someone else approach could be much more clever but how do you know if you didn't try it yourself?

I am working on 2 helper functions now and rewriting add$, subtr$, mult$ with lines of code savings! If things work out ;-))

[bplus]

I think I might have a unique approach for division, preliminary results are looking really good!

I am intending to use multiplicative inverses, ie for n / d, use n * 1/d.

[bplus]

Getting divide$() from Multiplicative Inverse worked like a charm for getting nice set of digits but getting the decimal settled at right point (was that a pun?) took a little more doing including not stripping 0's until last, display, step.

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Multplicative Inverse: nInverse$() and divide$()" ' b+ 2020-08-16 from
3. ' I always want to try doing division by multipling the numerator
4. ' by the multiplicative inverse of denominator.
5. ' n/d = n * 1/d so how bout a function that does 1/n
6. ' Then divide$() is pretty easy with mult$
7.  
8. RANDOMIZE TIMER 'now that it's seems to be running silent
9. SCREEN _NEWIMAGE(1200, 700, 32)
10. _DELAY .25
11. _SCREENMOVE _MIDDLE
12.  
13. 'special cases or hard cases
14. PRINT nInverse$("0", 100)
15. PRINT nInverse$("1", 100)
16. PRINT nInverse$("2", 100) 'yeah this might work!
17. PRINT nInverse$("7", 150)
18. PRINT nInverse$("50", 150) ' good
19. PRINT nInverse$("999999999", 150) ' oh boy!!!
20. PRINT nInverse$("11111111111111111111", 150)
21. PRINT nInverse$("1024", 150)
22. PRINT nInverse$("717", 150)
23. PRINT
24. PRINT "  OK try some Divisions "
25. PRINT ".5 ? "; divide$("1", "2") 'well that took some tuning
26. PRINT ".125 ? "; divide$("1", "8") ' well more tuning!
27. PRINT ".002 ? "; divide$("1", "500")
28. PRINT "1.714285R714285... ? "; divide$("12", "7")
29. PRINT "15555 ? "; divide$("108885", "7") 'close to 15555
30. PRINT "2048 ? "; divide$("131072", "64") 'powers of 2 here 2048
31. PRINT: PRINT " press any for some random tests comparing divisions to QB64 values"
32. SLEEP
33.  
34. 'random testing
35. DIM n AS _UNSIGNED _INTEGER64, d AS _UNSIGNED _INTEGER64
36. DIM quotient AS DOUBLE, e1 AS INTEGER, e2 AS INTEGER, num$, den$, divStr$, qbCalc$
37. DO
38.     'pick two numbers
39.     e1 = INT(10 * RND): e2 = INT(10 * RND)
40.     n = RND * 10 ^ e1: d = RND * 10 ^ e2: quotient = n / d
41.     num$ = _TRIM$(STR$(n)): den$ = _TRIM$(STR$(d))
42.     PRINT
43.     PRINT num$; " divided by "; den$; " ="
44.     divStr$ = divide$(num$, den$)
45.     PRINT divStr$; " according to mult$ function we are testing."
46.     qbCalc$ = _TRIM$(STR$(quotient))
47.     PRINT qbCalc$; " according to QB64 math"
48.     ' <<<<<<<<<< stop when find an discrepency
49.     PRINT "Next divide$() check in 10 secs, or press key,  press escape to quit..."
50.     SLEEP 10
51. LOOP UNTIL _KEYDOWN(27)
52.  
53. FUNCTION divide$ (n$, d$)
54.     DIM di$, ndi$, nD AS INTEGER
55.     IF trim0$(n$) = "0" THEN divide$ = "0": EXIT FUNCTION
56.     IF trim0$(d$) = "0" THEN divide$ = "div 0": EXIT FUNCTION
57.     IF trim0$(d$) = "1" THEN divide$ = n$: EXIT FUNCTION
58.     di$ = nInverse$(d$, 100)
59.     nD = LEN(di$)
60.     ndi$ = mult$(n$, di$)
61.     ndi$ = MID$(ndi$, 1, LEN(ndi$) - nD) + "." + RIGHT$(ndi$, nD)
62.     divide$ = trim0$(ndi$)
63. END FUNCTION
64.  
65. FUNCTION nInverse$ (n$, DP AS INTEGER) 'assume decimal at very start of the string of digits returned, no rounding
66.     DIM m$(1 TO 9), si$, r$, outstr$, d$
67.     DIM i AS INTEGER
68.     FOR i = 1 TO 9
69.         si$ = _TRIM$(STR$(i))
70.         m$(i) = mult$(si$, n$)
71.     NEXT
72.     outstr$ = ""
73.     IF n$ = "0" THEN nInverse$ = "Div 0": EXIT FUNCTION
74.     IF n$ = "1" THEN nInverse$ = "1": EXIT FUNCTION
75.     r$ = "10"
76.     DO
77.         WHILE LEFT$(subtr$(r$, n$), 1) = "-" '   r - n < 0
78.             outstr$ = outstr$ + "0" '            add 0 to the  output string
79.             IF LEN(outstr$) = DP THEN nInverse$ = outstr$: EXIT FUNCTION 'check if we've reached DP length
80.             r$ = r$ + "0"
81.         WEND
82.         FOR i = 9 TO 1 STEP -1
83.             IF LTE(m$(i), r$) THEN d$ = _TRIM$(STR$(i)): EXIT FOR
84.         NEXT
85.         outstr$ = outstr$ + d$
86.         IF LEN(outstr$) = DP THEN nInverse$ = outstr$: EXIT FUNCTION
87.         r$ = subtr$(r$, mult$(d$, n$)) 'r = r -d*n
88.         IF r$ = "0" THEN nInverse$ = outstr$: EXIT FUNCTION 'found a perfect divisor
89.         r$ = r$ + "0" 'add another place
90.     LOOP
91. END FUNCTION
92.  
93. FUNCTION mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
94.     DIM la AS INTEGER, lb AS INTEGER, m AS INTEGER, g AS INTEGER, dp AS INTEGER
95.     DIM v18 AS _UNSIGNED _INTEGER64, sd AS _UNSIGNED _INTEGER64, co AS _UNSIGNED _INTEGER64
96.     DIM f18$, f1$, t$, build$, accum$
97.  
98.     IF trim0$(a$) = "0" THEN mult$ = "0": EXIT FUNCTION
99.     IF trim0$(b$) = "0" THEN mult$ = "0": EXIT FUNCTION
100.     IF trim0$(a$) = "1" THEN mult$ = trim0$(b$): EXIT FUNCTION
101.     IF trim0$(b$) = "1" THEN mult$ = trim0$(a$): EXIT FUNCTION
102.     'find the longer number and make it a mult of 18 to take 18 digits at a time from it
103.     la = LEN(a$): lb = LEN(b$)
104.     IF la > lb THEN
105.         m = INT(la / 18) + 1
106.         f18$ = RIGHT$(STRING$(m * 18, "0") + a$, m * 18)
107.         f1$ = b$
108.     ELSE
109.         m = INT(lb / 18) + 1
110.         f18$ = RIGHT$(STRING$(m * 18, "0") + b$, m * 18)
111.         f1$ = a$
112.     END IF
113.     FOR dp = LEN(f1$) TO 1 STEP -1 'dp = digit position of the f1$
114.         build$ = "" 'line builder
115.         co = 0
116.         'now taking 18 digits at a time Thanks Steve McNeill
117.         FOR g = 1 TO m
118.             v18 = VAL(MID$(f18$, m * 18 - g * 18 + 1, 18))
119.             sd = VAL(MID$(f1$, dp, 1))
120.             t$ = RIGHT$(STRING$(19, "0") + _TRIM$(STR$(v18 * sd + co)), 19)
121.             co = VAL(MID$(t$, 1, 1))
122.             build$ = MID$(t$, 2) + build$
123.         NEXT g
124.         IF co THEN build$ = _TRIM$(STR$(co)) + build$
125.         IF dp = LEN(f1$) THEN
126.             accum$ = build$
127.         ELSE
128.             accum$ = add$(accum$, build$ + STRING$(LEN(f1$) - dp, "0"))
129.         END IF
130.     NEXT dp
131.     mult$ = accum$
132. END FUNCTION
133.  
134. FUNCTION subtr$ (sum$, minus$) ' assume both numbers are positive all digits
135.     DIM m AS INTEGER, g AS INTEGER, p AS INTEGER
136.     DIM VB AS _UNSIGNED _INTEGER64, vs AS _UNSIGNED _INTEGER64, tenE18 AS _UNSIGNED _INTEGER64
137.     DIM ts$, tm$, sign$, LG$, sm$, t$, result$
138.  
139.     ts$ = TrimLead0$(sum$): tm$ = TrimLead0$(minus$)
140.     IF trim0(ts$) = trim0$(tm$) THEN subtr$ = "0": EXIT FUNCTION 'OK proceed with function knowing they are not equal
141.     tenE18 = 1000000000000000000 'yes!!! no dang E's
142.     IF LTE(ts$, tm$) THEN ' which is bigger? minus is bigger
143.         sign$ = "-"
144.         m = INT(LEN(tm$) / 18) + 1
145.         LG$ = RIGHT$(STRING$(m * 18, "0") + tm$, m * 18)
146.         sm$ = RIGHT$(STRING$(m * 18, "0") + ts$, m * 18)
147.     ELSE 'sum is bigger
148.         sign$ = ""
149.         m = INT(LEN(ts$) / 18) + 1
150.         LG$ = RIGHT$(STRING$(m * 18, "0") + ts$, m * 18)
151.         sm$ = RIGHT$(STRING$(m * 18, "0") + tm$, m * 18)
152.     END IF
153.     'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
154.     FOR g = 1 TO m
155.         VB = VAL(MID$(LG$, m * 18 - g * 18 + 1, 18))
156.         vs = VAL(MID$(sm$, m * 18 - g * 18 + 1, 18))
157.         IF vs > VB THEN
158.             t$ = RIGHT$(STRING$(18, "0") + _TRIM$(STR$(tenE18 - vs + VB)), 18)
159.  
160.             'debug
161.             'PRINT VB, tenE18, tenE18 - vs + VB, " t$ = "; t$
162.  
163.             ''borrow 1 = rewrite string
164.             p = (m - g) * 18
165.             WHILE p > 0 AND MID$(LG$, p, 1) = "0"
166.                 MID$(LG$, p, 1) = "9"
167.                 p = p - 1
168.             WEND
169.             IF p > 0 THEN MID$(LG$, p, 1) = _TRIM$(STR$(VAL(MID$(LG$, p, 1)) - 1))
170.         ELSE
171.             t$ = RIGHT$(STRING$(18, "0") + _TRIM$(STR$(VB - vs)), 18)
172.         END IF
173.         result$ = t$ + result$
174.     NEXT
175.     subtr$ = sign$ + result$
176. END FUNCTION
177.  
178. FUNCTION add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
179.     'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
180.     DIM la AS INTEGER, lb AS INTEGER, m AS INTEGER, g AS INTEGER
181.     DIM sa AS _UNSIGNED _INTEGER64, sb AS _UNSIGNED _INTEGER64, co AS _UNSIGNED _INTEGER64
182.     DIM fa$, fb$, t$, new$, result$
183.     la = LEN(a$): lb = LEN(b$)
184.     IF la > lb THEN m = INT(la / 18) + 1 ELSE m = INT(lb / 18) + 1
185.     fa$ = RIGHT$(STRING$(m * 18, "0") + a$, m * 18)
186.     fb$ = RIGHT$(STRING$(m * 18, "0") + b$, m * 18)
187.  
188.     'now taking 18 digits at a time Thanks Steve McNeill
189.     FOR g = 1 TO m
190.         sa = VAL(MID$(fa$, m * 18 - g * 18 + 1, 18))
191.         sb = VAL(MID$(fb$, m * 18 - g * 18 + 1, 18))
192.         t$ = RIGHT$(STRING$(36, "0") + _TRIM$(STR$(sa + sb + co)), 36)
193.         co = VAL(MID$(t$, 1, 18))
194.         new$ = MID$(t$, 19)
195.         result$ = new$ + result$
196.  
197.         'debug
198.         'DIM w$
199.         'PRINT a$, m * 18, sa, sb, t$, co, result$
200.         'INPUT "OK "; w$ 'OK
201.     NEXT
202.     IF co THEN result$ = STR$(co) + result$
203.     add$ = result$
204. END FUNCTION
205.  
206. ' String Math Helpers -----------------------------------------------
207.  
208. 'this function needs TrimLead0$(s$)
209. FUNCTION LTE (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings
210.     DIM ca$, cb$, la AS INTEGER, lb AS INTEGER, i AS INTEGER
211.     ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
212.     la = LEN(ca$): lb = LEN(cb$)
213.     IF ca$ = cb$ THEN
214.         LTE = -1
215.     ELSEIF la < lb THEN ' a is smaller
216.         LTE = -1
217.     ELSEIF la > lb THEN ' a is bigger
218.         LTE = 0
219.     ELSEIF la = lb THEN ' equal lengths
220.         FOR i = 1 TO LEN(ca$)
221.             IF VAL(MID$(ca$, i, 1)) > VAL(MID$(cb$, i, 1)) THEN
222.                 LTE = 0: EXIT FUNCTION
223.             ELSEIF VAL(MID$(ca$, i, 1)) < VAL(MID$(cb$, i, 1)) THEN
224.                 LTE = -1: EXIT FUNCTION
225.             END IF
226.         NEXT
227.     END IF
228. END FUNCTION
229.  
230. ' ------------------------------------- use these for final display
231.  
232. FUNCTION TrimLead0$ (s$) 'for treating strings as number (pos integers)
233.     DIM copys$, i AS INTEGER, find AS INTEGER
234.     copys$ = _TRIM$(s$) 'might as well remove spaces too
235.     i = 1: find = 0
236.     WHILE i < LEN(copys$) AND MID$(copys$, i, 1) = "0"
237.         i = i + 1: find = 1
238.     WEND
239.     IF find = 1 THEN copys$ = MID$(copys$, i)
240.     IF copys$ = "" THEN TrimLead0$ = "0" ELSE TrimLead0$ = copys$
241. END FUNCTION
242.  
243. FUNCTION TrimTail0$ (s$)
244.     DIM copys$, dp AS INTEGER, i AS INTEGER, find AS INTEGER
245.     copys$ = _TRIM$(s$) 'might as well remove spaces too
246.     TrimTail0$ = copys$
247.     dp = INSTR(copys$, ".")
248.     IF dp > 0 THEN
249.         i = LEN(copys$): find = 0
250.         WHILE i > dp AND MID$(copys$, i, 1) = "0"
251.             i = i - 1: find = 1
252.         WEND
253.         IF find = 1 THEN
254.             IF i = dp THEN
255.                 TrimTail0$ = MID$(copys$, 1, dp - 1)
256.             ELSE
257.                 TrimTail0$ = MID$(copys$, 1, i)
258.             END IF
259.         END IF
260.     END IF
261. END FUNCTION
262.  
263. FUNCTION trim0$ (s$)
264.     DIM t$
265.     t$ = TrimLead0$(s$)
266.     trim0$ = TrimTail0$(t$)
267. END FUNCTION
268.  

[STxAxTIC]

Here's a test for ya from http://wfbarnes.net/sxript/docs/fibonacci2/main.php#Top

It turns out that the first hundred (or so) Fibonacci Numbers can be produced by inverting the integer 999999999999999999999998999999999999999999999999 (bonus points for noticing that one of the digits is not a 9).

Code: [Select]

print_
  largediv(
    1.(for(<i,1,2495,1>,{0})),
    999999999999999999999998999999999999999999999999
  )


Code: [Select]

+0.000000000000000000000000000000000000000000000001000000000000000000000001000000000000000000000002000000000000000000000003000000000000000000000005000000000000000000000008000000000000000000000013000000000000000000000021000000000000000000000034000000000000000000000055000000000000000000000089000000000000000000000144000000000000000000000233000000000000000000000377000000000000000000000610000000000000000000000987000000000000000000001597000000000000000000002584000000000000000000004181000000000000000000006765000000000000000000010946000000000000000000017711000000000000000000028657000000000000000000046368000000000000000000075025000000000000000000121393000000000000000000196418000000000000000000317811000000000000000000514229000000000000000000832040000000000000000001346269000000000000000002178309000000000000000003524578000000000000000005702887000000000000000009227465000000000000000014930352000000000000000024157817000000000000000039088169000000000000000063245986000000000000000102334155000000000000000165580141000000000000000267914296000000000000000433494437000000000000000701408733000000000000001134903170000000000000001836311903000000000000002971215073000000000000004807526976000000000000007778742049000000000000012586269025000000000000020365011074000000000000032951280099000000000000053316291173000000000000086267571272000000000000139583862445000000000000225851433717000000000000365435296162000000000000591286729879000000000000956722026041000000000001548008755920000000000002504730781961000000000004052739537881000000000006557470319842000000000010610209857723000000000017167680177565000000000027777890035288000000000044945570212853000000000072723460248141000000000117669030460994000000000190392490709135000000000308061521170129000000000498454011879264000000000806515533049393000000001304969544928657000000002111485077978050000000003416454622906707000000005527939700884757000000008944394323791464000000014472334024676221000000023416728348467685000000037889062373143906000000061305790721611591000000099194853094755497000000160500643816367088000000259695496911122585000000420196140727489673000000679891637638612258000001100087778366101931000001779979416004714189000002880067194370816120000004660046610375530309000007540113804746346429000012200160415121876738000019740274219868223167000031940434634990099905000051680708854858323072000083621143489848422977000135301852344706746049000218922995834555169026000354224848179261915075000573147844013817084101000927372692193078999176001500520536206896083277002427893228399975082453003928413764606871165730006356306993006846248183010284720757613717413913

[bplus]

Well there is an interesting experiment! Thanx STx :)

The first order of business today was fixing the nInverse function with a decimal point because I need to return 1 (without decimal) when n = 1

2nd thing is rounding when I get a repeating stream of 9's for divide, usually it means it should be infinitesimally small nudge more.

[bplus]

Some nice results this morning, tweaking last nights nInverse$(), divide$, adding showDP$() for rounding at DP + 1 if have that many decimals.

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Multplicative Inverse: nInverse$() and divide$()" ' b+ 2020-08-16
3. ' 2020-08-16 picking up from Sting Math add$(), subtr$(), mult$() onto divide$()
4. ' I always wanted to try doing division by multipling the numerator
5. ' by the multiplicative inverse of denominator.
6. ' n/d = n * 1/d so how bout a function that does 1/n.
7. ' Then divide$() is pretty easy with mult$  Yes works but need more decimal work.
8. ' 2020-08-17 redo all this with a decimal point for nInverse just start outstr with "." instead ""
9. ' Now somethings off with divide$() first is 1 / 500 should be .002 returning .2, debug."
10. ' Much better than post of last night
11. ' showDP rounds up to DP (Decimal Places IF there are more decimals past DP)
12.  
13. RANDOMIZE TIMER 'now that it's seems to be running silent
14. SCREEN _NEWIMAGE(1200, 700, 32)
15. _DELAY .25
16. _SCREENMOVE _MIDDLE
17.  
18. 'special cases or hard cases
19. PRINT "div 0 ? "; nInverse$("0", 100)
20. PRINT "This is 2nd special case where no decimal is returned: 1 ? "; nInverse$("1", 100)
21. PRINT "1/2 =.5 no more no less ? "; nInverse$("2", 100) 'yeah this might work!
22. PRINT ".142857 and repeat forever ? for 1/7"
23. PRINT nInverse$("7", 149)
24. PRINT ".02 no more or less ? "; nInverse$("50", 149) ' good
25. PRINT "1/ (9 nines) should b"
26. PRINT ".000000001 repeated forever ?"
27. PRINT nInverse$("999999999", 149) ' oh boy!!!
28. PRINT "1/ (20 ones) should be 19 zeros nine repeated forever ?"
29. PRINT ".00000000000000000009 repeat forever ?"
30. PRINT nInverse$("11111111111111111111", 149)
31. PRINT ".0009765625 ?"
32. PRINT nInverse$("1024", 150)
33. PRINT ".0013947 repeat forever ?"
34. PRINT nInverse$("717", 150)
35. PRINT
36. PRINT "  OK try some Divisions "
37. PRINT ".5 ? "; divide$("1", "2") 'well that took some tuning
38. PRINT ".125 ? "; divide$("1", "8") ' well more tuning!
39. PRINT ".002 ? "; divide$("1", "500") 'lost first 2 zeros?
40. PRINT ".002222...? "; divide$("1", "450")
41. PRINT "1.002222...? "; divide$("451", "450")
42. PRINT "1.714285R714285... ? "; divide$("12", "7")
43. PRINT "15555 ? "; divide$("108885", "7") 'close to 15555
44. PRINT "test showDP fix 9's to 4 places?"
45. PRINT "15555 ? "; showDP(divide$("108885", "7"), 4)
46. PRINT "2048 ? "; divide$("131072", "64") 'powers of 2 here 2048
47. PRINT "1 ? "; showDP(divide$("99999", "100000"), 2)
48. PRINT: PRINT " press any for some random tests comparing divisions to QB64 values"
49. SLEEP
50.  
51. 'random testing
52. DIM n AS _UNSIGNED _INTEGER64, d AS _UNSIGNED _INTEGER64
53. DIM quotient AS DOUBLE, e1 AS INTEGER, e2 AS INTEGER, num$, den$, divStr$, qbCalc$
54. DO
55.     'pick two numbers
56.     e1 = INT(10 * RND): e2 = INT(10 * RND)
57.     n = RND * 10 ^ e1: d = RND * 10 ^ e2: quotient = n / d
58.     num$ = _TRIM$(STR$(n)): den$ = _TRIM$(STR$(d))
59.     PRINT
60.     PRINT num$; " divided by "; den$; " ="
61.     divStr$ = divide$(num$, den$)
62.     PRINT showDP$(divStr$, 60); " LEN:"; LEN(showDP$(divStr$, 60)); " divide$() trunc. 60"
63.     qbCalc$ = _TRIM$(STR$(quotient))
64.     PRINT qbCalc$; " according to QB64 math"
65.     ' <<<<<<<<<< stop when find an discrepency
66.     PRINT "Next divide$() check in 10 secs, or press key,  press escape to quit..."
67.     SLEEP 10
68. LOOP UNTIL _KEYDOWN(27)
69.  
70. FUNCTION divide$ (n$, d$)
71.     DIM di$, ndi$, nD AS INTEGER
72.     IF trim0$(n$) = "0" THEN divide$ = "0": EXIT FUNCTION
73.     IF trim0$(d$) = "0" THEN divide$ = "div 0": EXIT FUNCTION
74.     IF trim0$(d$) = "1" THEN divide$ = trim0$(n$): EXIT FUNCTION '8/17 add trim0$
75.     di$ = MID$(nInverse$(d$, 100), 2) 'chop off decimal point after
76.     nD = LEN(di$)
77.     ndi$ = mult$(n$, di$)
78.     ndi$ = MID$(ndi$, 1, LEN(ndi$) - nD) + "." + RIGHT$(STRING$(nD, "0") + RIGHT$(ndi$, nD), nD)
79.     divide$ = trim0$(ndi$)
80. END FUNCTION
81.  
82. FUNCTION nInverse$ (n$, DP AS INTEGER) 'assume decimal at very start of the string of digits returned, no rounding
83.     DIM m$(1 TO 9), si$, r$, outstr$, d$
84.     DIM i AS INTEGER
85.     FOR i = 1 TO 9
86.         si$ = _TRIM$(STR$(i))
87.         m$(i) = mult$(si$, n$)
88.     NEXT
89.     outstr$ = ""
90.     IF n$ = "0" THEN nInverse$ = "Div 0": EXIT FUNCTION
91.     IF n$ = "1" THEN nInverse$ = "1": EXIT FUNCTION
92.     outstr$ = "." 'everything else n > 1 is decimal 8/17
93.     r$ = "10"
94.     DO
95.         WHILE LEFT$(subtr$(r$, n$), 1) = "-" '   r - n < 0
96.             outstr$ = outstr$ + "0" '            add 0 to the  output string
97.             IF LEN(outstr$) = DP THEN nInverse$ = outstr$: EXIT FUNCTION 'check if we've reached DP length
98.             r$ = r$ + "0"
99.         WEND
100.         FOR i = 9 TO 1 STEP -1
101.             IF LTE(m$(i), r$) THEN d$ = _TRIM$(STR$(i)): EXIT FOR
102.         NEXT
103.         outstr$ = outstr$ + d$
104.         IF LEN(outstr$) = DP THEN nInverse$ = outstr$: EXIT FUNCTION
105.         r$ = subtr$(r$, mult$(d$, n$)) 'r = r -d*n
106.         IF r$ = "0" THEN nInverse$ = outstr$: EXIT FUNCTION 'found a perfect divisor
107.         r$ = r$ + "0" 'add another place
108.     LOOP
109. END FUNCTION
110.  
111. FUNCTION mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
112.     DIM la AS INTEGER, lb AS INTEGER, m AS INTEGER, g AS INTEGER, dp AS INTEGER
113.     DIM v18 AS _UNSIGNED _INTEGER64, sd AS _UNSIGNED _INTEGER64, co AS _UNSIGNED _INTEGER64
114.     DIM f18$, f1$, t$, build$, accum$
115.  
116.     IF trim0$(a$) = "0" THEN mult$ = "0": EXIT FUNCTION
117.     IF trim0$(b$) = "0" THEN mult$ = "0": EXIT FUNCTION
118.     IF trim0$(a$) = "1" THEN mult$ = trim0$(b$): EXIT FUNCTION
119.     IF trim0$(b$) = "1" THEN mult$ = trim0$(a$): EXIT FUNCTION
120.     'find the longer number and make it a mult of 18 to take 18 digits at a time from it
121.     la = LEN(a$): lb = LEN(b$)
122.     IF la > lb THEN
123.         m = INT(la / 18) + 1
124.         f18$ = RIGHT$(STRING$(m * 18, "0") + a$, m * 18)
125.         f1$ = b$
126.     ELSE
127.         m = INT(lb / 18) + 1
128.         f18$ = RIGHT$(STRING$(m * 18, "0") + b$, m * 18)
129.         f1$ = a$
130.     END IF
131.     FOR dp = LEN(f1$) TO 1 STEP -1 'dp = digit position of the f1$
132.         build$ = "" 'line builder
133.         co = 0
134.         'now taking 18 digits at a time Thanks Steve McNeill
135.         FOR g = 1 TO m
136.             v18 = VAL(MID$(f18$, m * 18 - g * 18 + 1, 18))
137.             sd = VAL(MID$(f1$, dp, 1))
138.             t$ = RIGHT$(STRING$(19, "0") + _TRIM$(STR$(v18 * sd + co)), 19)
139.             co = VAL(MID$(t$, 1, 1))
140.             build$ = MID$(t$, 2) + build$
141.         NEXT g
142.         IF co THEN build$ = _TRIM$(STR$(co)) + build$
143.         IF dp = LEN(f1$) THEN
144.             accum$ = build$
145.         ELSE
146.             accum$ = add$(accum$, build$ + STRING$(LEN(f1$) - dp, "0"))
147.         END IF
148.     NEXT dp
149.     mult$ = accum$
150. END FUNCTION
151.  
152. FUNCTION subtr$ (sum$, minus$) ' assume both numbers are positive all digits
153.     DIM m AS INTEGER, g AS INTEGER, p AS INTEGER
154.     DIM VB AS _UNSIGNED _INTEGER64, vs AS _UNSIGNED _INTEGER64, tenE18 AS _UNSIGNED _INTEGER64
155.     DIM ts$, tm$, sign$, LG$, sm$, t$, result$
156.  
157.     ts$ = TrimLead0$(sum$): tm$ = TrimLead0$(minus$)
158.     IF trim0(ts$) = trim0$(tm$) THEN subtr$ = "0": EXIT FUNCTION 'OK proceed with function knowing they are not equal
159.     tenE18 = 1000000000000000000 'yes!!! no dang E's
160.     IF LTE(ts$, tm$) THEN ' which is bigger? minus is bigger
161.         sign$ = "-"
162.         m = INT(LEN(tm$) / 18) + 1
163.         LG$ = RIGHT$(STRING$(m * 18, "0") + tm$, m * 18)
164.         sm$ = RIGHT$(STRING$(m * 18, "0") + ts$, m * 18)
165.     ELSE 'sum is bigger
166.         sign$ = ""
167.         m = INT(LEN(ts$) / 18) + 1
168.         LG$ = RIGHT$(STRING$(m * 18, "0") + ts$, m * 18)
169.         sm$ = RIGHT$(STRING$(m * 18, "0") + tm$, m * 18)
170.     END IF
171.     'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
172.     FOR g = 1 TO m
173.         VB = VAL(MID$(LG$, m * 18 - g * 18 + 1, 18))
174.         vs = VAL(MID$(sm$, m * 18 - g * 18 + 1, 18))
175.         IF vs > VB THEN
176.             t$ = RIGHT$(STRING$(18, "0") + _TRIM$(STR$(tenE18 - vs + VB)), 18)
177.  
178.             'debug
179.             'PRINT VB, tenE18, tenE18 - vs + VB, " t$ = "; t$
180.  
181.             ''borrow 1 = rewrite string
182.             p = (m - g) * 18
183.             WHILE p > 0 AND MID$(LG$, p, 1) = "0"
184.                 MID$(LG$, p, 1) = "9"
185.                 p = p - 1
186.             WEND
187.             IF p > 0 THEN MID$(LG$, p, 1) = _TRIM$(STR$(VAL(MID$(LG$, p, 1)) - 1))
188.         ELSE
189.             t$ = RIGHT$(STRING$(18, "0") + _TRIM$(STR$(VB - vs)), 18)
190.         END IF
191.         result$ = t$ + result$
192.     NEXT
193.     subtr$ = sign$ + result$
194. END FUNCTION
195.  
196. FUNCTION add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
197.     'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
198.     DIM la AS INTEGER, lb AS INTEGER, m AS INTEGER, g AS INTEGER
199.     DIM sa AS _UNSIGNED _INTEGER64, sb AS _UNSIGNED _INTEGER64, co AS _UNSIGNED _INTEGER64
200.     DIM fa$, fb$, t$, new$, result$
201.     la = LEN(a$): lb = LEN(b$)
202.     IF la > lb THEN m = INT(la / 18) + 1 ELSE m = INT(lb / 18) + 1
203.     fa$ = RIGHT$(STRING$(m * 18, "0") + a$, m * 18)
204.     fb$ = RIGHT$(STRING$(m * 18, "0") + b$, m * 18)
205.  
206.     'now taking 18 digits at a time Thanks Steve McNeill
207.     FOR g = 1 TO m
208.         sa = VAL(MID$(fa$, m * 18 - g * 18 + 1, 18))
209.         sb = VAL(MID$(fb$, m * 18 - g * 18 + 1, 18))
210.         t$ = RIGHT$(STRING$(36, "0") + _TRIM$(STR$(sa + sb + co)), 36)
211.         co = VAL(MID$(t$, 1, 18))
212.         new$ = MID$(t$, 19)
213.         result$ = new$ + result$
214.  
215.         'debug
216.         'DIM w$
217.         'PRINT a$, m * 18, sa, sb, t$, co, result$
218.         'INPUT "OK "; w$ 'OK
219.     NEXT
220.     IF co THEN result$ = STR$(co) + result$
221.     add$ = result$
222. END FUNCTION
223.  
224. ' String Math Helpers -----------------------------------------------
225.  
226. 'this function needs TrimLead0$(s$)
227. FUNCTION LTE (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings
228.     DIM ca$, cb$, la AS INTEGER, lb AS INTEGER, i AS INTEGER
229.     ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
230.     la = LEN(ca$): lb = LEN(cb$)
231.     IF ca$ = cb$ THEN
232.         LTE = -1
233.     ELSEIF la < lb THEN ' a is smaller
234.         LTE = -1
235.     ELSEIF la > lb THEN ' a is bigger
236.         LTE = 0
237.     ELSEIF la = lb THEN ' equal lengths
238.         FOR i = 1 TO LEN(ca$)
239.             IF VAL(MID$(ca$, i, 1)) > VAL(MID$(cb$, i, 1)) THEN
240.                 LTE = 0: EXIT FUNCTION
241.             ELSEIF VAL(MID$(ca$, i, 1)) < VAL(MID$(cb$, i, 1)) THEN
242.                 LTE = -1: EXIT FUNCTION
243.             END IF
244.         NEXT
245.     END IF
246. END FUNCTION
247.  
248. ' ------------------------------------- use these for final display
249.  
250. FUNCTION TrimLead0$ (s$) 'for treating strings as number (pos integers)
251.     DIM copys$, i AS INTEGER, find AS INTEGER
252.     copys$ = _TRIM$(s$) 'might as well remove spaces too
253.     i = 1: find = 0
254.     WHILE i < LEN(copys$) AND MID$(copys$, i, 1) = "0"
255.         i = i + 1: find = 1
256.     WEND
257.     IF find = 1 THEN copys$ = MID$(copys$, i)
258.     IF copys$ = "" THEN TrimLead0$ = "0" ELSE TrimLead0$ = copys$
259. END FUNCTION
260.  
261. FUNCTION TrimTail0$ (s$)
262.     DIM copys$, dp AS INTEGER, i AS INTEGER, find AS INTEGER
263.     copys$ = _TRIM$(s$) 'might as well remove spaces too
264.     TrimTail0$ = copys$
265.     dp = INSTR(copys$, ".")
266.     IF dp > 0 THEN
267.         i = LEN(copys$): find = 0
268.         WHILE i > dp AND MID$(copys$, i, 1) = "0"
269.             i = i - 1: find = 1
270.         WEND
271.         IF find = 1 THEN
272.             IF i = dp THEN
273.                 TrimTail0$ = MID$(copys$, 1, dp - 1)
274.             ELSE
275.                 TrimTail0$ = MID$(copys$, 1, i)
276.             END IF
277.         END IF
278.     END IF
279. END FUNCTION
280.  
281. FUNCTION trim0$ (s$)
282.     DIM t$
283.     t$ = TrimLead0$(s$)
284.     trim0$ = TrimTail0$(t$)
285. END FUNCTION
286.  
287. ' for displaying truncated numbers say to 60 digits
288. FUNCTION showDP$ (num$, nDP AS INTEGER)
289.     DIM cNum$, dp AS INTEGER, d AS INTEGER, i AS INTEGER
290.     cNum$ = num$ 'since num$ could get changed
291.     showDP$ = num$
292.     dp = INSTR(num$, ".")
293.     IF dp > 0 THEN
294.         IF LEN(MID$(cNum$, dp + 1)) > nDP THEN
295.             d = VAL(MID$(cNum$, dp + nDP + 1, 1))
296.             IF d > 4 THEN
297.                 cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
298.                 dp = dp + 1
299.                 i = dp + nDP
300.                 WHILE MID$(cNum$, i, 1) = "9" OR MID$(cNum$, i, 1) = "."
301.                     IF MID$(cNum$, i, 1) = "9" THEN
302.                         MID$(cNum$, i, 1) = "0"
303.                     END IF
304.                     i = i - 1
305.                 WEND
306.                 MID$(cNum$, i, 1) = _TRIM$(STR$(VAL(MID$(cNum$, i, 1)) + 1)) 'last non 9 digit
307.                 cNum$ = MID$(cNum$, 1, dp + nDP) 'chop it
308.                 showDP$ = trim0$(cNum$)
309.             ELSE
310.                 showDP$ = MID$(cNum$, 1, dp + nDP)
311.             END IF
312.         END IF
313.     END IF
314. END FUNCTION
315.  

Milestone #1 the 4 Basic Arithmetic operations, plus display control of number (wo changing original number string).

Now for some fun with STx quiz ;-))

[bplus]

102 terms of sequence from inverse of STx Number:
(note: _UNSIGNED _INTEGER64 couldn't go the distance.)

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Multplicative Inverse: STx Fibonacci " ' b+ 2020-08-17
3. ' 2020-08-16 picking up from Sting Math add$(), subtr$(), mult$() onto divide$()
4. ' I always wanted to try doing division by multipling the numerator
5. ' by the multiplicative inverse of denominator.
6. ' n/d = n * 1/d so how bout a function that does 1/n.
7. ' Then divide$() is pretty easy with mult$  Yes works but need more decimal work.
8. ' 2020-08-17 redo all this with a decimal point for nInverse just start outstr with "." instead ""
9. ' Now somethings off with divide$() first is 1 / 500 should be .002 returning .2, debug."
10. ' Much better than post of last night
11. ' showDP rounds up to DP (Decimal Places IF there are more decimals past DP)
12.  
13. ' 2020-08-17 from Multplicative Inverse: nInverse$ and divide$
14. ' STx Fibonacci from
15. ' ref: https://www.qb64.org/forum/index.php?topic=2921.msg121845#msg121845
16.  
17.  
18. RANDOMIZE TIMER 'now that it's seems to be running silent
19. SCREEN _NEWIMAGE(1200, 700, 32)
20. _DELAY .25
21. _SCREENMOVE _MIDDLE
22.  
23. 'special cases or hard cases
24. DIM STxFib$
25. STxFib$ = nInverse$("999999999999999999999998999999999999999999999999", 2495) '2445 DP? is what he has
26. PRINT STxFib$
27. 'OK starts good let's parse it
28. DIM i AS INTEGER, fibi AS _UNSIGNED _INTEGER64, find AS LONG, dont AS INTEGER
29. DIM fibi(1 TO 200) AS STRING
30. i = 3
31. fibi(1) = "1"
32. fibi(2) = "1"
33. find = 0
34. DO
35.     fibi(i) = trim0$(add$(fibi(i - 2), fibi(i - 1)))
36.     find = INSTR(find + 1, STxFib$, fibi(i))
37.     IF find > 0 THEN
38.         PRINT "Found Fibonacci"; i; ", "; fibi(i); " at"; find; "of len(STxFib$) ="; LEN(STxFib$)
39.         i = i + 1
40.     ELSE
41.         PRINT "Failed to find next Fibonacci number"; i
42.         dont = -1
43.     END IF
44.     PRINT "Press any to continue..."
45.     SLEEP
46. LOOP UNTIL dont = -1
47.  
48.  
49.  
50.  
51. FUNCTION divide$ (n$, d$)
52.     DIM di$, ndi$, nD AS INTEGER
53.     IF trim0$(n$) = "0" THEN divide$ = "0": EXIT FUNCTION
54.     IF trim0$(d$) = "0" THEN divide$ = "div 0": EXIT FUNCTION
55.     IF trim0$(d$) = "1" THEN divide$ = trim0$(n$): EXIT FUNCTION '8/17 add trim0$
56.     di$ = MID$(nInverse$(d$, 100), 2) 'chop off decimal point after
57.     nD = LEN(di$)
58.     ndi$ = mult$(n$, di$)
59.     ndi$ = MID$(ndi$, 1, LEN(ndi$) - nD) + "." + RIGHT$(STRING$(nD, "0") + RIGHT$(ndi$, nD), nD)
60.     divide$ = trim0$(ndi$)
61. END FUNCTION
62.  
63. FUNCTION nInverse$ (n$, DP AS INTEGER) 'assume decimal at very start of the string of digits returned, no rounding
64.     DIM m$(1 TO 9), si$, r$, outstr$, d$
65.     DIM i AS INTEGER
66.     FOR i = 1 TO 9
67.         si$ = _TRIM$(STR$(i))
68.         m$(i) = mult$(si$, n$)
69.     NEXT
70.     outstr$ = ""
71.     IF n$ = "0" THEN nInverse$ = "Div 0": EXIT FUNCTION
72.     IF n$ = "1" THEN nInverse$ = "1": EXIT FUNCTION
73.     outstr$ = "." 'everything else n > 1 is decimal 8/17
74.     r$ = "10"
75.     DO
76.         WHILE LEFT$(subtr$(r$, n$), 1) = "-" '   r - n < 0
77.             outstr$ = outstr$ + "0" '            add 0 to the  output string
78.             IF LEN(outstr$) = DP THEN nInverse$ = outstr$: EXIT FUNCTION 'check if we've reached DP length
79.             r$ = r$ + "0"
80.         WEND
81.         FOR i = 9 TO 1 STEP -1
82.             IF LTE(m$(i), r$) THEN d$ = _TRIM$(STR$(i)): EXIT FOR
83.         NEXT
84.         outstr$ = outstr$ + d$
85.         IF LEN(outstr$) = DP THEN nInverse$ = outstr$: EXIT FUNCTION
86.         r$ = subtr$(r$, mult$(d$, n$)) 'r = r -d*n
87.         IF r$ = "0" THEN nInverse$ = outstr$: EXIT FUNCTION 'found a perfect divisor
88.         r$ = r$ + "0" 'add another place
89.     LOOP
90. END FUNCTION
91.  
92. FUNCTION mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
93.     DIM la AS INTEGER, lb AS INTEGER, m AS INTEGER, g AS INTEGER, dp AS INTEGER
94.     DIM v18 AS _UNSIGNED _INTEGER64, sd AS _UNSIGNED _INTEGER64, co AS _UNSIGNED _INTEGER64
95.     DIM f18$, f1$, t$, build$, accum$
96.  
97.     IF trim0$(a$) = "0" THEN mult$ = "0": EXIT FUNCTION
98.     IF trim0$(b$) = "0" THEN mult$ = "0": EXIT FUNCTION
99.     IF trim0$(a$) = "1" THEN mult$ = trim0$(b$): EXIT FUNCTION
100.     IF trim0$(b$) = "1" THEN mult$ = trim0$(a$): EXIT FUNCTION
101.     'find the longer number and make it a mult of 18 to take 18 digits at a time from it
102.     la = LEN(a$): lb = LEN(b$)
103.     IF la > lb THEN
104.         m = INT(la / 18) + 1
105.         f18$ = RIGHT$(STRING$(m * 18, "0") + a$, m * 18)
106.         f1$ = b$
107.     ELSE
108.         m = INT(lb / 18) + 1
109.         f18$ = RIGHT$(STRING$(m * 18, "0") + b$, m * 18)
110.         f1$ = a$
111.     END IF
112.     FOR dp = LEN(f1$) TO 1 STEP -1 'dp = digit position of the f1$
113.         build$ = "" 'line builder
114.         co = 0
115.         'now taking 18 digits at a time Thanks Steve McNeill
116.         FOR g = 1 TO m
117.             v18 = VAL(MID$(f18$, m * 18 - g * 18 + 1, 18))
118.             sd = VAL(MID$(f1$, dp, 1))
119.             t$ = RIGHT$(STRING$(19, "0") + _TRIM$(STR$(v18 * sd + co)), 19)
120.             co = VAL(MID$(t$, 1, 1))
121.             build$ = MID$(t$, 2) + build$
122.         NEXT g
123.         IF co THEN build$ = _TRIM$(STR$(co)) + build$
124.         IF dp = LEN(f1$) THEN
125.             accum$ = build$
126.         ELSE
127.             accum$ = add$(accum$, build$ + STRING$(LEN(f1$) - dp, "0"))
128.         END IF
129.     NEXT dp
130.     mult$ = accum$
131. END FUNCTION
132.  
133. FUNCTION subtr$ (sum$, minus$) ' assume both numbers are positive all digits
134.     DIM m AS INTEGER, g AS INTEGER, p AS INTEGER
135.     DIM VB AS _UNSIGNED _INTEGER64, vs AS _UNSIGNED _INTEGER64, tenE18 AS _UNSIGNED _INTEGER64
136.     DIM ts$, tm$, sign$, LG$, sm$, t$, result$
137.  
138.     ts$ = TrimLead0$(sum$): tm$ = TrimLead0$(minus$)
139.     IF trim0(ts$) = trim0$(tm$) THEN subtr$ = "0": EXIT FUNCTION 'OK proceed with function knowing they are not equal
140.     tenE18 = 1000000000000000000 'yes!!! no dang E's
141.     IF LTE(ts$, tm$) THEN ' which is bigger? minus is bigger
142.         sign$ = "-"
143.         m = INT(LEN(tm$) / 18) + 1
144.         LG$ = RIGHT$(STRING$(m * 18, "0") + tm$, m * 18)
145.         sm$ = RIGHT$(STRING$(m * 18, "0") + ts$, m * 18)
146.     ELSE 'sum is bigger
147.         sign$ = ""
148.         m = INT(LEN(ts$) / 18) + 1
149.         LG$ = RIGHT$(STRING$(m * 18, "0") + ts$, m * 18)
150.         sm$ = RIGHT$(STRING$(m * 18, "0") + tm$, m * 18)
151.     END IF
152.     'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
153.     FOR g = 1 TO m
154.         VB = VAL(MID$(LG$, m * 18 - g * 18 + 1, 18))
155.         vs = VAL(MID$(sm$, m * 18 - g * 18 + 1, 18))
156.         IF vs > VB THEN
157.             t$ = RIGHT$(STRING$(18, "0") + _TRIM$(STR$(tenE18 - vs + VB)), 18)
158.  
159.             'debug
160.             'PRINT VB, tenE18, tenE18 - vs + VB, " t$ = "; t$
161.  
162.             ''borrow 1 = rewrite string
163.             p = (m - g) * 18
164.             WHILE p > 0 AND MID$(LG$, p, 1) = "0"
165.                 MID$(LG$, p, 1) = "9"
166.                 p = p - 1
167.             WEND
168.             IF p > 0 THEN MID$(LG$, p, 1) = _TRIM$(STR$(VAL(MID$(LG$, p, 1)) - 1))
169.         ELSE
170.             t$ = RIGHT$(STRING$(18, "0") + _TRIM$(STR$(VB - vs)), 18)
171.         END IF
172.         result$ = t$ + result$
173.     NEXT
174.     subtr$ = sign$ + result$
175. END FUNCTION
176.  
177. FUNCTION add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
178.     'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
179.     DIM la AS INTEGER, lb AS INTEGER, m AS INTEGER, g AS INTEGER
180.     DIM sa AS _UNSIGNED _INTEGER64, sb AS _UNSIGNED _INTEGER64, co AS _UNSIGNED _INTEGER64
181.     DIM fa$, fb$, t$, new$, result$
182.     la = LEN(a$): lb = LEN(b$)
183.     IF la > lb THEN m = INT(la / 18) + 1 ELSE m = INT(lb / 18) + 1
184.     fa$ = RIGHT$(STRING$(m * 18, "0") + a$, m * 18)
185.     fb$ = RIGHT$(STRING$(m * 18, "0") + b$, m * 18)
186.  
187.     'now taking 18 digits at a time Thanks Steve McNeill
188.     FOR g = 1 TO m
189.         sa = VAL(MID$(fa$, m * 18 - g * 18 + 1, 18))
190.         sb = VAL(MID$(fb$, m * 18 - g * 18 + 1, 18))
191.         t$ = RIGHT$(STRING$(36, "0") + _TRIM$(STR$(sa + sb + co)), 36)
192.         co = VAL(MID$(t$, 1, 18))
193.         new$ = MID$(t$, 19)
194.         result$ = new$ + result$
195.  
196.         'debug
197.         'DIM w$
198.         'PRINT a$, m * 18, sa, sb, t$, co, result$
199.         'INPUT "OK "; w$ 'OK
200.     NEXT
201.     IF co THEN result$ = STR$(co) + result$
202.     add$ = result$
203. END FUNCTION
204.  
205. ' String Math Helpers -----------------------------------------------
206.  
207. 'this function needs TrimLead0$(s$)
208. FUNCTION LTE (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings
209.     DIM ca$, cb$, la AS INTEGER, lb AS INTEGER, i AS INTEGER
210.     ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
211.     la = LEN(ca$): lb = LEN(cb$)
212.     IF ca$ = cb$ THEN
213.         LTE = -1
214.     ELSEIF la < lb THEN ' a is smaller
215.         LTE = -1
216.     ELSEIF la > lb THEN ' a is bigger
217.         LTE = 0
218.     ELSEIF la = lb THEN ' equal lengths
219.         FOR i = 1 TO LEN(ca$)
220.             IF VAL(MID$(ca$, i, 1)) > VAL(MID$(cb$, i, 1)) THEN
221.                 LTE = 0: EXIT FUNCTION
222.             ELSEIF VAL(MID$(ca$, i, 1)) < VAL(MID$(cb$, i, 1)) THEN
223.                 LTE = -1: EXIT FUNCTION
224.             END IF
225.         NEXT
226.     END IF
227. END FUNCTION
228.  
229. ' ------------------------------------- use these for final display
230.  
231. FUNCTION TrimLead0$ (s$) 'for treating strings as number (pos integers)
232.     DIM copys$, i AS INTEGER, find AS INTEGER
233.     copys$ = _TRIM$(s$) 'might as well remove spaces too
234.     i = 1: find = 0
235.     WHILE i < LEN(copys$) AND MID$(copys$, i, 1) = "0"
236.         i = i + 1: find = 1
237.     WEND
238.     IF find = 1 THEN copys$ = MID$(copys$, i)
239.     IF copys$ = "" THEN TrimLead0$ = "0" ELSE TrimLead0$ = copys$
240. END FUNCTION
241.  
242. FUNCTION TrimTail0$ (s$)
243.     DIM copys$, dp AS INTEGER, i AS INTEGER, find AS INTEGER
244.     copys$ = _TRIM$(s$) 'might as well remove spaces too
245.     TrimTail0$ = copys$
246.     dp = INSTR(copys$, ".")
247.     IF dp > 0 THEN
248.         i = LEN(copys$): find = 0
249.         WHILE i > dp AND MID$(copys$, i, 1) = "0"
250.             i = i - 1: find = 1
251.         WEND
252.         IF find = 1 THEN
253.             IF i = dp THEN
254.                 TrimTail0$ = MID$(copys$, 1, dp - 1)
255.             ELSE
256.                 TrimTail0$ = MID$(copys$, 1, i)
257.             END IF
258.         END IF
259.     END IF
260. END FUNCTION
261.  
262. FUNCTION trim0$ (s$)
263.     DIM t$
264.     t$ = TrimLead0$(s$)
265.     trim0$ = TrimTail0$(t$)
266. END FUNCTION
267.  
268. ' for displaying truncated numbers say to 60 digits
269. FUNCTION showDP$ (num$, nDP AS INTEGER)
270.     DIM cNum$, dp AS INTEGER, d AS INTEGER, i AS INTEGER
271.     cNum$ = num$ 'since num$ could get changed
272.     showDP$ = num$
273.     dp = INSTR(num$, ".")
274.     IF dp > 0 THEN
275.         IF LEN(MID$(cNum$, dp + 1)) > nDP THEN
276.             d = VAL(MID$(cNum$, dp + nDP + 1, 1))
277.             IF d > 4 THEN
278.                 cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
279.                 dp = dp + 1
280.                 i = dp + nDP
281.                 WHILE MID$(cNum$, i, 1) = "9" OR MID$(cNum$, i, 1) = "."
282.                     IF MID$(cNum$, i, 1) = "9" THEN
283.                         MID$(cNum$, i, 1) = "0"
284.                     END IF
285.                     i = i - 1
286.                 WEND
287.                 MID$(cNum$, i, 1) = _TRIM$(STR$(VAL(MID$(cNum$, i, 1)) + 1)) 'last non 9 digit
288.                 cNum$ = MID$(cNum$, 1, dp + nDP) 'chop it
289.                 showDP$ = trim0$(cNum$)
290.             ELSE
291.                 showDP$ = MID$(cNum$, 1, dp + nDP)
292.             END IF
293.         END IF
294.     END IF
295. END FUNCTION
296.  

 

[bplus]

Here it is! String math for 4 basic arithmetic operations with signs and decimal places in under 300 lines:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Math regulator mr" ' b+ start 2020-08-17
3. ' 2020-08-16 picking up from String Math add$(), subtr$(), mult$() onto divide$()
4. ' I always wanted to try doing division by multipling the numerator
5. ' by the multiplicative inverse of denominator.
6. ' n/d = n * 1/d so how bout a function that does 1/n.
7. ' Then divide$() is pretty easy with mult$  Yes works but need more decimal work.
8. ' 2020-08-17 redo all this with a decimal point for nInverse just start outstr with "." instead ""
9. ' Now somethings off with divide$() first is 1 / 500 should be .002 returning .2, debug."
10. ' Much better than post of last night
11. ' showDP rounds up to DP (Decimal Places IF there are more decimals past DP)
12. ' 2020-08-17 Math regulator mr$(a$, ops$, b$) ' manages before and after calls to 4 basic arith operations
13. ' note: 265 lines with just the set of functions so far
14. ' 2020-08-18 last night subtr and signs confused hell out of me but I think I have all code I need for +!
15. ' OK add and subtr seem to be working with signs and decimals but ugly code, can we combine lines?
16. ' OH yeah, traded 12 redundant lines for 2! and a bunch of debug and other 389 lines to 354
17. ' OK setup for * and /, mr$ finished adding 77 lines of code
18. ' OK everything is simple after divide$() and substraction with signs and decimals ;-))
19.  
20. RANDOMIZE TIMER 'now that it's seems to be running silent
21. SCREEN _NEWIMAGE(1200, 700, 32)
22. _DELAY .25
23. _SCREENMOVE _MIDDLE
24.  
25. ' debug tests
26. 'PRINT "2105 ? "
27. 'PRINT mr$("5", "+", "2100") ' OK
28. 'PRINT "-10039.0965 ? "
29. 'PRINT mr$("6.1035", "+", "-10045.2") ' OK
30. 'PRINT "-801.99968 ?"
31. 'PRINT mr$("-802", "+", ".00032")
32. 'PRINT "-.0003500009 ?"
33. 'PRINT mr$("-.00035", "+", "-.0000000009")
34. 'PRINT "-5 ?"
35. 'PRINT mr$("-10", "-", "-5")
36. 'PRINT "-15 ?"
37. 'PRINT mr$("-10", "-", "5") 'X fixed
38. 'PRINT "15 ?"
39. 'PRINT mr$("10", "-", "-5")
40. 'PRINT "5 ?"
41. 'PRINT mr$("10", "-", "5")
42. 'PRINT "4.99 ?"
43. 'PRINT mr$("-.010", "-", "-5")
44. 'PRINT "-5.01 ?"
45. 'PRINT mr$("-.010", "-", "5") 'X  fixed
46. 'PRINT "5.01 ?"
47. 'PRINT mr$(".010", "-", "-5")
48. 'PRINT "-4.99 ?"
49. 'PRINT mr$(".010", "-", "5")
50. 'PRINT .00207 * 10000; "?"
51. 'PRINT mr$(".00207", " * ", "10000") 'OK
52. 'PRINT 2468.02468 / .02; "?"
53. 'PRINT mr$("2468.02468", "/", ".02") 'OK
54. 'PRINT -.333333333333333333 * -3.00000000000; "?"
55. 'PRINT mr$("-.333333333333333333", "*", "-3.00000000000") 'OK
56. 'PRINT -1.0000001 / .07; "?"
57. 'PRINT mr$("-1.0000001", "/", ".07") 'OK
58. 'PRINT 90.9 / -30; "?"
59. 'PRINT mr$("90.9", "/", "-30") 'OK
60.  
61.  
62. 'random testing for correct signs, decimal places and values
63. DIM ad AS DOUBLE, bd AS DOUBLE, check AS DOUBLE, ea AS INTEGER, eb AS INTEGER, ma AS INTEGER, mb AS INTEGER
64. DIM op$, a$, b$, mrStr$, ma$, mb$, qbCalc$
65. DO
66.     'pick two numbers
67.     op$ = MID$("+-*/", INT(RND * 4) + 1, 1)
68.     IF RND < .5 THEN
69.         ma$ = "-": ma = -1
70.     ELSE
71.         ma$ = "": ma = 1
72.     END IF
73.     IF RND < .5 THEN
74.         mb$ = "-": mb = -1
75.     ELSE
76.         mb$ = "": mb = 1
77.     END IF
78.  
79.     ea = INT(10 * RND): eb = INT(10 * RND)
80.     ad = ma * RND * 10 ^ ea: bd = mb * RND * 10 ^ eb
81.     SELECT CASE op$
82.         CASE "+": check = ad + bd
83.         CASE "-": check = ad - bd
84.         CASE "*": check = ad * bd
85.         CASE "/": check = ad / bd
86.     END SELECT
87.     a$ = _TRIM$(STR$(ad)): b$ = _TRIM$(STR$(bd))
88.     PRINT
89.     PRINT a$; " "; op$; " "; b$; " ="
90.     mrStr$ = mr$(a$, op$, b$)
91.     PRINT mrStr$; " according to mr$ function we are testing."
92.     qbCalc$ = _TRIM$(STR$(check))
93.     PRINT qbCalc$; " according to QB64 math"
94.     PRINT "diff ="; VAL(mrStr$) - check
95.     PRINT "Next subtr$ check in 10 secs, or press key,  press escape to quit..."
96.     SLEEP 10 ' comment out to see if any delay in execution of print
97. LOOP UNTIL _KEYDOWN(27)
98.  
99. FUNCTION mr$ (a$, op$, b$) ' catchy? mr$ for math regulator
100.     DIM ca$, cb$, aSgn$, bSgn$, postOp$, sgn$
101.     DIM adp AS INTEGER, bdp AS INTEGER, dp AS INTEGER, lpop AS INTEGER
102.  
103.     op$ = _TRIM$(op$) 'save fixing each time
104.     ca$ = _TRIM$(a$): cb$ = _TRIM$(b$) 'make copies in case we change
105.     'strip signs and decimals
106.     IF LEFT$(ca$, 1) = "-" THEN
107.         aSgn$ = "-": ca$ = MID$(ca$, 2)
108.     ELSE
109.         aSgn$ = "": ca$ = ca$
110.     END IF
111.     dp = INSTR(ca$, ".")
112.     IF dp > 0 THEN
113.         adp = LEN(ca$) - dp
114.         ca$ = MID$(ca$, 1, dp - 1) + MID$(ca$, dp + 1)
115.     ELSE
116.         adp = 0
117.     END IF
118.     IF LEFT$(cb$, 1) = "-" THEN
119.         bSgn$ = "-": cb$ = MID$(cb$, 2)
120.     ELSE
121.         bSgn$ = "": cb$ = cb$
122.     END IF
123.     dp = INSTR(cb$, ".")
124.     IF dp > 0 THEN
125.         bdp = LEN(cb$) - dp
126.         cb$ = MID$(cb$, 1, dp - 1) + MID$(cb$, dp + 1)
127.     ELSE
128.         bdp = 0
129.     END IF
130.  
131.     IF op$ = "+" OR op$ = "-" OR op$ = "/" THEN 'add or subtr  even up strings on right of decimal
132.         'even up the right sides of decimals if any
133.         IF adp > bdp THEN dp = adp ELSE dp = bdp
134.         IF adp < dp THEN ca$ = ca$ + STRING$(dp - adp, "0")
135.         IF bdp < dp THEN cb$ = cb$ + STRING$(dp - bdp, "0")
136.     ELSEIF op$ = "*" THEN
137.         dp = adp + bdp
138.     END IF
139.     IF op$ = "*" OR op$ = "/" THEN
140.         IF aSgn$ = bSgn$ THEN sgn$ = "" ELSE sgn$ = "-"
141.     END IF
142.     'now according to signs and op$ call add$ or subtr$
143.     IF op$ = "+" THEN
144.         IF aSgn$ = bSgn$ THEN 'really add
145.             postOp$ = aSgn$ + add$(ca$, cb$)
146.         ELSE 'have a case of subtraction
147.             IF aSgn$ = "-" THEN postOp$ = subtr$(cb$, ca$) ELSE postOp$ = subtr$(ca$, cb$)
148.         END IF
149.     ELSEIF op$ = "-" THEN
150.         IF bSgn$ = "-" THEN 'really add but switch b sign
151.             bSgn$ = ""
152.             IF aSgn$ = "-" THEN
153.                 postOp$ = subtr$(cb$, ca$)
154.             ELSE 'aSgn = ""
155.                 postOp$ = add$(ca$, cb$)
156.             END IF
157.         ELSE 'bSgn$ =""
158.             IF aSgn$ = "-" THEN
159.                 bSgn$ = "-"
160.                 postOp$ = aSgn$ + add$(ca$, cb$)
161.             ELSE
162.                 postOp$ = subtr$(ca$, cb$)
163.             END IF
164.         END IF
165.     ELSEIF op$ = "*" THEN
166.         postOp$ = sgn$ + mult$(ca$, cb$)
167.     ELSEIF op$ = "/" THEN
168.         postOp$ = sgn$ + divide$(ca$, cb$)
169.     END IF ' which op
170.     'put dp back
171.     IF op$ <> "/" THEN
172.         lpop = LEN(postOp$) ' put decimal back
173.         postOp$ = MID$(postOp$, 1, lpop - dp) + "." + MID$(postOp$, lpop - dp + 1)
174.     END IF
175.     mr$ = trim0$(postOp$)
176. END FUNCTION
177.  
178. FUNCTION divide$ (n$, d$)
179.     DIM di$, ndi$, nD AS INTEGER
180.     IF trim0$(n$) = "0" THEN divide$ = "0": EXIT FUNCTION
181.     IF trim0$(d$) = "0" THEN divide$ = "div 0": EXIT FUNCTION
182.     IF trim0$(d$) = "1" THEN divide$ = trim0$(n$): EXIT FUNCTION '8/17 add trim0$
183.     di$ = MID$(nInverse$(d$, 100), 2) 'chop off decimal point after
184.     nD = LEN(di$)
185.     ndi$ = mult$(n$, di$)
186.     ndi$ = MID$(ndi$, 1, LEN(ndi$) - nD) + "." + RIGHT$(STRING$(nD, "0") + RIGHT$(ndi$, nD), nD)
187.     divide$ = trim0$(ndi$)
188. END FUNCTION
189.  
190. FUNCTION nInverse$ (n$, DP AS INTEGER) 'assume decimal at very start of the string of digits returned, no rounding
191.     DIM m$(1 TO 9), si$, r$, outstr$, d$
192.     DIM i AS INTEGER
193.     FOR i = 1 TO 9
194.         si$ = _TRIM$(STR$(i))
195.         m$(i) = mult$(si$, n$)
196.     NEXT
197.     outstr$ = ""
198.     IF n$ = "0" THEN nInverse$ = "Div 0": EXIT FUNCTION
199.     IF n$ = "1" THEN nInverse$ = "1": EXIT FUNCTION
200.     outstr$ = "." 'everything else n > 1 is decimal 8/17
201.     r$ = "10"
202.     DO
203.         WHILE LEFT$(subtr$(r$, n$), 1) = "-" '   r - n < 0
204.             outstr$ = outstr$ + "0" '            add 0 to the  output string
205.             IF LEN(outstr$) = DP THEN nInverse$ = outstr$: EXIT FUNCTION 'check if we've reached DP length
206.             r$ = r$ + "0"
207.         WEND
208.         FOR i = 9 TO 1 STEP -1
209.             IF LTE(m$(i), r$) THEN d$ = _TRIM$(STR$(i)): EXIT FOR
210.         NEXT
211.         outstr$ = outstr$ + d$
212.         IF LEN(outstr$) = DP THEN nInverse$ = outstr$: EXIT FUNCTION
213.         r$ = subtr$(r$, mult$(d$, n$)) 'r = r -d*n
214.         IF r$ = "0" THEN nInverse$ = outstr$: EXIT FUNCTION 'found a perfect divisor
215.         r$ = r$ + "0" 'add another place
216.     LOOP
217. END FUNCTION
218.  
219. FUNCTION mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
220.     DIM la AS INTEGER, lb AS INTEGER, m AS INTEGER, g AS INTEGER, dp AS INTEGER
221.     DIM v18 AS _UNSIGNED _INTEGER64, sd AS _UNSIGNED _INTEGER64, co AS _UNSIGNED _INTEGER64
222.     DIM f18$, f1$, t$, build$, accum$
223.  
224.     IF trim0$(a$) = "0" THEN mult$ = "0": EXIT FUNCTION
225.     IF trim0$(b$) = "0" THEN mult$ = "0": EXIT FUNCTION
226.     IF trim0$(a$) = "1" THEN mult$ = trim0$(b$): EXIT FUNCTION
227.     IF trim0$(b$) = "1" THEN mult$ = trim0$(a$): EXIT FUNCTION
228.     'find the longer number and make it a mult of 18 to take 18 digits at a time from it
229.     la = LEN(a$): lb = LEN(b$)
230.     IF la > lb THEN
231.         m = INT(la / 18) + 1
232.         f18$ = RIGHT$(STRING$(m * 18, "0") + a$, m * 18)
233.         f1$ = b$
234.     ELSE
235.         m = INT(lb / 18) + 1
236.         f18$ = RIGHT$(STRING$(m * 18, "0") + b$, m * 18)
237.         f1$ = a$
238.     END IF
239.     FOR dp = LEN(f1$) TO 1 STEP -1 'dp = digit position of the f1$
240.         build$ = "" 'line builder
241.         co = 0
242.         'now taking 18 digits at a time Thanks Steve McNeill
243.         FOR g = 1 TO m
244.             v18 = VAL(MID$(f18$, m * 18 - g * 18 + 1, 18))
245.             sd = VAL(MID$(f1$, dp, 1))
246.             t$ = RIGHT$(STRING$(19, "0") + _TRIM$(STR$(v18 * sd + co)), 19)
247.             co = VAL(MID$(t$, 1, 1))
248.             build$ = MID$(t$, 2) + build$
249.         NEXT g
250.         IF co THEN build$ = _TRIM$(STR$(co)) + build$
251.         IF dp = LEN(f1$) THEN
252.             accum$ = build$
253.         ELSE
254.             accum$ = add$(accum$, build$ + STRING$(LEN(f1$) - dp, "0"))
255.         END IF
256.     NEXT dp
257.     mult$ = accum$
258. END FUNCTION
259.  
260. FUNCTION subtr$ (sum$, minus$) ' assume both numbers are positive all digits
261.     DIM m AS INTEGER, g AS INTEGER, p AS INTEGER
262.     DIM VB AS _UNSIGNED _INTEGER64, vs AS _UNSIGNED _INTEGER64, tenE18 AS _UNSIGNED _INTEGER64
263.     DIM ts$, tm$, sign$, LG$, sm$, t$, result$
264.  
265.     ts$ = TrimLead0$(sum$): tm$ = TrimLead0$(minus$)
266.     IF trim0(ts$) = trim0$(tm$) THEN subtr$ = "0": EXIT FUNCTION 'OK proceed with function knowing they are not equal
267.     tenE18 = 1000000000000000000 'yes!!! no dang E's
268.     IF LTE(ts$, tm$) THEN ' which is bigger? minus is bigger
269.         sign$ = "-"
270.         m = INT(LEN(tm$) / 18) + 1
271.         LG$ = RIGHT$(STRING$(m * 18, "0") + tm$, m * 18)
272.         sm$ = RIGHT$(STRING$(m * 18, "0") + ts$, m * 18)
273.     ELSE 'sum is bigger
274.         sign$ = ""
275.         m = INT(LEN(ts$) / 18) + 1
276.         LG$ = RIGHT$(STRING$(m * 18, "0") + ts$, m * 18)
277.         sm$ = RIGHT$(STRING$(m * 18, "0") + tm$, m * 18)
278.     END IF
279.     'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
280.     FOR g = 1 TO m
281.         VB = VAL(MID$(LG$, m * 18 - g * 18 + 1, 18))
282.         vs = VAL(MID$(sm$, m * 18 - g * 18 + 1, 18))
283.         IF vs > VB THEN
284.             t$ = RIGHT$(STRING$(18, "0") + _TRIM$(STR$(tenE18 - vs + VB)), 18)
285.             p = (m - g) * 18
286.             WHILE p > 0 AND MID$(LG$, p, 1) = "0"
287.                 MID$(LG$, p, 1) = "9"
288.                 p = p - 1
289.             WEND
290.             IF p > 0 THEN MID$(LG$, p, 1) = _TRIM$(STR$(VAL(MID$(LG$, p, 1)) - 1))
291.         ELSE
292.             t$ = RIGHT$(STRING$(18, "0") + _TRIM$(STR$(VB - vs)), 18)
293.         END IF
294.         result$ = t$ + result$
295.     NEXT
296.     subtr$ = sign$ + result$
297. END FUNCTION
298.  
299. FUNCTION add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
300.     'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
301.     DIM la AS INTEGER, lb AS INTEGER, m AS INTEGER, g AS INTEGER
302.     DIM sa AS _UNSIGNED _INTEGER64, sb AS _UNSIGNED _INTEGER64, co AS _UNSIGNED _INTEGER64
303.     DIM fa$, fb$, t$, new$, result$
304.     la = LEN(a$): lb = LEN(b$)
305.     IF la > lb THEN m = INT(la / 18) + 1 ELSE m = INT(lb / 18) + 1
306.     fa$ = RIGHT$(STRING$(m * 18, "0") + a$, m * 18)
307.     fb$ = RIGHT$(STRING$(m * 18, "0") + b$, m * 18)
308.  
309.     'now taking 18 digits at a time Thanks Steve McNeill
310.     FOR g = 1 TO m
311.         sa = VAL(MID$(fa$, m * 18 - g * 18 + 1, 18))
312.         sb = VAL(MID$(fb$, m * 18 - g * 18 + 1, 18))
313.         t$ = RIGHT$(STRING$(36, "0") + _TRIM$(STR$(sa + sb + co)), 36)
314.         co = VAL(MID$(t$, 1, 18))
315.         new$ = MID$(t$, 19)
316.         result$ = new$ + result$
317.     NEXT
318.     IF co THEN result$ = STR$(co) + result$
319.     add$ = result$
320. END FUNCTION
321.  
322. ' String Math Helpers -----------------------------------------------
323.  
324. 'this function needs TrimLead0$(s$)
325. FUNCTION LTE (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings
326.     DIM ca$, cb$, la AS INTEGER, lb AS INTEGER, i AS INTEGER
327.     ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
328.     la = LEN(ca$): lb = LEN(cb$)
329.     IF ca$ = cb$ THEN
330.         LTE = -1
331.     ELSEIF la < lb THEN ' a is smaller
332.         LTE = -1
333.     ELSEIF la > lb THEN ' a is bigger
334.         LTE = 0
335.     ELSEIF la = lb THEN ' equal lengths
336.         FOR i = 1 TO LEN(ca$)
337.             IF VAL(MID$(ca$, i, 1)) > VAL(MID$(cb$, i, 1)) THEN
338.                 LTE = 0: EXIT FUNCTION
339.             ELSEIF VAL(MID$(ca$, i, 1)) < VAL(MID$(cb$, i, 1)) THEN
340.                 LTE = -1: EXIT FUNCTION
341.             END IF
342.         NEXT
343.     END IF
344. END FUNCTION
345.  
346. ' ------------------------------------- use these for final display
347.  
348. FUNCTION TrimLead0$ (s$) 'for treating strings as number (pos integers)
349.     DIM copys$, i AS INTEGER, find AS INTEGER
350.     copys$ = _TRIM$(s$) 'might as well remove spaces too
351.     i = 1: find = 0
352.     WHILE i < LEN(copys$) AND MID$(copys$, i, 1) = "0"
353.         i = i + 1: find = 1
354.     WEND
355.     IF find = 1 THEN copys$ = MID$(copys$, i)
356.     IF copys$ = "" THEN TrimLead0$ = "0" ELSE TrimLead0$ = copys$
357. END FUNCTION
358.  
359. FUNCTION TrimTail0$ (s$)
360.     DIM copys$, dp AS INTEGER, i AS INTEGER, find AS INTEGER
361.     copys$ = _TRIM$(s$) 'might as well remove spaces too
362.     TrimTail0$ = copys$
363.     dp = INSTR(copys$, ".")
364.     IF dp > 0 THEN
365.         i = LEN(copys$): find = 0
366.         WHILE i > dp AND MID$(copys$, i, 1) = "0"
367.             i = i - 1: find = 1
368.         WEND
369.         IF find = 1 THEN
370.             IF i = dp THEN
371.                 TrimTail0$ = MID$(copys$, 1, dp - 1)
372.             ELSE
373.                 TrimTail0$ = MID$(copys$, 1, i)
374.             END IF
375.         END IF
376.     END IF
377. END FUNCTION
378.  
379. FUNCTION trim0$ (s$)
380.     DIM cs$, si$
381.     cs$ = s$
382.     si$ = LEFT$(cs$, 1)
383.     IF si$ = "-" THEN cs$ = MID$(cs$, 2)
384.     cs$ = TrimLead0$(cs$)
385.     cs$ = TrimTail0$(cs$)
386.     IF RIGHT$(cs$, 1) = "." THEN cs$ = MID$(cs$, 1, LEN(cs$) - 1)
387.     IF si$ = "-" THEN trim0$ = si$ + cs$ ELSE trim0$ = cs$
388. END FUNCTION
389.  
390. ' for displaying truncated numbers say to 60 digits
391. FUNCTION showDP$ (num$, nDP AS INTEGER)
392.     DIM cNum$, dp AS INTEGER, d AS INTEGER, i AS INTEGER
393.     cNum$ = num$ 'since num$ could get changed
394.     showDP$ = num$
395.     dp = INSTR(num$, ".")
396.     IF dp > 0 THEN
397.         IF LEN(MID$(cNum$, dp + 1)) > nDP THEN
398.             d = VAL(MID$(cNum$, dp + nDP + 1, 1))
399.             IF d > 4 THEN
400.                 cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
401.                 dp = dp + 1
402.                 i = dp + nDP
403.                 WHILE MID$(cNum$, i, 1) = "9" OR MID$(cNum$, i, 1) = "."
404.                     IF MID$(cNum$, i, 1) = "9" THEN
405.                         MID$(cNum$, i, 1) = "0"
406.                     END IF
407.                     i = i - 1
408.                 WEND
409.                 MID$(cNum$, i, 1) = _TRIM$(STR$(VAL(MID$(cNum$, i, 1)) + 1)) 'last non 9 digit
410.                 cNum$ = MID$(cNum$, 1, dp + nDP) 'chop it
411.                 showDP$ = trim0$(cNum$)
412.             ELSE
413.                 showDP$ = MID$(cNum$, 1, dp + nDP)
414.             END IF
415.         END IF
416.     END IF
417. END FUNCTION
418.  

Update 2021-06-03: Nope! Sorry the divide$ function was buggy. Had to pull the link to this code from Library.

[bplus]

Attempting to extend String Math into Square Roots, I discovered a huge bug with Divide$ Function, it's all commented in code below. I think I have it patched but maybe not. This is tricky without Boolean Compares for String Math.

Main code is testing a 100 digit precision Square Root Code and Divide$ has the "fixed"? String Math patch

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Math regulator mr test sqr estimating" ' b+ start 2021-06-02
3. Randomize Timer 'now that it's seems to be running silent
4. Screen _NewImage(1200, 700, 32)
5. _Delay .25
6. _ScreenMove _Middle
7.  
8. Dim n$, guess$, other$, cont$, sum$, loopCnt, lastGuess$
9. Do
10.     'remember everything is strings
11.     Input "Enter a number to find it's square root "; n$
12.     If n$ = "" Then End
13.     guess$ = mr$(n$, "/", "2") ' for n$ = 2
14.     other$ = n$
15.     loopCnt = 0
16.     Do
17.         loopCnt = loopCnt + 1
18.         Print loopCnt; " guess: "; guess$
19.         'Input "Continue press enter, any other to quit "; cont$
20.         'If cont$ = "" Then
21.         If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then ' go past 100 matching digits for 100 digit precision
22.             Print
23.             Print "100 digits precision goal, not 100 digits past decimal: Square root of "; n$; " is:"
24.             Print Mid$(guess$, 1, 101) ' one char for decimal
25.             _Clipboard$ = Mid$(guess$, 1, 101) ' ditto
26.             Print
27.             Exit Do
28.         Else
29.             lastGuess$ = guess$
30.             'Print "guess$ "; guess$
31.             'Print "other$ "; other$
32.             sum$ = mr$(guess$, "+", other$)
33.             'Print "sum$ "; sum$
34.             'Print "Call divide for guess$, sum$ / 2"
35.             guess$ = mr$(sum$, "/", "2")
36.             Print "New guess$ "; Mid$(guess$, 1, 105)
37.             'Print "Call n$ divide  new guess$ for other$, n$ / guess$"
38.             other$ = mr$(n$, "/", guess$)
39.             Print "New other$ "; Mid$(other$, 1, 105)
40.         End If
41.         'Else
42.         '    Exit Do
43.         'End If
44.     Loop
45. Loop
46.  
47. Function mr$ (a$, op$, b$) ' catchy? mr$ for math regulator
48.     Dim ca$, cb$, aSgn$, bSgn$, postOp$, sgn$
49.     Dim adp As Integer, bdp As Integer, dp As Integer, lpop As Integer
50.  
51.     op$ = _Trim$(op$) 'save fixing each time
52.     ca$ = _Trim$(a$): cb$ = _Trim$(b$) 'make copies in case we change
53.     'strip signs and decimals
54.     If Left$(ca$, 1) = "-" Then
55.         aSgn$ = "-": ca$ = Mid$(ca$, 2)
56.     Else
57.         aSgn$ = "": ca$ = ca$
58.     End If
59.     dp = InStr(ca$, ".")
60.     If dp > 0 Then
61.         adp = Len(ca$) - dp
62.         ca$ = Mid$(ca$, 1, dp - 1) + Mid$(ca$, dp + 1)
63.     Else
64.         adp = 0
65.     End If
66.     If Left$(cb$, 1) = "-" Then
67.         bSgn$ = "-": cb$ = Mid$(cb$, 2)
68.     Else
69.         bSgn$ = "": cb$ = cb$
70.     End If
71.     dp = InStr(cb$, ".")
72.     If dp > 0 Then
73.         bdp = Len(cb$) - dp
74.         cb$ = Mid$(cb$, 1, dp - 1) + Mid$(cb$, dp + 1)
75.     Else
76.         bdp = 0
77.     End If
78.  
79.     If op$ = "+" Or op$ = "-" Or op$ = "/" Then 'add or subtr  even up strings on right of decimal
80.         'even up the right sides of decimals if any
81.         If adp > bdp Then dp = adp Else dp = bdp
82.         If adp < dp Then ca$ = ca$ + String$(dp - adp, "0")
83.         If bdp < dp Then cb$ = cb$ + String$(dp - bdp, "0")
84.     ElseIf op$ = "*" Then
85.         dp = adp + bdp
86.     End If
87.     If op$ = "*" Or op$ = "/" Then
88.         If aSgn$ = bSgn$ Then sgn$ = "" Else sgn$ = "-"
89.     End If
90.     'now according to signs and op$ call add$ or subtr$
91.     If op$ = "+" Then
92.         If aSgn$ = bSgn$ Then 'really add
93.             postOp$ = aSgn$ + add$(ca$, cb$)
94.         Else 'have a case of subtraction
95.             If aSgn$ = "-" Then postOp$ = subtr$(cb$, ca$) Else postOp$ = subtr$(ca$, cb$)
96.         End If
97.     ElseIf op$ = "-" Then
98.         If bSgn$ = "-" Then 'really add but switch b sign
99.             bSgn$ = ""
100.             If aSgn$ = "-" Then
101.                 postOp$ = subtr$(cb$, ca$)
102.             Else 'aSgn = ""
103.                 postOp$ = add$(ca$, cb$)
104.             End If
105.         Else 'bSgn$ =""
106.             If aSgn$ = "-" Then
107.                 bSgn$ = "-"
108.                 postOp$ = aSgn$ + add$(ca$, cb$)
109.             Else
110.                 postOp$ = subtr$(ca$, cb$)
111.             End If
112.         End If
113.     ElseIf op$ = "*" Then
114.         postOp$ = sgn$ + mult$(ca$, cb$)
115.     ElseIf op$ = "/" Then
116.         postOp$ = sgn$ + divide$(ca$, cb$)
117.     End If ' which op
118.     'put dp back
119.     If op$ <> "/" Then
120.         lpop = Len(postOp$) ' put decimal back
121.         postOp$ = Mid$(postOp$, 1, lpop - dp) + "." + Mid$(postOp$, lpop - dp + 1)
122.     End If
123.     mr$ = trim0$(postOp$)
124. End Function
125.  
126. Function divide$ (n$, d$) ' goal here is 100 digits precision not 100 digits past decimal
127.     'Print "divide$ got n$ = "; n$; " and d$ = "; d$
128.     Dim di$, ndi$, nD As Integer
129.     If trim0$(n$) = "0" Then divide$ = "0": Exit Function
130.     If trim0$(d$) = "0" Then divide$ = "div 0": Exit Function
131.     If trim0$(d$) = "1" Then divide$ = trim0$(n$): Exit Function '8/17 add trim0$
132.  
133.     ' aha! found a bug when d$ gets really huge 100 is no where near enough!!!!
134.     ' 2021-06-03 fix by adding 100 to len(d$), plus have to go a little past 100 for 100 digit precision
135.     ' need to go past 100 for 100 precise digits (not decimal places)
136.     di$ = Mid$(nInverse$(d$, Len(d$) + 200), 2) 'chop off decimal point after
137.     'Print "divide$ inverse of d$ = di$ = "; di$
138.  
139.     nD = Len(di$)
140.     ndi$ = mult$(n$, di$)
141.     ndi$ = Mid$(ndi$, 1, Len(ndi$) - nD) + "." + Right$(String$(nD, "0") + Right$(ndi$, nD), nD)
142.     divide$ = trim0$(ndi$)
143. End Function
144.  
145. Function nInverse$ (n$, DP As Integer) 'assume decimal at very start of the string of digits returned, no rounding
146.     Dim m$(1 To 9), si$, r$, outstr$, d$
147.     Dim i As Integer
148.     For i = 1 To 9
149.         si$ = _Trim$(Str$(i))
150.         m$(i) = mult$(si$, n$)
151.     Next
152.     outstr$ = ""
153.     If n$ = "0" Then nInverse$ = "Div 0": Exit Function
154.     If n$ = "1" Then nInverse$ = "1": Exit Function
155.     outstr$ = "." 'everything else n > 1 is decimal 8/17
156.     r$ = "10"
157.     Do
158.         While Left$(subtr$(r$, n$), 1) = "-" '   r - n < 0
159.             outstr$ = outstr$ + "0" '            add 0 to the  output string
160.             If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function 'check if we've reached DP length
161.             r$ = r$ + "0"
162.         Wend
163.         For i = 9 To 1 Step -1
164.             If LTE(m$(i), r$) Then d$ = _Trim$(Str$(i)): Exit For
165.         Next
166.         outstr$ = outstr$ + d$
167.         If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function
168.         r$ = subtr$(r$, mult$(d$, n$)) 'r = r -d*n
169.         If r$ = "0" Then nInverse$ = outstr$: Exit Function 'found a perfect divisor
170.         r$ = r$ + "0" 'add another place
171.     Loop
172. End Function
173.  
174. Function mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
175.     Dim la As Integer, lb As Integer, m As Integer, g As Integer, dp As Integer
176.     Dim v18 As _Unsigned _Integer64, sd As _Unsigned _Integer64, co As _Unsigned _Integer64
177.     Dim f18$, f1$, t$, build$, accum$
178.  
179.     If trim0$(a$) = "0" Then mult$ = "0": Exit Function
180.     If trim0$(b$) = "0" Then mult$ = "0": Exit Function
181.     If trim0$(a$) = "1" Then mult$ = trim0$(b$): Exit Function
182.     If trim0$(b$) = "1" Then mult$ = trim0$(a$): Exit Function
183.     'find the longer number and make it a mult of 18 to take 18 digits at a time from it
184.     la = Len(a$): lb = Len(b$)
185.     If la > lb Then
186.         m = Int(la / 18) + 1
187.         f18$ = Right$(String$(m * 18, "0") + a$, m * 18)
188.         f1$ = b$
189.     Else
190.         m = Int(lb / 18) + 1
191.         f18$ = Right$(String$(m * 18, "0") + b$, m * 18)
192.         f1$ = a$
193.     End If
194.     For dp = Len(f1$) To 1 Step -1 'dp = digit position of the f1$
195.         build$ = "" 'line builder
196.         co = 0
197.         'now taking 18 digits at a time Thanks Steve McNeill
198.         For g = 1 To m
199.             v18 = Val(Mid$(f18$, m * 18 - g * 18 + 1, 18))
200.             sd = Val(Mid$(f1$, dp, 1))
201.             t$ = Right$(String$(19, "0") + _Trim$(Str$(v18 * sd + co)), 19)
202.             co = Val(Mid$(t$, 1, 1))
203.             build$ = Mid$(t$, 2) + build$
204.         Next g
205.         If co Then build$ = _Trim$(Str$(co)) + build$
206.         If dp = Len(f1$) Then
207.             accum$ = build$
208.         Else
209.             accum$ = add$(accum$, build$ + String$(Len(f1$) - dp, "0"))
210.         End If
211.     Next dp
212.     mult$ = accum$
213. End Function
214.  
215. Function subtr$ (sum$, minus$) ' assume both numbers are positive all digits
216.     Dim m As Integer, g As Integer, p As Integer
217.     Dim VB As _Unsigned _Integer64, vs As _Unsigned _Integer64, tenE18 As _Unsigned _Integer64
218.     Dim ts$, tm$, sign$, LG$, sm$, t$, result$
219.  
220.     ts$ = TrimLead0$(sum$): tm$ = TrimLead0$(minus$)
221.     If trim0(ts$) = trim0$(tm$) Then subtr$ = "0": Exit Function 'OK proceed with function knowing they are not equal
222.     tenE18 = 1000000000000000000 'yes!!! no dang E's
223.     If LTE(ts$, tm$) Then ' which is bigger? minus is bigger
224.         sign$ = "-"
225.         m = Int(Len(tm$) / 18) + 1
226.         LG$ = Right$(String$(m * 18, "0") + tm$, m * 18)
227.         sm$ = Right$(String$(m * 18, "0") + ts$, m * 18)
228.     Else 'sum is bigger
229.         sign$ = ""
230.         m = Int(Len(ts$) / 18) + 1
231.         LG$ = Right$(String$(m * 18, "0") + ts$, m * 18)
232.         sm$ = Right$(String$(m * 18, "0") + tm$, m * 18)
233.     End If
234.     'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
235.     For g = 1 To m
236.         VB = Val(Mid$(LG$, m * 18 - g * 18 + 1, 18))
237.         vs = Val(Mid$(sm$, m * 18 - g * 18 + 1, 18))
238.         If vs > VB Then
239.             t$ = Right$(String$(18, "0") + _Trim$(Str$(tenE18 - vs + VB)), 18)
240.             p = (m - g) * 18
241.             While p > 0 And Mid$(LG$, p, 1) = "0"
242.                 Mid$(LG$, p, 1) = "9"
243.                 p = p - 1
244.             Wend
245.             If p > 0 Then Mid$(LG$, p, 1) = _Trim$(Str$(Val(Mid$(LG$, p, 1)) - 1))
246.         Else
247.             t$ = Right$(String$(18, "0") + _Trim$(Str$(VB - vs)), 18)
248.         End If
249.         result$ = t$ + result$
250.     Next
251.     subtr$ = sign$ + result$
252. End Function
253.  
254. Function add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
255.     'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
256.     Dim la As Integer, lb As Integer, m As Integer, g As Integer
257.     Dim sa As _Unsigned _Integer64, sb As _Unsigned _Integer64, co As _Unsigned _Integer64
258.     Dim fa$, fb$, t$, new$, result$
259.     la = Len(a$): lb = Len(b$)
260.     If la > lb Then m = Int(la / 18) + 1 Else m = Int(lb / 18) + 1
261.     fa$ = Right$(String$(m * 18, "0") + a$, m * 18)
262.     fb$ = Right$(String$(m * 18, "0") + b$, m * 18)
263.  
264.     'now taking 18 digits at a time Thanks Steve McNeill
265.     For g = 1 To m
266.         sa = Val(Mid$(fa$, m * 18 - g * 18 + 1, 18))
267.         sb = Val(Mid$(fb$, m * 18 - g * 18 + 1, 18))
268.         t$ = Right$(String$(36, "0") + _Trim$(Str$(sa + sb + co)), 36)
269.         co = Val(Mid$(t$, 1, 18))
270.         new$ = Mid$(t$, 19)
271.         result$ = new$ + result$
272.     Next
273.     If co Then result$ = Str$(co) + result$
274.     add$ = result$
275. End Function
276.  
277. ' String Math Helpers -----------------------------------------------
278.  
279. 'this function needs TrimLead0$(s$)
280. Function LTE (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings, For Integers Only!
281.     Dim ca$, cb$, la As Integer, lb As Integer, i As Integer
282.     ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
283.     la = Len(ca$): lb = Len(cb$)
284.     If ca$ = cb$ Then
285.         LTE = -1
286.     ElseIf la < lb Then ' a is smaller
287.         LTE = -1
288.     ElseIf la > lb Then ' a is bigger
289.         LTE = 0
290.     ElseIf la = lb Then ' equal lengths
291.         For i = 1 To Len(ca$)
292.             If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
293.                 LTE = 0: Exit Function
294.             ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
295.                 LTE = -1: Exit Function
296.             End If
297.         Next
298.     End If
299. End Function
300.  
301. ' ------------------------------------- use these for final display
302.  
303. Function TrimLead0$ (s$) 'for treating strings as number (pos integers)
304.     Dim copys$, i As Integer, find As Integer
305.     copys$ = _Trim$(s$) 'might as well remove spaces too
306.     i = 1: find = 0
307.     While i < Len(copys$) And Mid$(copys$, i, 1) = "0"
308.         i = i + 1: find = 1
309.     Wend
310.     If find = 1 Then copys$ = Mid$(copys$, i)
311.     If copys$ = "" Then TrimLead0$ = "0" Else TrimLead0$ = copys$
312. End Function
313.  
314. Function TrimTail0$ (s$)
315.     Dim copys$, dp As Integer, i As Integer, find As Integer
316.     copys$ = _Trim$(s$) 'might as well remove spaces too
317.     TrimTail0$ = copys$
318.     dp = InStr(copys$, ".")
319.     If dp > 0 Then
320.         i = Len(copys$): find = 0
321.         While i > dp And Mid$(copys$, i, 1) = "0"
322.             i = i - 1: find = 1
323.         Wend
324.         If find = 1 Then
325.             If i = dp Then
326.                 TrimTail0$ = Mid$(copys$, 1, dp - 1)
327.             Else
328.                 TrimTail0$ = Mid$(copys$, 1, i)
329.             End If
330.         End If
331.     End If
332. End Function
333.  
334. Function trim0$ (s$)
335.     Dim cs$, si$
336.     cs$ = s$
337.     si$ = Left$(cs$, 1)
338.     If si$ = "-" Then cs$ = Mid$(cs$, 2)
339.     cs$ = TrimLead0$(cs$)
340.     cs$ = TrimTail0$(cs$)
341.     If Right$(cs$, 1) = "." Then cs$ = Mid$(cs$, 1, Len(cs$) - 1)
342.     If si$ = "-" Then trim0$ = si$ + cs$ Else trim0$ = cs$
343. End Function
344.  
345. ' for displaying truncated numbers say to 60 digits
346. Function showDP$ (num$, nDP As Integer)
347.     Dim cNum$, dp As Integer, d As Integer, i As Integer
348.     cNum$ = num$ 'since num$ could get changed
349.     showDP$ = num$
350.     dp = InStr(num$, ".")
351.     If dp > 0 Then
352.         If Len(Mid$(cNum$, dp + 1)) > nDP Then
353.             d = Val(Mid$(cNum$, dp + nDP + 1, 1))
354.             If d > 4 Then
355.                 cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
356.                 dp = dp + 1
357.                 i = dp + nDP
358.                 While Mid$(cNum$, i, 1) = "9" Or Mid$(cNum$, i, 1) = "."
359.                     If Mid$(cNum$, i, 1) = "9" Then
360.                         Mid$(cNum$, i, 1) = "0"
361.                     End If
362.                     i = i - 1
363.                 Wend
364.                 Mid$(cNum$, i, 1) = _Trim$(Str$(Val(Mid$(cNum$, i, 1)) + 1)) 'last non 9 digit
365.                 cNum$ = Mid$(cNum$, 1, dp + nDP) 'chop it
366.                 showDP$ = trim0$(cNum$)
367.             Else
368.                 showDP$ = Mid$(cNum$, 1, dp + nDP)
369.             End If
370.         End If
371.     End If
372. End Function
373.  

Going back to oh to replace the Divide$ function there.

Here is a list of compares between Square Root from above code and an Internet Calculator (that rounds it's last digit in decimal place, whereas this code cuts off at that digit # not decimal place.)

Code: [Select]

First show code clipboard result then show Internet Calculator result
from https://www.mathsisfun.com/calculator-precision.html

Square root 2 first from String Math then Internet Result 
1.414213562373095048801688724209698078569671875376948073176679737990732478462107038850387534327641572
1.4142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727

Square root of 3...
1.732050807568877293527446341505872366942805253810380628055806979451933016908800037081146186757248575
1.7320508075688772935274463415058723669428052538103806280558069794519330169088000370811461867572485757

Square root of 4...
gets stuck in infinite loop 1.999999999999999999999999....   
2 of course!

OK compare guess to last guess and if they match out to 105 digits then 100 digits must be accurate
1.999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999
2 of course!

SR 5
2.236067977499789696409173668731276235440618359611525724270897245410520925637804899414414408378782274
2.23606797749978969640917366873127623544061835961152572427089724541052092563780489941441440837878227497

SR 6
2.449489742783178098197284074705891391965947480656670128432692567250960377457315026539859433104640234
2.44948974278317809819728407470589139196594748065667012843269256725096037745731502653985943310464023482

SR 7
2.645751311064590590501615753639260425710259183082450180368334459201068823230283627760392886474543610
2.64575131106459059050161575363926042571025918308245018036833445920106882323028362776039288647454361062


[George McGinn]

I will post it here again, but my square root function gives you the correct answer.

I use the  The Newton-Raphson Iteration method to calculate the square root as well as the n'th roots (see link: https://secure.math.ubc.ca/~anstee/math104/104newtonmethod.pdf).

It is more accurate than your "best answer."

Here is the code to execute this method:

Code: QB64: [Select]

1. DIM SHARED result AS STRING
2. DIM SHARED x AS DOUBLE
3. DIM SHARED A AS DOUBLE
4.  
5. DECLARE FUNCTION root_2 (A)
6. DECLARE FUNCTION root_n (A, n)
7.  
8. '*** square root function
9. A = 4503599627370496: r = root_2(A): PRINT "square root of "; A; " equals "; result
10. A = 125: r = root_2(A): PRINT "square root of "; A; " equals "; result
11. A = 100: r = root_2(A): PRINT "square root of "; A; " equals "; result
12. PRINT
13.  
14.  
15. FUNCTION root_2 (A AS DOUBLE)
16.     x = A / 2: precision = 0.000001: max_iterations = 30
17.     FOR i = 1 TO max_iterations
18.         dx = (x - A / x) / 2: x = x - dx
19.         IF ABS(dx) < precision THEN i = max_iterations
20.     NEXT i
21.     result = STR$(x)
22. END FUNCTION

Attempting to extend String Math into Square Roots, I discovered a huge bug with Divide$ Function, it's all commented in code below. I think I have it patched but maybe not. This is tricky without Boolean Compares for String Math.

Main code is testing a 100 digit precision Square Root Code and Divide$ has the "fixed"? String Math patch

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Math regulator mr test sqr estimating" ' b+ start 2021-06-02
3. Randomize Timer 'now that it's seems to be running silent
4. Screen _NewImage(1200, 700, 32)
5. _Delay .25
6. _ScreenMove _Middle
7.  
8. Dim n$, guess$, other$, cont$, sum$, loopCnt, lastGuess$
9. Do
10.     'remember everything is strings
11.     Input "Enter a number to find it's square root "; n$
12.     If n$ = "" Then End
13.     guess$ = mr$(n$, "/", "2") ' for n$ = 2
14.     other$ = n$
15.     loopCnt = 0
16.     Do
17.         loopCnt = loopCnt + 1
18.         Print loopCnt; " guess: "; guess$
19.         'Input "Continue press enter, any other to quit "; cont$
20.         'If cont$ = "" Then
21.         If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then ' go past 100 matching digits for 100 digit precision
22.             Print
23.             Print "100 digits precision goal, not 100 digits past decimal: Square root of "; n$; " is:"
24.             Print Mid$(guess$, 1, 101) ' one char for decimal
25.             _Clipboard$ = Mid$(guess$, 1, 101) ' ditto
26.             Print
27.             Exit Do
28.         Else
29.             lastGuess$ = guess$
30.             'Print "guess$ "; guess$
31.             'Print "other$ "; other$
32.             sum$ = mr$(guess$, "+", other$)
33.             'Print "sum$ "; sum$
34.             'Print "Call divide for guess$, sum$ / 2"
35.             guess$ = mr$(sum$, "/", "2")
36.             Print "New guess$ "; Mid$(guess$, 1, 105)
37.             'Print "Call n$ divide  new guess$ for other$, n$ / guess$"
38.             other$ = mr$(n$, "/", guess$)
39.             Print "New other$ "; Mid$(other$, 1, 105)
40.         End If
41.         'Else
42.         '    Exit Do
43.         'End If
44.     Loop
45. Loop
46.  
47. Function mr$ (a$, op$, b$) ' catchy? mr$ for math regulator
48.     Dim ca$, cb$, aSgn$, bSgn$, postOp$, sgn$
49.     Dim adp As Integer, bdp As Integer, dp As Integer, lpop As Integer
50.  
51.     op$ = _Trim$(op$) 'save fixing each time
52.     ca$ = _Trim$(a$): cb$ = _Trim$(b$) 'make copies in case we change
53.     'strip signs and decimals
54.     If Left$(ca$, 1) = "-" Then
55.         aSgn$ = "-": ca$ = Mid$(ca$, 2)
56.     Else
57.         aSgn$ = "": ca$ = ca$
58.     End If
59.     dp = InStr(ca$, ".")
60.     If dp > 0 Then
61.         adp = Len(ca$) - dp
62.         ca$ = Mid$(ca$, 1, dp - 1) + Mid$(ca$, dp + 1)
63.     Else
64.         adp = 0
65.     End If
66.     If Left$(cb$, 1) = "-" Then
67.         bSgn$ = "-": cb$ = Mid$(cb$, 2)
68.     Else
69.         bSgn$ = "": cb$ = cb$
70.     End If
71.     dp = InStr(cb$, ".")
72.     If dp > 0 Then
73.         bdp = Len(cb$) - dp
74.         cb$ = Mid$(cb$, 1, dp - 1) + Mid$(cb$, dp + 1)
75.     Else
76.         bdp = 0
77.     End If
78.  
79.     If op$ = "+" Or op$ = "-" Or op$ = "/" Then 'add or subtr  even up strings on right of decimal
80.         'even up the right sides of decimals if any
81.         If adp > bdp Then dp = adp Else dp = bdp
82.         If adp < dp Then ca$ = ca$ + String$(dp - adp, "0")
83.         If bdp < dp Then cb$ = cb$ + String$(dp - bdp, "0")
84.     ElseIf op$ = "*" Then
85.         dp = adp + bdp
86.     End If
87.     If op$ = "*" Or op$ = "/" Then
88.         If aSgn$ = bSgn$ Then sgn$ = "" Else sgn$ = "-"
89.     End If
90.     'now according to signs and op$ call add$ or subtr$
91.     If op$ = "+" Then
92.         If aSgn$ = bSgn$ Then 'really add
93.             postOp$ = aSgn$ + add$(ca$, cb$)
94.         Else 'have a case of subtraction
95.             If aSgn$ = "-" Then postOp$ = subtr$(cb$, ca$) Else postOp$ = subtr$(ca$, cb$)
96.         End If
97.     ElseIf op$ = "-" Then
98.         If bSgn$ = "-" Then 'really add but switch b sign
99.             bSgn$ = ""
100.             If aSgn$ = "-" Then
101.                 postOp$ = subtr$(cb$, ca$)
102.             Else 'aSgn = ""
103.                 postOp$ = add$(ca$, cb$)
104.             End If
105.         Else 'bSgn$ =""
106.             If aSgn$ = "-" Then
107.                 bSgn$ = "-"
108.                 postOp$ = aSgn$ + add$(ca$, cb$)
109.             Else
110.                 postOp$ = subtr$(ca$, cb$)
111.             End If
112.         End If
113.     ElseIf op$ = "*" Then
114.         postOp$ = sgn$ + mult$(ca$, cb$)
115.     ElseIf op$ = "/" Then
116.         postOp$ = sgn$ + divide$(ca$, cb$)
117.     End If ' which op
118.     'put dp back
119.     If op$ <> "/" Then
120.         lpop = Len(postOp$) ' put decimal back
121.         postOp$ = Mid$(postOp$, 1, lpop - dp) + "." + Mid$(postOp$, lpop - dp + 1)
122.     End If
123.     mr$ = trim0$(postOp$)
124. End Function
125.  
126. Function divide$ (n$, d$) ' goal here is 100 digits precision not 100 digits past decimal
127.     'Print "divide$ got n$ = "; n$; " and d$ = "; d$
128.     Dim di$, ndi$, nD As Integer
129.     If trim0$(n$) = "0" Then divide$ = "0": Exit Function
130.     If trim0$(d$) = "0" Then divide$ = "div 0": Exit Function
131.     If trim0$(d$) = "1" Then divide$ = trim0$(n$): Exit Function '8/17 add trim0$
132.  
133.     ' aha! found a bug when d$ gets really huge 100 is no where near enough!!!!
134.     ' 2021-06-03 fix by adding 100 to len(d$), plus have to go a little past 100 for 100 digit precision
135.     ' need to go past 100 for 100 precise digits (not decimal places)
136.     di$ = Mid$(nInverse$(d$, Len(d$) + 200), 2) 'chop off decimal point after
137.     'Print "divide$ inverse of d$ = di$ = "; di$
138.  
139.     nD = Len(di$)
140.     ndi$ = mult$(n$, di$)
141.     ndi$ = Mid$(ndi$, 1, Len(ndi$) - nD) + "." + Right$(String$(nD, "0") + Right$(ndi$, nD), nD)
142.     divide$ = trim0$(ndi$)
143. End Function
144.  
145. Function nInverse$ (n$, DP As Integer) 'assume decimal at very start of the string of digits returned, no rounding
146.     Dim m$(1 To 9), si$, r$, outstr$, d$
147.     Dim i As Integer
148.     For i = 1 To 9
149.         si$ = _Trim$(Str$(i))
150.         m$(i) = mult$(si$, n$)
151.     Next
152.     outstr$ = ""
153.     If n$ = "0" Then nInverse$ = "Div 0": Exit Function
154.     If n$ = "1" Then nInverse$ = "1": Exit Function
155.     outstr$ = "." 'everything else n > 1 is decimal 8/17
156.     r$ = "10"
157.     Do
158.         While Left$(subtr$(r$, n$), 1) = "-" '   r - n < 0
159.             outstr$ = outstr$ + "0" '            add 0 to the  output string
160.             If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function 'check if we've reached DP length
161.             r$ = r$ + "0"
162.         Wend
163.         For i = 9 To 1 Step -1
164.             If LTE(m$(i), r$) Then d$ = _Trim$(Str$(i)): Exit For
165.         Next
166.         outstr$ = outstr$ + d$
167.         If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function
168.         r$ = subtr$(r$, mult$(d$, n$)) 'r = r -d*n
169.         If r$ = "0" Then nInverse$ = outstr$: Exit Function 'found a perfect divisor
170.         r$ = r$ + "0" 'add another place
171.     Loop
172. End Function
173.  
174. Function mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
175.     Dim la As Integer, lb As Integer, m As Integer, g As Integer, dp As Integer
176.     Dim v18 As _Unsigned _Integer64, sd As _Unsigned _Integer64, co As _Unsigned _Integer64
177.     Dim f18$, f1$, t$, build$, accum$
178.  
179.     If trim0$(a$) = "0" Then mult$ = "0": Exit Function
180.     If trim0$(b$) = "0" Then mult$ = "0": Exit Function
181.     If trim0$(a$) = "1" Then mult$ = trim0$(b$): Exit Function
182.     If trim0$(b$) = "1" Then mult$ = trim0$(a$): Exit Function
183.     'find the longer number and make it a mult of 18 to take 18 digits at a time from it
184.     la = Len(a$): lb = Len(b$)
185.     If la > lb Then
186.         m = Int(la / 18) + 1
187.         f18$ = Right$(String$(m * 18, "0") + a$, m * 18)
188.         f1$ = b$
189.     Else
190.         m = Int(lb / 18) + 1
191.         f18$ = Right$(String$(m * 18, "0") + b$, m * 18)
192.         f1$ = a$
193.     End If
194.     For dp = Len(f1$) To 1 Step -1 'dp = digit position of the f1$
195.         build$ = "" 'line builder
196.         co = 0
197.         'now taking 18 digits at a time Thanks Steve McNeill
198.         For g = 1 To m
199.             v18 = Val(Mid$(f18$, m * 18 - g * 18 + 1, 18))
200.             sd = Val(Mid$(f1$, dp, 1))
201.             t$ = Right$(String$(19, "0") + _Trim$(Str$(v18 * sd + co)), 19)
202.             co = Val(Mid$(t$, 1, 1))
203.             build$ = Mid$(t$, 2) + build$
204.         Next g
205.         If co Then build$ = _Trim$(Str$(co)) + build$
206.         If dp = Len(f1$) Then
207.             accum$ = build$
208.         Else
209.             accum$ = add$(accum$, build$ + String$(Len(f1$) - dp, "0"))
210.         End If
211.     Next dp
212.     mult$ = accum$
213. End Function
214.  
215. Function subtr$ (sum$, minus$) ' assume both numbers are positive all digits
216.     Dim m As Integer, g As Integer, p As Integer
217.     Dim VB As _Unsigned _Integer64, vs As _Unsigned _Integer64, tenE18 As _Unsigned _Integer64
218.     Dim ts$, tm$, sign$, LG$, sm$, t$, result$
219.  
220.     ts$ = TrimLead0$(sum$): tm$ = TrimLead0$(minus$)
221.     If trim0(ts$) = trim0$(tm$) Then subtr$ = "0": Exit Function 'OK proceed with function knowing they are not equal
222.     tenE18 = 1000000000000000000 'yes!!! no dang E's
223.     If LTE(ts$, tm$) Then ' which is bigger? minus is bigger
224.         sign$ = "-"
225.         m = Int(Len(tm$) / 18) + 1
226.         LG$ = Right$(String$(m * 18, "0") + tm$, m * 18)
227.         sm$ = Right$(String$(m * 18, "0") + ts$, m * 18)
228.     Else 'sum is bigger
229.         sign$ = ""
230.         m = Int(Len(ts$) / 18) + 1
231.         LG$ = Right$(String$(m * 18, "0") + ts$, m * 18)
232.         sm$ = Right$(String$(m * 18, "0") + tm$, m * 18)
233.     End If
234.     'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
235.     For g = 1 To m
236.         VB = Val(Mid$(LG$, m * 18 - g * 18 + 1, 18))
237.         vs = Val(Mid$(sm$, m * 18 - g * 18 + 1, 18))
238.         If vs > VB Then
239.             t$ = Right$(String$(18, "0") + _Trim$(Str$(tenE18 - vs + VB)), 18)
240.             p = (m - g) * 18
241.             While p > 0 And Mid$(LG$, p, 1) = "0"
242.                 Mid$(LG$, p, 1) = "9"
243.                 p = p - 1
244.             Wend
245.             If p > 0 Then Mid$(LG$, p, 1) = _Trim$(Str$(Val(Mid$(LG$, p, 1)) - 1))
246.         Else
247.             t$ = Right$(String$(18, "0") + _Trim$(Str$(VB - vs)), 18)
248.         End If
249.         result$ = t$ + result$
250.     Next
251.     subtr$ = sign$ + result$
252. End Function
253.  
254. Function add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
255.     'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
256.     Dim la As Integer, lb As Integer, m As Integer, g As Integer
257.     Dim sa As _Unsigned _Integer64, sb As _Unsigned _Integer64, co As _Unsigned _Integer64
258.     Dim fa$, fb$, t$, new$, result$
259.     la = Len(a$): lb = Len(b$)
260.     If la > lb Then m = Int(la / 18) + 1 Else m = Int(lb / 18) + 1
261.     fa$ = Right$(String$(m * 18, "0") + a$, m * 18)
262.     fb$ = Right$(String$(m * 18, "0") + b$, m * 18)
263.  
264.     'now taking 18 digits at a time Thanks Steve McNeill
265.     For g = 1 To m
266.         sa = Val(Mid$(fa$, m * 18 - g * 18 + 1, 18))
267.         sb = Val(Mid$(fb$, m * 18 - g * 18 + 1, 18))
268.         t$ = Right$(String$(36, "0") + _Trim$(Str$(sa + sb + co)), 36)
269.         co = Val(Mid$(t$, 1, 18))
270.         new$ = Mid$(t$, 19)
271.         result$ = new$ + result$
272.     Next
273.     If co Then result$ = Str$(co) + result$
274.     add$ = result$
275. End Function
276.  
277. ' String Math Helpers -----------------------------------------------
278.  
279. 'this function needs TrimLead0$(s$)
280. Function LTE (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings, For Integers Only!
281.     Dim ca$, cb$, la As Integer, lb As Integer, i As Integer
282.     ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
283.     la = Len(ca$): lb = Len(cb$)
284.     If ca$ = cb$ Then
285.         LTE = -1
286.     ElseIf la < lb Then ' a is smaller
287.         LTE = -1
288.     ElseIf la > lb Then ' a is bigger
289.         LTE = 0
290.     ElseIf la = lb Then ' equal lengths
291.         For i = 1 To Len(ca$)
292.             If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
293.                 LTE = 0: Exit Function
294.             ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
295.                 LTE = -1: Exit Function
296.             End If
297.         Next
298.     End If
299. End Function
300.  
301. ' ------------------------------------- use these for final display
302.  
303. Function TrimLead0$ (s$) 'for treating strings as number (pos integers)
304.     Dim copys$, i As Integer, find As Integer
305.     copys$ = _Trim$(s$) 'might as well remove spaces too
306.     i = 1: find = 0
307.     While i < Len(copys$) And Mid$(copys$, i, 1) = "0"
308.         i = i + 1: find = 1
309.     Wend
310.     If find = 1 Then copys$ = Mid$(copys$, i)
311.     If copys$ = "" Then TrimLead0$ = "0" Else TrimLead0$ = copys$
312. End Function
313.  
314. Function TrimTail0$ (s$)
315.     Dim copys$, dp As Integer, i As Integer, find As Integer
316.     copys$ = _Trim$(s$) 'might as well remove spaces too
317.     TrimTail0$ = copys$
318.     dp = InStr(copys$, ".")
319.     If dp > 0 Then
320.         i = Len(copys$): find = 0
321.         While i > dp And Mid$(copys$, i, 1) = "0"
322.             i = i - 1: find = 1
323.         Wend
324.         If find = 1 Then
325.             If i = dp Then
326.                 TrimTail0$ = Mid$(copys$, 1, dp - 1)
327.             Else
328.                 TrimTail0$ = Mid$(copys$, 1, i)
329.             End If
330.         End If
331.     End If
332. End Function
333.  
334. Function trim0$ (s$)
335.     Dim cs$, si$
336.     cs$ = s$
337.     si$ = Left$(cs$, 1)
338.     If si$ = "-" Then cs$ = Mid$(cs$, 2)
339.     cs$ = TrimLead0$(cs$)
340.     cs$ = TrimTail0$(cs$)
341.     If Right$(cs$, 1) = "." Then cs$ = Mid$(cs$, 1, Len(cs$) - 1)
342.     If si$ = "-" Then trim0$ = si$ + cs$ Else trim0$ = cs$
343. End Function
344.  
345. ' for displaying truncated numbers say to 60 digits
346. Function showDP$ (num$, nDP As Integer)
347.     Dim cNum$, dp As Integer, d As Integer, i As Integer
348.     cNum$ = num$ 'since num$ could get changed
349.     showDP$ = num$
350.     dp = InStr(num$, ".")
351.     If dp > 0 Then
352.         If Len(Mid$(cNum$, dp + 1)) > nDP Then
353.             d = Val(Mid$(cNum$, dp + nDP + 1, 1))
354.             If d > 4 Then
355.                 cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
356.                 dp = dp + 1
357.                 i = dp + nDP
358.                 While Mid$(cNum$, i, 1) = "9" Or Mid$(cNum$, i, 1) = "."
359.                     If Mid$(cNum$, i, 1) = "9" Then
360.                         Mid$(cNum$, i, 1) = "0"
361.                     End If
362.                     i = i - 1
363.                 Wend
364.                 Mid$(cNum$, i, 1) = _Trim$(Str$(Val(Mid$(cNum$, i, 1)) + 1)) 'last non 9 digit
365.                 cNum$ = Mid$(cNum$, 1, dp + nDP) 'chop it
366.                 showDP$ = trim0$(cNum$)
367.             Else
368.                 showDP$ = Mid$(cNum$, 1, dp + nDP)
369.             End If
370.         End If
371.     End If
372. End Function
373.  

Going back to oh to replace the Divide$ function there.

Here is a list of compares between Square Root from above code and an Internet Calculator (that rounds it's last digit in decimal place, whereas this code cuts off at that digit # not decimal place.)

Code: [Select]

First show code clipboard result then show Internet Calculator result
from https://www.mathsisfun.com/calculator-precision.html

Square root 2 first from String Math then Internet Result 
1.414213562373095048801688724209698078569671875376948073176679737990732478462107038850387534327641572
1.4142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727

Square root of 3...
1.732050807568877293527446341505872366942805253810380628055806979451933016908800037081146186757248575
1.7320508075688772935274463415058723669428052538103806280558069794519330169088000370811461867572485757

Square root of 4...
gets stuck in infinite loop 1.999999999999999999999999....   
2 of course!

OK compare guess to last guess and if they match out to 105 digits then 100 digits must be accurate
1.999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999
2 of course!

SR 5
2.236067977499789696409173668731276235440618359611525724270897245410520925637804899414414408378782274
2.23606797749978969640917366873127623544061835961152572427089724541052092563780489941441440837878227497

SR 6
2.449489742783178098197284074705891391965947480656670128432692567250960377457315026539859433104640234
2.44948974278317809819728407470589139196594748065667012843269256725096037745731502653985943310464023482

SR 7
2.645751311064590590501615753639260425710259183082450180368334459201068823230283627760392886474543610
2.64575131106459059050161575363926042571025918308245018036833445920106882323028362776039288647454361062


[jack]

hi bplus
here's some interesting code that if you manage to translate to QB64 might be useful as a first approximation for the Newton-Raphson Method
this is FreeBbasic code but the code is very short and the algorithm is explained in comments

Code: [Select]

'=======================================================================
' approximate a ^ b
Function approx_power( Byval a As Double, Byval b As Double ) As Double
    Dim As Long Ptr fp = 1 + Cptr( Long Ptr, @a )
    Dim As Long tmp = ( *fp - 1072632447 ) * b
    *fp = tmp + 1072632447
    Return a
End Function

'=======================================================================
' How and Why It Works.
' To accurately compute  y = a^b;  for non-integer b;  with a > 0;
'   take the log(a), multiply it by b, then look up the antilog, which is
'   the Exp() function, to give; y = Exp( b * Log( a ) )
' For a computer using base 2 it is convenient to use; y = 2^( b * Log2(a) )
' The IEEE double precision floating point format has an 11 bit, base two,
'   integer exponent. That will become the integer part of the log2(x) function.
'   It is simple to extract the exponent, multiply it by b, then return it to
'   the exponent, but that would be a clunky approximation because the exponent
'   is an integer count of powers of two with poor resolution.
' So that the multiply will change the result for small changes of a or power b,
'   the leading 20 mantissa bits are included as a false fractional extension to
'   the logarithmic exponent. That is the source of error in this approximation.
'   Note that the implicit 1 msb is missing from the mantissa.
' The exponent offset bias of 1022 must be removed by subtraction before the
'   multiplication. In the same operation an amount can be deducted from the
'   mantissa to significantly reduce the approximation error. The approximation
'   is computed from only the top 32 bits of the 64 bit double precision format.
' &bSeeeeeeeeeeeffffffffffffffffffff  Sign bit, exponent and fraction format
' &b00111111111000000000000000000000    1071644672 = 1022 * 2^20, shifted bias
' &b00000000000011110001001001111111        987775 = fudge amount
' &b00111111111011110001001001111111    1072632447 = sum is the magic number
'=======================================================================
dim as double x, y, z

Print approx_power( 123.456789, .5 ), sqr(123.456789)
here's the QB64 version

Code: QB64: [Select]

1. Declare CustomType Library
2.     Sub memcpy (ByVal dest As _Offset, Byval source As _Offset, Byval bytes As Long)
3. End Declare
4.  
5.  
6. Print approx_power(20000, .5#), Sqr(20000#)
7.  
8. Function approx_power# (x#, y#)
9.     Dim As Double a
10.     Dim As Long tmp
11.     a = x#
12.     memcpy _Offset(tmp), _Offset(a) + 4, 4
13.     tmp = (tmp - 1072632447) * y#
14.     tmp = tmp + 1072632447
15.     memcpy _Offset(a) + 4, _Offset(tmp), 4
16.     approx_power = a
17. End Function
18.  

all that's needed is to add the Newton-Raphson code, for reciprocal powers of integers it should give a fast approximation

[bplus]

Oh I see while I was making tiny improvements, @GeorgeMcGinn and @jack have suggested more.
OK I see you both like Newton-Raphson, I've see it like 50 years ago in math class so must be better. I will try and work it that way then.

In meantime I've chosen other$ to return with function because sometimes it nails the answer precisely without a bunch of .99999999's on end, not always but less than guess$. I am also handling negative numbers by tacking on an *i to the end of the number returned, better than error message, maybe.

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Math regulator mr test sqr estimating" ' b+ start 2021-06-02
3. ' divide$ found fix? 2021-06-03 comment in that function
4. ' 2021-06-03 update with new sqrRoot$ Function
5.  
6. Randomize Timer 'now that it's seems to be running silent
7. Screen _NewImage(1200, 700, 32)
8. _Delay .25
9. _ScreenMove _Middle
10.  
11. Dim n$, result$
12. Do
13.     'remember everything is strings
14.     Input "Enter a number to find it's square root "; n$
15.     If n$ = "" Then End
16.     result$ = sqrRoot$(n$)
17.     Print result$
18.     Print "Length ="; Len(result$)
19.     Print
20. Loop
21.  
22. Function sqrRoot$ (nmbr$)
23.     Dim n$, guess$, lastGuess$, other$, sum$, imaginary$
24.     If Left$(nmbr$, 1) = "-" Then 'handle neg numbers
25.         imaginary$ = "*i": n$ = Mid$(nmbr$, 2)
26.     Else
27.         imaginary$ = "": n$ = nmbr$
28.     End If
29.     guess$ = mr$(n$, "/", "2")
30.     other$ = n$
31.     Do
32.         If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then ' go past 100 matching digits for 100 digit precision
33.             sqrRoot$ = Mid$(other$, 1, 101) + imaginary$
34.             Exit Function
35.         Else
36.             lastGuess$ = guess$
37.             sum$ = mr$(guess$, "+", other$)
38.             guess$ = mr$(sum$, "/", "2")
39.             other$ = mr$(n$, "/", guess$)
40.         End If
41.     Loop
42. End Function
43.  
44. Function mr$ (a$, op$, b$) ' catchy? mr$ for math regulator
45.     Dim ca$, cb$, aSgn$, bSgn$, postOp$, sgn$
46.     Dim adp As Integer, bdp As Integer, dp As Integer, lpop As Integer
47.  
48.     op$ = _Trim$(op$) 'save fixing each time
49.     ca$ = _Trim$(a$): cb$ = _Trim$(b$) 'make copies in case we change
50.     'strip signs and decimals
51.     If Left$(ca$, 1) = "-" Then
52.         aSgn$ = "-": ca$ = Mid$(ca$, 2)
53.     Else
54.         aSgn$ = "": ca$ = ca$
55.     End If
56.     dp = InStr(ca$, ".")
57.     If dp > 0 Then
58.         adp = Len(ca$) - dp
59.         ca$ = Mid$(ca$, 1, dp - 1) + Mid$(ca$, dp + 1)
60.     Else
61.         adp = 0
62.     End If
63.     If Left$(cb$, 1) = "-" Then
64.         bSgn$ = "-": cb$ = Mid$(cb$, 2)
65.     Else
66.         bSgn$ = "": cb$ = cb$
67.     End If
68.     dp = InStr(cb$, ".")
69.     If dp > 0 Then
70.         bdp = Len(cb$) - dp
71.         cb$ = Mid$(cb$, 1, dp - 1) + Mid$(cb$, dp + 1)
72.     Else
73.         bdp = 0
74.     End If
75.  
76.     If op$ = "+" Or op$ = "-" Or op$ = "/" Then 'add or subtr  even up strings on right of decimal
77.         'even up the right sides of decimals if any
78.         If adp > bdp Then dp = adp Else dp = bdp
79.         If adp < dp Then ca$ = ca$ + String$(dp - adp, "0")
80.         If bdp < dp Then cb$ = cb$ + String$(dp - bdp, "0")
81.     ElseIf op$ = "*" Then
82.         dp = adp + bdp
83.     End If
84.     If op$ = "*" Or op$ = "/" Then
85.         If aSgn$ = bSgn$ Then sgn$ = "" Else sgn$ = "-"
86.     End If
87.     'now according to signs and op$ call add$ or subtr$
88.     If op$ = "+" Then
89.         If aSgn$ = bSgn$ Then 'really add
90.             postOp$ = aSgn$ + add$(ca$, cb$)
91.         Else 'have a case of subtraction
92.             If aSgn$ = "-" Then postOp$ = subtr$(cb$, ca$) Else postOp$ = subtr$(ca$, cb$)
93.         End If
94.     ElseIf op$ = "-" Then
95.         If bSgn$ = "-" Then 'really add but switch b sign
96.             bSgn$ = ""
97.             If aSgn$ = "-" Then
98.                 postOp$ = subtr$(cb$, ca$)
99.             Else 'aSgn = ""
100.                 postOp$ = add$(ca$, cb$)
101.             End If
102.         Else 'bSgn$ =""
103.             If aSgn$ = "-" Then
104.                 bSgn$ = "-"
105.                 postOp$ = aSgn$ + add$(ca$, cb$)
106.             Else
107.                 postOp$ = subtr$(ca$, cb$)
108.             End If
109.         End If
110.     ElseIf op$ = "*" Then
111.         postOp$ = sgn$ + mult$(ca$, cb$)
112.     ElseIf op$ = "/" Then
113.         postOp$ = sgn$ + divide$(ca$, cb$)
114.     End If ' which op
115.     'put dp back
116.     If op$ <> "/" Then
117.         lpop = Len(postOp$) ' put decimal back
118.         postOp$ = Mid$(postOp$, 1, lpop - dp) + "." + Mid$(postOp$, lpop - dp + 1)
119.     End If
120.     mr$ = trim0$(postOp$)
121. End Function
122.  
123. Function divide$ (n$, d$) ' goal here is 100 digits precision not 100 digits past decimal
124.     Dim di$, ndi$, nD As Integer
125.     If trim0$(n$) = "0" Then divide$ = "0": Exit Function
126.     If trim0$(d$) = "0" Then divide$ = "div 0": Exit Function
127.     If trim0$(d$) = "1" Then divide$ = trim0$(n$): Exit Function '8/17 add trim0$
128.  
129.     ' aha! found a bug when d$ gets really huge 100 is no where near enough!!!!
130.     ' 2021-06-03 fix by adding 100 to len(d$), plus have to go a little past 100 for 100 digit precision
131.     ' need to go past 100 for 100 precise digits (not decimal places)
132.     di$ = Mid$(nInverse$(d$, Len(d$) + 200), 2) 'chop off decimal point after
133.     nD = Len(di$)
134.     ndi$ = mult$(n$, di$)
135.     ndi$ = Mid$(ndi$, 1, Len(ndi$) - nD) + "." + Right$(String$(nD, "0") + Right$(ndi$, nD), nD)
136.     divide$ = trim0$(ndi$)
137. End Function
138.  
139. Function nInverse$ (n$, DP As Integer) 'assume decimal at very start of the string of digits returned, no rounding
140.     Dim m$(1 To 9), si$, r$, outstr$, d$
141.     Dim i As Integer
142.     For i = 1 To 9
143.         si$ = _Trim$(Str$(i))
144.         m$(i) = mult$(si$, n$)
145.     Next
146.     outstr$ = ""
147.     If n$ = "0" Then nInverse$ = "Div 0": Exit Function
148.     If n$ = "1" Then nInverse$ = "1": Exit Function
149.     outstr$ = "." 'everything else n > 1 is decimal 8/17
150.     r$ = "10"
151.     Do
152.         While Left$(subtr$(r$, n$), 1) = "-" '   r - n < 0
153.             outstr$ = outstr$ + "0" '            add 0 to the  output string
154.             If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function 'check if we've reached DP length
155.             r$ = r$ + "0"
156.         Wend
157.         For i = 9 To 1 Step -1
158.             If LTE(m$(i), r$) Then d$ = _Trim$(Str$(i)): Exit For
159.         Next
160.         outstr$ = outstr$ + d$
161.         If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function
162.         r$ = subtr$(r$, mult$(d$, n$)) 'r = r -d*n
163.         If r$ = "0" Then nInverse$ = outstr$: Exit Function 'found a perfect divisor
164.         r$ = r$ + "0" 'add another place
165.     Loop
166. End Function
167.  
168. Function mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
169.     Dim la As Integer, lb As Integer, m As Integer, g As Integer, dp As Integer
170.     Dim v18 As _Unsigned _Integer64, sd As _Unsigned _Integer64, co As _Unsigned _Integer64
171.     Dim f18$, f1$, t$, build$, accum$
172.  
173.     If trim0$(a$) = "0" Then mult$ = "0": Exit Function
174.     If trim0$(b$) = "0" Then mult$ = "0": Exit Function
175.     If trim0$(a$) = "1" Then mult$ = trim0$(b$): Exit Function
176.     If trim0$(b$) = "1" Then mult$ = trim0$(a$): Exit Function
177.     'find the longer number and make it a mult of 18 to take 18 digits at a time from it
178.     la = Len(a$): lb = Len(b$)
179.     If la > lb Then
180.         m = Int(la / 18) + 1
181.         f18$ = Right$(String$(m * 18, "0") + a$, m * 18)
182.         f1$ = b$
183.     Else
184.         m = Int(lb / 18) + 1
185.         f18$ = Right$(String$(m * 18, "0") + b$, m * 18)
186.         f1$ = a$
187.     End If
188.     For dp = Len(f1$) To 1 Step -1 'dp = digit position of the f1$
189.         build$ = "" 'line builder
190.         co = 0
191.         'now taking 18 digits at a time Thanks Steve McNeill
192.         For g = 1 To m
193.             v18 = Val(Mid$(f18$, m * 18 - g * 18 + 1, 18))
194.             sd = Val(Mid$(f1$, dp, 1))
195.             t$ = Right$(String$(19, "0") + _Trim$(Str$(v18 * sd + co)), 19)
196.             co = Val(Mid$(t$, 1, 1))
197.             build$ = Mid$(t$, 2) + build$
198.         Next g
199.         If co Then build$ = _Trim$(Str$(co)) + build$
200.         If dp = Len(f1$) Then
201.             accum$ = build$
202.         Else
203.             accum$ = add$(accum$, build$ + String$(Len(f1$) - dp, "0"))
204.         End If
205.     Next dp
206.     mult$ = accum$
207. End Function
208.  
209. Function subtr$ (sum$, minus$) ' assume both numbers are positive all digits
210.     Dim m As Integer, g As Integer, p As Integer
211.     Dim VB As _Unsigned _Integer64, vs As _Unsigned _Integer64, tenE18 As _Unsigned _Integer64
212.     Dim ts$, tm$, sign$, LG$, sm$, t$, result$
213.  
214.     ts$ = TrimLead0$(sum$): tm$ = TrimLead0$(minus$)
215.     If trim0(ts$) = trim0$(tm$) Then subtr$ = "0": Exit Function 'OK proceed with function knowing they are not equal
216.     tenE18 = 1000000000000000000 'yes!!! no dang E's
217.     If LTE(ts$, tm$) Then ' which is bigger? minus is bigger
218.         sign$ = "-"
219.         m = Int(Len(tm$) / 18) + 1
220.         LG$ = Right$(String$(m * 18, "0") + tm$, m * 18)
221.         sm$ = Right$(String$(m * 18, "0") + ts$, m * 18)
222.     Else 'sum is bigger
223.         sign$ = ""
224.         m = Int(Len(ts$) / 18) + 1
225.         LG$ = Right$(String$(m * 18, "0") + ts$, m * 18)
226.         sm$ = Right$(String$(m * 18, "0") + tm$, m * 18)
227.     End If
228.     'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
229.     For g = 1 To m
230.         VB = Val(Mid$(LG$, m * 18 - g * 18 + 1, 18))
231.         vs = Val(Mid$(sm$, m * 18 - g * 18 + 1, 18))
232.         If vs > VB Then
233.             t$ = Right$(String$(18, "0") + _Trim$(Str$(tenE18 - vs + VB)), 18)
234.             p = (m - g) * 18
235.             While p > 0 And Mid$(LG$, p, 1) = "0"
236.                 Mid$(LG$, p, 1) = "9"
237.                 p = p - 1
238.             Wend
239.             If p > 0 Then Mid$(LG$, p, 1) = _Trim$(Str$(Val(Mid$(LG$, p, 1)) - 1))
240.         Else
241.             t$ = Right$(String$(18, "0") + _Trim$(Str$(VB - vs)), 18)
242.         End If
243.         result$ = t$ + result$
244.     Next
245.     subtr$ = sign$ + result$
246. End Function
247.  
248. Function add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
249.     'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
250.     Dim la As Integer, lb As Integer, m As Integer, g As Integer
251.     Dim sa As _Unsigned _Integer64, sb As _Unsigned _Integer64, co As _Unsigned _Integer64
252.     Dim fa$, fb$, t$, new$, result$
253.     la = Len(a$): lb = Len(b$)
254.     If la > lb Then m = Int(la / 18) + 1 Else m = Int(lb / 18) + 1
255.     fa$ = Right$(String$(m * 18, "0") + a$, m * 18)
256.     fb$ = Right$(String$(m * 18, "0") + b$, m * 18)
257.  
258.     'now taking 18 digits at a time Thanks Steve McNeill
259.     For g = 1 To m
260.         sa = Val(Mid$(fa$, m * 18 - g * 18 + 1, 18))
261.         sb = Val(Mid$(fb$, m * 18 - g * 18 + 1, 18))
262.         t$ = Right$(String$(36, "0") + _Trim$(Str$(sa + sb + co)), 36)
263.         co = Val(Mid$(t$, 1, 18))
264.         new$ = Mid$(t$, 19)
265.         result$ = new$ + result$
266.     Next
267.     If co Then result$ = Str$(co) + result$
268.     add$ = result$
269. End Function
270.  
271. ' String Math Helpers -----------------------------------------------
272.  
273. 'this function needs TrimLead0$(s$)
274. Function LTE (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings
275.     Dim ca$, cb$, la As Integer, lb As Integer, i As Integer
276.     ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
277.     la = Len(ca$): lb = Len(cb$)
278.     If ca$ = cb$ Then
279.         LTE = -1
280.     ElseIf la < lb Then ' a is smaller
281.         LTE = -1
282.     ElseIf la > lb Then ' a is bigger
283.         LTE = 0
284.     ElseIf la = lb Then ' equal lengths
285.         For i = 1 To Len(ca$)
286.             If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
287.                 LTE = 0: Exit Function
288.             ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
289.                 LTE = -1: Exit Function
290.             End If
291.         Next
292.     End If
293. End Function
294.  
295. ' ------------------------------------- use these for final display
296.  
297. Function TrimLead0$ (s$) 'for treating strings as number (pos integers)
298.     Dim copys$, i As Integer, find As Integer
299.     copys$ = _Trim$(s$) 'might as well remove spaces too
300.     i = 1: find = 0
301.     While i < Len(copys$) And Mid$(copys$, i, 1) = "0"
302.         i = i + 1: find = 1
303.     Wend
304.     If find = 1 Then copys$ = Mid$(copys$, i)
305.     If copys$ = "" Then TrimLead0$ = "0" Else TrimLead0$ = copys$
306. End Function
307.  
308. Function TrimTail0$ (s$)
309.     Dim copys$, dp As Integer, i As Integer, find As Integer
310.     copys$ = _Trim$(s$) 'might as well remove spaces too
311.     TrimTail0$ = copys$
312.     dp = InStr(copys$, ".")
313.     If dp > 0 Then
314.         i = Len(copys$): find = 0
315.         While i > dp And Mid$(copys$, i, 1) = "0"
316.             i = i - 1: find = 1
317.         Wend
318.         If find = 1 Then
319.             If i = dp Then
320.                 TrimTail0$ = Mid$(copys$, 1, dp - 1)
321.             Else
322.                 TrimTail0$ = Mid$(copys$, 1, i)
323.             End If
324.         End If
325.     End If
326. End Function
327.  
328. Function trim0$ (s$)
329.     Dim cs$, si$
330.     cs$ = s$
331.     si$ = Left$(cs$, 1)
332.     If si$ = "-" Then cs$ = Mid$(cs$, 2)
333.     cs$ = TrimLead0$(cs$)
334.     cs$ = TrimTail0$(cs$)
335.     If Right$(cs$, 1) = "." Then cs$ = Mid$(cs$, 1, Len(cs$) - 1)
336.     If si$ = "-" Then trim0$ = si$ + cs$ Else trim0$ = cs$
337. End Function
338.  
339. ' for displaying truncated numbers say to 60 digits
340. Function showDP$ (num$, nDP As Integer)
341.     Dim cNum$, dp As Integer, d As Integer, i As Integer
342.     cNum$ = num$ 'since num$ could get changed
343.     showDP$ = num$
344.     dp = InStr(num$, ".")
345.     If dp > 0 Then
346.         If Len(Mid$(cNum$, dp + 1)) > nDP Then
347.             d = Val(Mid$(cNum$, dp + nDP + 1, 1))
348.             If d > 4 Then
349.                 cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
350.                 dp = dp + 1
351.                 i = dp + nDP
352.                 While Mid$(cNum$, i, 1) = "9" Or Mid$(cNum$, i, 1) = "."
353.                     If Mid$(cNum$, i, 1) = "9" Then
354.                         Mid$(cNum$, i, 1) = "0"
355.                     End If
356.                     i = i - 1
357.                 Wend
358.                 Mid$(cNum$, i, 1) = _Trim$(Str$(Val(Mid$(cNum$, i, 1)) + 1)) 'last non 9 digit
359.                 cNum$ = Mid$(cNum$, 1, dp + nDP) 'chop it
360.                 showDP$ = trim0$(cNum$)
361.             Else
362.                 showDP$ = Mid$(cNum$, 1, dp + nDP)
363.             End If
364.         End If
365.     End If
366. End Function
367.  

I was all set to make this the new Best Answer but I will investigate adapting Newton-Raphson, a better start from jack and a better method from george.