String Math

[George McGinn]

@jack

I ran it and it does give me the correct answer for SQR(100) where mine is having an issue where the decimals are being carried over (might be part of a subtraction problem in the Math Regulator, but not sure yet, and I did see your post about an issue with the subtraction function).

I am working on converting my n'th root function to string, unless you have one as well. I would test it out along side mine, as the issue I am having with my square root function I believe I will also have with my n'th root function.

@bplus it seems that you didn't bother to run the code I posted, instead you jump to conclusions.
but for completeness here my sqrt$ function that takes care of any exponential notation and is many times faster

Code: QB64: [Select]

1. Function sqrt$ (n$)
2.     Dim As String r, tmp, r2
3.     Dim As Integer d, e, k, l
4.     r = _Trim$(Str$(Sqr(Val(n$))))
5.     d = InStr(r, "D")
6.     If d > 0 Then
7.         e = Val(Mid$(r, d + 1))
8.         r = Left$(r, 1) + Mid$(Left$(r, d - 1), 3)
9.         l = Len(r)
10.         If e > 0 Then
11.             r = r + String$(e - l + 1, "0")
12.         ElseIf e < 0 Then
13.             r = "0." + String$(Abs(e) - 1, "0") + r
14.         End If
15.     End If
16.     For k = 1 To 3
17.         tmp = mr$(r, "*", r)
18.         tmp = mr$(tmp, "-", n$)
19.         r2 = mr$(r, "+", r)
20.         tmp = mr$(tmp, "/", r2)
21.         r = mr$(r, "-", tmp)
22.         If Len(r) > 101 Then r = Left$(r, 101)
23.     Next k 'Loop Until Abs(Val(tmp)) < 1D-100
24.     sqrt$ = r
25. End Function
26.  

about 482 times faster

[bplus]

@bplus it seems that you didn't bother to run the code I posted, instead you jump to conclusions.
...

@jack

I did run the code you provided in reply #33
https://www.qb64.org/forum/index.php?topic=2921.msg133047#msg133047

I suspected it would not work with numbers outside the range of doubles and floats so first I tried 100 with an even amount of zeros added on, I didn't count then but I double checked with 100 + 30 zeros a second time, then I ran a small number .0000000000000000000064 (that's suppose to be 20 zeroes between decimal and 64.

I posted my first results in reply #37
https://www.qb64.org/forum/index.php?topic=2921.msg133053#msg133053

Just to confirm what I saw yesterday I ran the code from reply #33 again this for sure 100 then 30 zeros and . 20-0's and 64
Again my functions takes a very long time but result looks correct and your function doesn't take a long time but results are do not look close to correct:
 

I have not run the code that corrects for exponents (reply #43 posted this AM) because I am just getting to it now your sqr(2) times 10 to some hefty amount of even number (I assume by the answers) looks very impressive specially with time.

Please forget my comments in #37 I don't know what the heck you're doing in 3 iterations, let the screen shot of my test of your code speak for itself.

[bplus]

bplus, there's a bug in your subtract routine

Code: QB64: [Select]

1. result$ = mr$(".00000000000000000000000000000000000000000000200000000000000054307978001764", "-", ".000000000000000000000000000000000000000000002")
2. Print result$
3.  

the outputit should be

Confirmed! thanks for heads up.

Apparently the Forum editor can only Quote one Quote box at a time.

[jack]

here's your MR with nth root, but I there seem to problems with very big numbers, not sure it's due to a MR bug
there's a loss of precision with roots higher than 50

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. Declare CustomType Library
11.     Sub memcpy (ByVal dest As _Offset, Byval source As _Offset, Byval bytes As Long)
12. End Declare
13.  
14. $Console:Only
15. _Dest _Console
16.  
17. Dim n$, result$
18. Dim t#
19. 'Do
20. '    'remember everything is strings
21. '    Input "Enter a number to find it's square root "; n$
22. '    If n$ = "" Then End
23. '    t# = Timer
24. '    result$ = sqrRoot$(n$)
25. '    Print Timer - t#, result$
26. '    t# = Timer
27. '    result$ = sqrt$(n$)
28. '    Print Timer - t#, result$
29. '    Print "Length ="; Len(result$)
30. '    Print
31. 'Loop
32. 'Print approx_power(x#, y#), x# ^ (1 / y#)
33.  
34. n$ = "2"
35. t# = Timer
36. result$ = approx_powers$(n$, 2)
37. Print Timer - t#, result$
38.  
39. Function sqrRoot$ (nmbr$)
40.     Dim n$, guess$, lastGuess$, other$, sum$, imaginary$
41.     If Left$(nmbr$, 1) = "-" Then 'handle neg numbers
42.         imaginary$ = "*i": n$ = Mid$(nmbr$, 2)
43.     Else
44.         imaginary$ = "": n$ = nmbr$
45.     End If
46.     guess$ = mr$(n$, "/", "2")
47.     other$ = n$
48.     Do
49.         If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then ' go past 100 matching digits for 100 digit precision
50.             sqrRoot$ = Mid$(other$, 1, 101) + imaginary$
51.             Exit Function
52.         Else
53.             lastGuess$ = guess$
54.             sum$ = mr$(guess$, "+", other$)
55.             guess$ = mr$(sum$, "/", "2")
56.             other$ = mr$(n$, "/", guess$)
57.         End If
58.     Loop
59. End Function
60.  
61. Function ipower# (x As Double, e As Integer)
62.     'take x to an integer power
63.     Dim As Double z, y
64.     Dim As Integer n
65.     y = x
66.     n = Abs(e)
67.     z = 1#
68.     While n > 0
69.         While (n Mod 2) = 0
70.             n = n \ 2
71.             y = y * y
72.         Wend
73.         n = n - 1
74.         z = y * z
75.     Wend
76.     If e < 0 Then
77.         ipower = 1# / z
78.     Else
79.         ipower = z
80.     End If
81. End Function
82.  
83. Function approx_power# (x#, y#)
84.     Dim As Double a, b
85.     Dim As Long tmp
86.     a = x#: b = 1# / y#
87.     memcpy _Offset(tmp), _Offset(a) + 4, 4
88.     tmp = (tmp - 1072632447) * b
89.     tmp = tmp + 1072632447
90.     memcpy _Offset(a) + 4, _Offset(tmp), 4
91.     a = a - (ipower(a, y#) - x#) / (y# * ipower(a, y# - 1))
92.     a = a - (ipower(a, y#) - x#) / (y# * ipower(a, y# - 1))
93.     a = a - (ipower(a, y#) - x#) / (y# * ipower(a, y# - 1))
94.     a = a - (ipower(a, y#) - x#) / (y# * ipower(a, y# - 1))
95.     approx_power = a
96. End Function
97.  
98. Function ipow$ (x As String, e As Integer)
99.     'take x to an integer power
100.     Dim As String z, y
101.     Dim As Integer n
102.     y = x
103.     n = Abs(e)
104.     z = "1"
105.     While n > 0
106.         While (n Mod 2) = 0
107.             n = n \ 2
108.             y = mr$(y, "*", y)
109.             If Len(y) > 101 Then y = Left$(y, 101)
110.         Wend
111.         n = n - 1
112.         z = mr$(y, "*", z)
113.         If Len(z) > 101 Then z = Left$(z, 101)
114.     Wend
115.     If e < 0 Then
116.         ipow = mr$("1", "/", z)
117.     Else
118.         ipow = z
119.     End If
120. End Function
121.  
122. Function approx_powers$ (x$, y%)
123.     Dim As Double a, b
124.     Dim As Integer d, e, k, l
125.     Dim As String r, r2, temp, ys
126.     a = Val(x$): b = y%
127.     a = approx_power#(a, b)
128.     r = _Trim$(Str$(a))
129.     d = InStr(r, "D")
130.     If d > 0 Then
131.         e = Val(Mid$(r, d + 1))
132.         r = Left$(r, 1) + Mid$(Left$(r, d - 1), 3)
133.         l = Len(r)
134.         If e > 0 Then
135.             r = r + String$(e - l + 1, "0")
136.         ElseIf e < 0 Then
137.             r = "0." + String$(Abs(e) - 1, "0") + r
138.         End If
139.     End If
140.     ys = _Trim$(Str$(y%))
141.     For k = 1 To 3
142.         temp = ipow$(r, y%)
143.         temp = mr$(temp, "-", x$)
144.         r2 = ipow$(r, y% - 1)
145.         r2 = mr$(ys, "*", r2)
146.         r2 = mr$(temp, "/", r2)
147.         r = mr$(r, "-", r2)
148.     Next k
149.     If Len(r) > 101 Then r = Left$(r, 101)
150.     approx_powers = r
151. End Function
152.  
153. Function sqrt$ (n$)
154.     Dim As String r, tmp, r2
155.     Dim As Integer d, e, k, l
156.     r = _Trim$(Str$(Sqr(Val(n$))))
157.     d = InStr(r, "D")
158.     If d > 0 Then
159.         e = Val(Mid$(r, d + 1))
160.         r = Left$(r, 1) + Mid$(Left$(r, d - 1), 3)
161.         l = Len(r)
162.         If e > 0 Then
163.             r = r + String$(e - l + 1, "0")
164.         ElseIf e < 0 Then
165.             r = "0." + String$(Abs(e) - 1, "0") + r
166.         End If
167.     End If
168.     For k = 1 To 3
169.         tmp = mr$(r, "*", r)
170.         tmp = mr$(tmp, "-", n$)
171.         r2 = mr$(r, "+", r)
172.         tmp = mr$(tmp, "/", r2)
173.         r = mr$(r, "-", tmp)
174.         If Len(r) > 101 Then r = Left$(r, 101)
175.     Next k 'Loop Until Abs(Val(tmp)) < 1D-100
176.     sqrt$ = r
177. End Function
178.  
179. Function mr$ (a$, op$, b$) ' catchy? mr$ for math regulator
180.     Dim ca$, cb$, aSgn$, bSgn$, postOp$, sgn$
181.     Dim adp As Integer, bdp As Integer, dp As Integer, lpop As Integer
182.  
183.     op$ = _Trim$(op$) 'save fixing each time
184.     ca$ = _Trim$(a$): cb$ = _Trim$(b$) 'make copies in case we change
185.     'strip signs and decimals
186.     If Left$(ca$, 1) = "-" Then
187.         aSgn$ = "-": ca$ = Mid$(ca$, 2)
188.     Else
189.         aSgn$ = "": ca$ = ca$
190.     End If
191.     dp = InStr(ca$, ".")
192.     If dp > 0 Then
193.         adp = Len(ca$) - dp
194.         ca$ = Mid$(ca$, 1, dp - 1) + Mid$(ca$, dp + 1)
195.     Else
196.         adp = 0
197.     End If
198.     If Left$(cb$, 1) = "-" Then
199.         bSgn$ = "-": cb$ = Mid$(cb$, 2)
200.     Else
201.         bSgn$ = "": cb$ = cb$
202.     End If
203.     dp = InStr(cb$, ".")
204.     If dp > 0 Then
205.         bdp = Len(cb$) - dp
206.         cb$ = Mid$(cb$, 1, dp - 1) + Mid$(cb$, dp + 1)
207.     Else
208.         bdp = 0
209.     End If
210.  
211.     If op$ = "+" Or op$ = "-" Or op$ = "/" Then 'add or subtr  even up strings on right of decimal
212.         'even up the right sides of decimals if any
213.         If adp > bdp Then dp = adp Else dp = bdp
214.         If adp < dp Then ca$ = ca$ + String$(dp - adp, "0")
215.         If bdp < dp Then cb$ = cb$ + String$(dp - bdp, "0")
216.     ElseIf op$ = "*" Then
217.         dp = adp + bdp
218.     End If
219.     If op$ = "*" Or op$ = "/" Then
220.         If aSgn$ = bSgn$ Then sgn$ = "" Else sgn$ = "-"
221.     End If
222.     'now according to signs and op$ call add$ or subtr$
223.     If op$ = "+" Then
224.         If aSgn$ = bSgn$ Then 'really add
225.             postOp$ = aSgn$ + add$(ca$, cb$)
226.         Else 'have a case of subtraction
227.             If aSgn$ = "-" Then postOp$ = subtr$(cb$, ca$) Else postOp$ = subtr$(ca$, cb$)
228.         End If
229.     ElseIf op$ = "-" Then
230.         If bSgn$ = "-" Then 'really add but switch b sign
231.             bSgn$ = ""
232.             If aSgn$ = "-" Then
233.                 postOp$ = subtr$(cb$, ca$)
234.             Else 'aSgn = ""
235.                 postOp$ = add$(ca$, cb$)
236.             End If
237.         Else 'bSgn$ =""
238.             If aSgn$ = "-" Then
239.                 bSgn$ = "-"
240.                 postOp$ = aSgn$ + add$(ca$, cb$)
241.             Else
242.                 postOp$ = subtr$(ca$, cb$)
243.             End If
244.         End If
245.     ElseIf op$ = "*" Then
246.         postOp$ = sgn$ + mult$(ca$, cb$)
247.     ElseIf op$ = "/" Then
248.         postOp$ = sgn$ + divide$(ca$, cb$)
249.     End If ' which op
250.     'put dp back
251.     If op$ <> "/" Then
252.         lpop = Len(postOp$) ' put decimal back
253.         postOp$ = Mid$(postOp$, 1, lpop - dp) + "." + Mid$(postOp$, lpop - dp + 1)
254.     End If
255.     mr$ = trim0$(postOp$)
256. End Function
257.  
258. Function divide$ (n$, d$) ' goal here is 100 digits precision not 100 digits past decimal
259.     Dim di$, ndi$, nD As Integer
260.     If trim0$(n$) = "0" Then divide$ = "0": Exit Function
261.     If trim0$(d$) = "0" Then divide$ = "div 0": Exit Function
262.     If trim0$(d$) = "1" Then divide$ = trim0$(n$): Exit Function '8/17 add trim0$
263.  
264.     ' aha! found a bug when d$ gets really huge 100 is no where near enough!!!!
265.     ' 2021-06-03 fix by adding 100 to len(d$), plus have to go a little past 100 for 100 digit precision
266.     ' need to go past 100 for 100 precise digits (not decimal places)
267.     di$ = Mid$(nInverse$(d$, Len(d$) + 200), 2) 'chop off decimal point after
268.     nD = Len(di$)
269.     ndi$ = mult$(n$, di$)
270.     ndi$ = Mid$(ndi$, 1, Len(ndi$) - nD) + "." + Right$(String$(nD, "0") + Right$(ndi$, nD), nD)
271.     divide$ = trim0$(ndi$)
272. End Function
273.  
274. Function nInverse$ (n$, DP As Integer) 'assume decimal at very start of the string of digits returned, no rounding
275.     Dim m$(1 To 9), si$, r$, outstr$, d$
276.     Dim i As Integer
277.     For i = 1 To 9
278.         si$ = _Trim$(Str$(i))
279.         m$(i) = mult$(si$, n$)
280.     Next
281.     outstr$ = ""
282.     If n$ = "0" Then nInverse$ = "Div 0": Exit Function
283.     If n$ = "1" Then nInverse$ = "1": Exit Function
284.     outstr$ = "." 'everything else n > 1 is decimal 8/17
285.     r$ = "10"
286.     Do
287.         While Left$(subtr$(r$, n$), 1) = "-" '   r - n < 0
288.             outstr$ = outstr$ + "0" '            add 0 to the  output string
289.             If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function 'check if we've reached DP length
290.             r$ = r$ + "0"
291.         Wend
292.         For i = 9 To 1 Step -1
293.             If LTE(m$(i), r$) Then d$ = _Trim$(Str$(i)): Exit For
294.         Next
295.         outstr$ = outstr$ + d$
296.         If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function
297.         r$ = subtr$(r$, mult$(d$, n$)) 'r = r -d*n
298.         If r$ = "0" Then nInverse$ = outstr$: Exit Function 'found a perfect divisor
299.         r$ = r$ + "0" 'add another place
300.     Loop
301. End Function
302.  
303. Function mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
304.     Dim la As Integer, lb As Integer, m As Integer, g As Integer, dp As Integer
305.     Dim v18 As _Unsigned _Integer64, sd As _Unsigned _Integer64, co As _Unsigned _Integer64
306.     Dim f18$, f1$, t$, build$, accum$
307.  
308.     If trim0$(a$) = "0" Then mult$ = "0": Exit Function
309.     If trim0$(b$) = "0" Then mult$ = "0": Exit Function
310.     If trim0$(a$) = "1" Then mult$ = trim0$(b$): Exit Function
311.     If trim0$(b$) = "1" Then mult$ = trim0$(a$): Exit Function
312.     'find the longer number and make it a mult of 18 to take 18 digits at a time from it
313.     la = Len(a$): lb = Len(b$)
314.     If la > lb Then
315.         m = Int(la / 18) + 1
316.         f18$ = Right$(String$(m * 18, "0") + a$, m * 18)
317.         f1$ = b$
318.     Else
319.         m = Int(lb / 18) + 1
320.         f18$ = Right$(String$(m * 18, "0") + b$, m * 18)
321.         f1$ = a$
322.     End If
323.     For dp = Len(f1$) To 1 Step -1 'dp = digit position of the f1$
324.         build$ = "" 'line builder
325.         co = 0
326.         'now taking 18 digits at a time Thanks Steve McNeill
327.         For g = 1 To m
328.             v18 = Val(Mid$(f18$, m * 18 - g * 18 + 1, 18))
329.             sd = Val(Mid$(f1$, dp, 1))
330.             t$ = Right$(String$(19, "0") + _Trim$(Str$(v18 * sd + co)), 19)
331.             co = Val(Mid$(t$, 1, 1))
332.             build$ = Mid$(t$, 2) + build$
333.         Next g
334.         If co Then build$ = _Trim$(Str$(co)) + build$
335.         If dp = Len(f1$) Then
336.             accum$ = build$
337.         Else
338.             accum$ = add$(accum$, build$ + String$(Len(f1$) - dp, "0"))
339.         End If
340.     Next dp
341.     mult$ = accum$
342. End Function
343.  
344. Function subtr$ (sum$, minus$) ' assume both numbers are positive all digits
345.     Dim m As Integer, g As Integer, p As Integer
346.     Dim VB As _Unsigned _Integer64, vs As _Unsigned _Integer64, tenE18 As _Unsigned _Integer64
347.     Dim ts$, tm$, sign$, LG$, sm$, t$, result$
348.  
349.     ts$ = TrimLead0$(sum$): tm$ = TrimLead0$(minus$)
350.     If trim0(ts$) = trim0$(tm$) Then subtr$ = "0": Exit Function 'OK proceed with function knowing they are not equal
351.     tenE18 = 1000000000000000000 'yes!!! no dang E's
352.     If LTE(ts$, tm$) Then ' which is bigger? minus is bigger
353.         sign$ = "-"
354.         m = Int(Len(tm$) / 18) + 1
355.         LG$ = Right$(String$(m * 18, "0") + tm$, m * 18)
356.         sm$ = Right$(String$(m * 18, "0") + ts$, m * 18)
357.     Else 'sum is bigger
358.         sign$ = ""
359.         m = Int(Len(ts$) / 18) + 1
360.         LG$ = Right$(String$(m * 18, "0") + ts$, m * 18)
361.         sm$ = Right$(String$(m * 18, "0") + tm$, m * 18)
362.     End If
363.     'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
364.     For g = 1 To m
365.         VB = Val(Mid$(LG$, m * 18 - g * 18 + 1, 18))
366.         vs = Val(Mid$(sm$, m * 18 - g * 18 + 1, 18))
367.         If vs > VB Then
368.             t$ = Right$(String$(18, "0") + _Trim$(Str$(tenE18 - vs + VB)), 18)
369.             p = (m - g) * 18
370.             While p > 0 And Mid$(LG$, p, 1) = "0"
371.                 Mid$(LG$, p, 1) = "9"
372.                 p = p - 1
373.             Wend
374.             If p > 0 Then Mid$(LG$, p, 1) = _Trim$(Str$(Val(Mid$(LG$, p, 1)) - 1))
375.         Else
376.             t$ = Right$(String$(18, "0") + _Trim$(Str$(VB - vs)), 18)
377.         End If
378.         result$ = t$ + result$
379.     Next
380.     subtr$ = sign$ + result$
381. End Function
382.  
383. Function add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
384.     'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
385.     Dim la As Integer, lb As Integer, m As Integer, g As Integer
386.     Dim sa As _Unsigned _Integer64, sb As _Unsigned _Integer64, co As _Unsigned _Integer64
387.     Dim fa$, fb$, t$, new$, result$
388.     la = Len(a$): lb = Len(b$)
389.     If la > lb Then m = Int(la / 18) + 1 Else m = Int(lb / 18) + 1
390.     fa$ = Right$(String$(m * 18, "0") + a$, m * 18)
391.     fb$ = Right$(String$(m * 18, "0") + b$, m * 18)
392.  
393.     'now taking 18 digits at a time Thanks Steve McNeill
394.     For g = 1 To m
395.         sa = Val(Mid$(fa$, m * 18 - g * 18 + 1, 18))
396.         sb = Val(Mid$(fb$, m * 18 - g * 18 + 1, 18))
397.         t$ = Right$(String$(36, "0") + _Trim$(Str$(sa + sb + co)), 36)
398.         co = Val(Mid$(t$, 1, 18))
399.         new$ = Mid$(t$, 19)
400.         result$ = new$ + result$
401.     Next
402.     If co Then result$ = Str$(co) + result$
403.     add$ = result$
404. End Function
405.  
406. ' String Math Helpers -----------------------------------------------
407.  
408. 'this function needs TrimLead0$(s$)
409. Function LTE (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings
410.     Dim ca$, cb$, la As Integer, lb As Integer, i As Integer
411.     ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
412.     la = Len(ca$): lb = Len(cb$)
413.     If ca$ = cb$ Then
414.         LTE = -1
415.     ElseIf la < lb Then ' a is smaller
416.         LTE = -1
417.     ElseIf la > lb Then ' a is bigger
418.         LTE = 0
419.     ElseIf la = lb Then ' equal lengths
420.         For i = 1 To Len(ca$)
421.             If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
422.                 LTE = 0: Exit Function
423.             ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
424.                 LTE = -1: Exit Function
425.             End If
426.         Next
427.     End If
428. End Function
429.  
430. ' ------------------------------------- use these for final display
431.  
432. Function TrimLead0$ (s$) 'for treating strings as number (pos integers)
433.     Dim copys$, i As Integer, find As Integer
434.     copys$ = _Trim$(s$) 'might as well remove spaces too
435.     i = 1: find = 0
436.     While i < Len(copys$) And Mid$(copys$, i, 1) = "0"
437.         i = i + 1: find = 1
438.     Wend
439.     If find = 1 Then copys$ = Mid$(copys$, i)
440.     If copys$ = "" Then TrimLead0$ = "0" Else TrimLead0$ = copys$
441. End Function
442.  
443. Function TrimTail0$ (s$)
444.     Dim copys$, dp As Integer, i As Integer, find As Integer
445.     copys$ = _Trim$(s$) 'might as well remove spaces too
446.     TrimTail0$ = copys$
447.     dp = InStr(copys$, ".")
448.     If dp > 0 Then
449.         i = Len(copys$): find = 0
450.         While i > dp And Mid$(copys$, i, 1) = "0"
451.             i = i - 1: find = 1
452.         Wend
453.         If find = 1 Then
454.             If i = dp Then
455.                 TrimTail0$ = Mid$(copys$, 1, dp - 1)
456.             Else
457.                 TrimTail0$ = Mid$(copys$, 1, i)
458.             End If
459.         End If
460.     End If
461. End Function
462.  
463. Function trim0$ (s$)
464.     Dim cs$, si$
465.     cs$ = s$
466.     si$ = Left$(cs$, 1)
467.     If si$ = "-" Then cs$ = Mid$(cs$, 2)
468.     cs$ = TrimLead0$(cs$)
469.     cs$ = TrimTail0$(cs$)
470.     If Right$(cs$, 1) = "." Then cs$ = Mid$(cs$, 1, Len(cs$) - 1)
471.     If si$ = "-" Then trim0$ = si$ + cs$ Else trim0$ = cs$
472. End Function
473.  
474. ' for displaying truncated numbers say to 60 digits
475. Function showDP$ (num$, nDP As Integer)
476.     Dim cNum$, dp As Integer, d As Integer, i As Integer
477.     cNum$ = num$ 'since num$ could get changed
478.     showDP$ = num$
479.     dp = InStr(num$, ".")
480.     If dp > 0 Then
481.         If Len(Mid$(cNum$, dp + 1)) > nDP Then
482.             d = Val(Mid$(cNum$, dp + nDP + 1, 1))
483.             If d > 4 Then
484.                 cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
485.                 dp = dp + 1
486.                 i = dp + nDP
487.                 While Mid$(cNum$, i, 1) = "9" Or Mid$(cNum$, i, 1) = "."
488.                     If Mid$(cNum$, i, 1) = "9" Then
489.                         Mid$(cNum$, i, 1) = "0"
490.                     End If
491.                     i = i - 1
492.                 Wend
493.                 Mid$(cNum$, i, 1) = _Trim$(Str$(Val(Mid$(cNum$, i, 1)) + 1)) 'last non 9 digit
494.                 cNum$ = Mid$(cNum$, 1, dp + nDP) 'chop it
495.                 showDP$ = trim0$(cNum$)
496.             Else
497.                 showDP$ = Mid$(cNum$, 1, dp + nDP)
498.             End If
499.         End If
500.     End If
501. End Function
502.  

[bplus]

The subtr$ Function is terrible!

I should have checked way larger and smaller numbers with it. I think I just checked it with QB64 Doubles or Floats for errors but the bug doesn't show until numbers are longer than 18 digits.

Apologies to all who wasted time working that code.

Still, our goal is a good one I think.

PS This explains why the attempts with Newton-Raphson were not working with Mr$() Function calls and why I was getting good sqrRoots because I was using the Average Method that did not use subtraction.

[George McGinn]

The sqrt$ also performs subtr$ function. The root_n$ I have now (non-string version) and your power## seems to work fine.

Also, I noticed that for the power## function, when I do 1.2^5 [mr$("1.2", "^", "5")] I get the right digits, but the decimal place isn't put back into the final result (see screen print).

 

[bplus]

Well it took all day to find a simple little change in the subtr$() Function that fixes problems. That was the good news.

The bad news, it is now taking the inverse of STx number to see 115 terms of Fibonacci series (or is it sequence)  about 30 secs to calculate, before it was up in a sneeze. It looks different also at the end but the same 115 terms of Fibonacci can still be found.

OK so the first line in subtr$() fixes the bug that jack pointed out that I confirmed and it also fixes my version of George's version of Newton-Raphson estimates of SQR() but it is definitely slowed down. We now get same sqr roots for 100 + 30-0's and .20-0's 64 for both versions.

Anyway here is the code checks and tests:

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. ' jack error reported 2021-06-04 confirmed!   fixed
12. Print mr$(".00000000000000000000000000000000000000000000200000000000000054307978001764", "-", ".000000000000000000000000000000000000000000002")
13. Print ".00000000000000000000000000000000000000000000000000000000000054307978001764"
14.  
15. Dim r$, ruler$
16. ruler$ = "0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890" + Chr$(10)
17. ruler$ = ruler$ + "0         1         2         3         4         5         6         7         8         9        10        11        12"
18. ' debug tests
19. Print mr$("-5", "+", "-2100"), " OK if -2105"
20. Print mr$("." + String$(20, "0") + "1", "+", "1" + String$(40, "0") + "1") ' first real test of add
21. Print ruler$
22. Print Val("." + String$(20, "0") + "1") + Val("1" + String$(40, "0") + "1") ' test print of big and small val
23. Print mr$("-.00071", "+", ".00036" + String$(35, "0") + "9")
24. '-.00071
25. ' .00036000000000000000000000000000000000009
26. Print "-.00034999999999999999999999999999999999991"
27. Print ruler$
28. 'testing a different subtract sub
29. Print mr$("10", "-", "5"), " 5 OK"
30. Print mr$("-10", "+", "5"), " -5 OK"
31. Print mr$("-10", "-", "-5"), " -5 OK"
32. Print mr$("-10", "-", "5"), " -15  OK  added"
33. Print mr$("10", "-", "-5"), " 15  OK  added"
34. Print mr$("-.010", "-", "-5"), "4.99 OK"
35. Print mr$("-.010", "-", "5"), "-5.01  OK just added"
36. Print mr$(".010", "-", "5"), " -4.99 OK"
37. ' jack error reported 2021-06-04 confirmed!  variation below
38. r$ = mr$(".00000000200000000000000054307978001764", "-", ".0000000020000000000000001") '16 0 wrong  8 wrong
39. Print "   mr$ rtnd:"; r$
40. Print "    compare:.00000000000000000000000044307978001764" ' 2021-06-05 finally!
41. '                  .0000000020000000000000001
42. '                  .00000000200000000000000054307978001764
43.  
44. r$ = mr$(".00000000000000000100000000000000000011", "-", ".000000000000000001000000000000000001") ' bad too
45. Print "   mr$ rtnd:"; r$
46. '         ".000000000000000001000000000000000001"
47. Print "    compare:-.00000000000000000000000000000000000089"
48. r$ = mr$(".00000000000000000100000000000000000111", "-", ".000000000000000002000000000000000001")
49. '       ".000000000000000002000000000000000001"
50. '       ".00000000000000000100000000000000000111"
51. '       ".00000000000000000099999999999999999989"
52. Print "   mr$ rtnd:"; r$
53. Print "    compare:-.00000000000000000099999999999999999989"
54.  
55. r$ = mr$(".00000000000000000000000000999", "-", "1")
56. '-1.00000000000000000000000000000000000000000
57. '  .00000000000000000000000000999
58. ' -.99999999999999999999999999001
59. Print "   mr$ rtnd:"; r$
60. Print "    compare:-.99999999999999999999999999001"
61.  
62. r$ = mr$("1", "+", "-1000000000000000000000000000000000000000")
63. Print "   mr$ rtnd:"; r$
64. '1000000000000000000000000000000000000000
65. '-999999999999999999999999999999999999999
66. Print "    compare:-999999999999999999999999999999999999999"
67.  
68. ' check jack problems with FB translation  2021-06-03  errors must be in FB trans from QB64
69. Print Mid$(mr$(" .1", "/", "3"), 1, 100) ' too long?
70. Print Mid$(mr$("1.1", "/", "9"), 1, 100)
71. Print Mid$(mr$("1.38", "/", "1.2"), 1, 100)
72. Print ruler$
73.  
74. Print "checking inverse of 50 = .02 "; nInverse$("50", 20) 'OK  .020000... length 20
75. Print ruler$
76. Print
77. Print "zzz... see inverse of STx number now takes close to 30 secs with fixed subtr$() sub,"
78. Print "Use to come up in a sneeze! It also looks different way more space on end but still"
79. Print "can find 115 Fibonacci terms in it."
80. Print "    The only difference is I am not trimming leading 0's in subst$() function!"
81. Sleep
82. Cls
83. Print nInverse$("999999999999999999999998999999999999999999999999", 4000) ' wow big delay!
84. Print
85.  
86.  
87.  
88. Dim n$, result$
89. Do
90.     'remember everything is strings
91.     Input "Enter a number to find it's square root "; n$
92.     If n$ = "" Then End
93.     result$ = sqrRoot$(n$)
94.     Print result$
95.     Print "Length ="; Len(result$)
96.     _Delay 2
97.     result$ = SRbyNR$(n$)
98.     Print result$
99.     Print "Length ="; Len(result$)
100.     Print
101. Loop
102.  
103. Function sqrRoot$ (nmbr$)
104.     Dim n$, guess$, lastGuess$, other$, sum$, imaginary$, loopcnt
105.     If Left$(nmbr$, 1) = "-" Then 'handle neg numbers
106.         imaginary$ = "*i": n$ = Mid$(nmbr$, 2)
107.     Else
108.         imaginary$ = "": n$ = nmbr$
109.     End If
110.     guess$ = mr$(n$, "/", "2")
111.     other$ = n$
112.     Do
113.         loopcnt = loopcnt + 1
114.         Print "loop cnt"; loopcnt
115.  
116.         If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then ' go past 100 matching digits for 100 digit precision
117.             sqrRoot$ = Mid$(other$, 1, 101) + imaginary$ ' try other factor for guess$  sometimes it nails answer without all digits
118.             Exit Function
119.         Else
120.             lastGuess$ = guess$
121.             sum$ = mr$(guess$, "+", other$)
122.             guess$ = mr$(sum$, "/", "2")
123.             other$ = mr$(n$, "/", guess$)
124.         End If
125.     Loop
126. End Function
127.  
128. Function SRbyNR$ (nmbr$) ' square root by Newton - Ralphson method my interpretation of GeorgeMcGinn
129.  
130.     Dim n$, guess$, lastGuess$, dx$, imaginary$, other$, loopcnt
131.     If Left$(nmbr$, 1) = "-" Then 'handle neg numbers
132.         imaginary$ = "*i": n$ = Mid$(nmbr$, 2)
133.     Else
134.         imaginary$ = "": n$ = nmbr$
135.     End If
136.  
137.     guess$ = mr$(n$, "/", "2") ' get this going first and then try better starting guess later
138.  
139.     Do
140.         loopcnt = loopcnt + 1
141.         Print "loop cnt"; loopcnt
142.         If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then ' go past 100 matching digits for 100 digit precision
143.             SRbyNR$ = Mid$(other$, 1, 101) + imaginary$
144.             Exit Function
145.         Else
146.             'dx = (x - A / x) / 2: x = x - dx ' Thanks George
147.             lastGuess$ = guess$
148.             dx$ = mr$(mr$(guess$, "-", mr$(n$, "/", guess$)), "/", "2")
149.             guess$ = mr$(guess$, "-", dx$)
150.             other$ = mr$(n$, "/", guess$) ' try other factor for guess$  sometimes it nails answer without all digits
151.         End If
152.     Loop
153. End Function
154.  
155.  
156. Function mr$ (a$, op$, b$) ' catchy? mr$ for math regulator
157.     Dim ca$, cb$, aSgn$, bSgn$, postOp$, sgn$
158.     Dim adp As Integer, bdp As Integer, dp As Integer, lpop As Integer
159.  
160.     op$ = _Trim$(op$) 'save fixing each time
161.     ca$ = _Trim$(a$): cb$ = _Trim$(b$) 'make copies in case we change
162.     'strip signs and decimals
163.     If Left$(ca$, 1) = "-" Then
164.         aSgn$ = "-": ca$ = Mid$(ca$, 2)
165.     Else
166.         aSgn$ = "": ca$ = ca$
167.     End If
168.     dp = InStr(ca$, ".")
169.     If dp > 0 Then
170.         adp = Len(ca$) - dp
171.         ca$ = Mid$(ca$, 1, dp - 1) + Mid$(ca$, dp + 1)
172.     Else
173.         adp = 0
174.     End If
175.     If Left$(cb$, 1) = "-" Then
176.         bSgn$ = "-": cb$ = Mid$(cb$, 2)
177.     Else
178.         bSgn$ = "": cb$ = cb$
179.     End If
180.     dp = InStr(cb$, ".")
181.     If dp > 0 Then
182.         bdp = Len(cb$) - dp
183.         cb$ = Mid$(cb$, 1, dp - 1) + Mid$(cb$, dp + 1)
184.     Else
185.         bdp = 0
186.     End If
187.  
188.     If op$ = "+" Or op$ = "-" Or op$ = "/" Then 'add or subtr  even up strings on right of decimal
189.         'even up the right sides of decimals if any
190.         If adp > bdp Then dp = adp Else dp = bdp
191.         If adp < dp Then ca$ = ca$ + String$(dp - adp, "0")
192.         If bdp < dp Then cb$ = cb$ + String$(dp - bdp, "0")
193.     ElseIf op$ = "*" Then
194.         dp = adp + bdp
195.     End If
196.     If op$ = "*" Or op$ = "/" Then
197.         If aSgn$ = bSgn$ Then sgn$ = "" Else sgn$ = "-"
198.     End If
199.     'now according to signs and op$ call add$ or subtr$
200.     If op$ = "+" Then
201.         If aSgn$ = bSgn$ Then 'really add
202.             postOp$ = aSgn$ + add$(ca$, cb$)
203.         Else 'have a case of subtraction
204.             If aSgn$ = "-" Then postOp$ = subtr$(cb$, ca$) Else postOp$ = subtr$(ca$, cb$)
205.         End If
206.     ElseIf op$ = "-" Then
207.         If bSgn$ = "-" Then 'really add but switch b sign
208.             bSgn$ = ""
209.             If aSgn$ = "-" Then
210.                 postOp$ = subtr$(cb$, ca$)
211.             Else 'aSgn = ""
212.                 postOp$ = add$(ca$, cb$)
213.             End If
214.         Else 'bSgn$ =""
215.             If aSgn$ = "-" Then
216.                 bSgn$ = "-"
217.                 postOp$ = aSgn$ + add$(ca$, cb$)
218.             Else
219.                 postOp$ = subtr$(ca$, cb$)
220.             End If
221.         End If
222.     ElseIf op$ = "*" Then
223.         postOp$ = sgn$ + mult$(ca$, cb$)
224.     ElseIf op$ = "/" Then
225.         postOp$ = sgn$ + divide$(ca$, cb$)
226.     End If ' which op
227.     'put dp back
228.     If op$ <> "/" Then
229.         lpop = Len(postOp$) ' put decimal back
230.         postOp$ = Mid$(postOp$, 1, lpop - dp) + "." + Mid$(postOp$, lpop - dp + 1)
231.     End If
232.     mr$ = trim0$(postOp$)
233. End Function
234.  
235. Function divide$ (n$, d$) ' goal here is 100 digits precision not 100 digits past decimal
236.     Dim di$, ndi$, nD As Integer
237.     If trim0$(n$) = "0" Then divide$ = "0": Exit Function
238.     If trim0$(d$) = "0" Then divide$ = "div 0": Exit Function
239.     If trim0$(d$) = "1" Then divide$ = trim0$(n$): Exit Function '8/17 add trim0$
240.  
241.     ' aha! found a bug when d$ gets really huge 100 is no where near enough!!!!
242.     ' 2021-06-03 fix by adding 100 to len(d$), plus have to go a little past 100 for 100 digit precision
243.     ' need to go past 100 for 100 precise digits (not decimal places)
244.     di$ = Mid$(nInverse$(d$, Len(d$) + 200), 2) 'chop off decimal point after
245.     nD = Len(di$)
246.     ndi$ = mult$(n$, di$)
247.     ndi$ = Mid$(ndi$, 1, Len(ndi$) - nD) + "." + Right$(String$(nD, "0") + Right$(ndi$, nD), nD)
248.     divide$ = trim0$(ndi$)
249. End Function
250.  
251. Function nInverse$ (n$, DP As Integer) 'assume decimal at very start of the string of digits returned, no rounding
252.     Dim m$(1 To 9), si$, r$, outstr$, d$
253.     Dim i As Integer
254.     For i = 1 To 9
255.         si$ = _Trim$(Str$(i))
256.         m$(i) = mult$(si$, n$)
257.     Next
258.     outstr$ = ""
259.     If n$ = "0" Then nInverse$ = "Div 0": Exit Function
260.     If n$ = "1" Then nInverse$ = "1": Exit Function
261.     outstr$ = "." 'everything else n > 1 is decimal 8/17
262.     r$ = "10"
263.     Do
264.         While Left$(subtr$(r$, n$), 1) = "-" '   r - n < 0
265.             outstr$ = outstr$ + "0" '            add 0 to the  output string
266.             If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function 'check if we've reached DP length
267.             r$ = r$ + "0"
268.         Wend
269.         For i = 9 To 1 Step -1
270.             If LTE(m$(i), r$) Then d$ = _Trim$(Str$(i)): Exit For
271.         Next
272.         outstr$ = outstr$ + d$
273.         If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function
274.         r$ = subtr$(r$, mult$(d$, n$)) 'r = r -d*n
275.         If r$ = "0" Then nInverse$ = outstr$: Exit Function 'found a perfect divisor
276.         r$ = r$ + "0" 'add another place
277.     Loop
278. End Function
279.  
280. Function mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
281.     Dim la As Integer, lb As Integer, m As Integer, g As Integer, dp As Integer
282.     Dim v18 As _Unsigned _Integer64, sd As _Unsigned _Integer64, co As _Unsigned _Integer64
283.     Dim f18$, f1$, t$, build$, accum$
284.  
285.     If trim0$(a$) = "0" Then mult$ = "0": Exit Function
286.     If trim0$(b$) = "0" Then mult$ = "0": Exit Function
287.     If trim0$(a$) = "1" Then mult$ = trim0$(b$): Exit Function
288.     If trim0$(b$) = "1" Then mult$ = trim0$(a$): Exit Function
289.     'find the longer number and make it a mult of 18 to take 18 digits at a time from it
290.     la = Len(a$): lb = Len(b$)
291.     If la > lb Then
292.         m = Int(la / 18) + 1
293.         f18$ = Right$(String$(m * 18, "0") + a$, m * 18)
294.         f1$ = b$
295.     Else
296.         m = Int(lb / 18) + 1
297.         f18$ = Right$(String$(m * 18, "0") + b$, m * 18)
298.         f1$ = a$
299.     End If
300.     For dp = Len(f1$) To 1 Step -1 'dp = digit position of the f1$
301.         build$ = "" 'line builder
302.         co = 0
303.         'now taking 18 digits at a time Thanks Steve McNeill
304.         For g = 1 To m
305.             v18 = Val(Mid$(f18$, m * 18 - g * 18 + 1, 18))
306.             sd = Val(Mid$(f1$, dp, 1))
307.             t$ = Right$(String$(19, "0") + _Trim$(Str$(v18 * sd + co)), 19)
308.             co = Val(Mid$(t$, 1, 1))
309.             build$ = Mid$(t$, 2) + build$
310.         Next g
311.         If co Then build$ = _Trim$(Str$(co)) + build$
312.         If dp = Len(f1$) Then
313.             accum$ = build$
314.         Else
315.             accum$ = add$(accum$, build$ + String$(Len(f1$) - dp, "0"))
316.         End If
317.     Next dp
318.     mult$ = accum$
319. End Function
320.  
321. Function subtr$ (sum$, minus$) ' assume both numbers are positive all digits
322.     Dim m As Integer, g As Integer, p As Integer
323.     Dim VB As _Unsigned _Integer64, vs As _Unsigned _Integer64, tenE18 As _Unsigned _Integer64
324.     Dim ts$, tm$, sign$, LG$, sm$, t$, result$
325.  
326.     'ts$ = TrimLead0$(sum$): tm$ = TrimLead0$(minus$)   'orig with decent square root speed
327.     ts$ = _Trim$(sum$): tm$ = _Trim$(minus$) ' fixed subtr$ 2021-06-05
328.     If trim0(ts$) = trim0$(tm$) Then subtr$ = "0": Exit Function 'OK proceed with function knowing they are not equal
329.     tenE18 = 1000000000000000000 'yes!!! no dang E's
330.     If LTE(ts$, tm$) Then ' which is bigger? minus is bigger
331.         sign$ = "-"
332.         m = Int(Len(tm$) / 18) + 1
333.         LG$ = Right$(String$(m * 18, "0") + tm$, m * 18)
334.         sm$ = Right$(String$(m * 18, "0") + ts$, m * 18)
335.     Else 'sum is bigger
336.         sign$ = ""
337.         m = Int(Len(ts$) / 18) + 1
338.         LG$ = Right$(String$(m * 18, "0") + ts$, m * 18)
339.         sm$ = Right$(String$(m * 18, "0") + tm$, m * 18)
340.     End If
341.     'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
342.     For g = 1 To m
343.         VB = Val(Mid$(LG$, m * 18 - g * 18 + 1, 18))
344.         vs = Val(Mid$(sm$, m * 18 - g * 18 + 1, 18))
345.         If vs > VB Then
346.             t$ = Right$(String$(18, "0") + _Trim$(Str$(tenE18 - vs + VB)), 18)
347.             p = (m - g) * 18
348.             While p > 0 And Mid$(LG$, p, 1) = "0"
349.                 Mid$(LG$, p, 1) = "9"
350.                 p = p - 1
351.             Wend
352.             If p > 0 Then Mid$(LG$, p, 1) = _Trim$(Str$(Val(Mid$(LG$, p, 1)) - 1))
353.         Else
354.             t$ = Right$(String$(18, "0") + _Trim$(Str$(VB - vs)), 18)
355.         End If
356.         result$ = t$ + result$
357.     Next
358.     subtr$ = sign$ + result$
359. End Function
360.  
361. Function add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
362.     'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
363.     Dim la As Integer, lb As Integer, m As Integer, g As Integer
364.     Dim sa As _Unsigned _Integer64, sb As _Unsigned _Integer64, co As _Unsigned _Integer64
365.     Dim fa$, fb$, t$, new$, result$
366.     la = Len(a$): lb = Len(b$)
367.     If la > lb Then m = Int(la / 18) + 1 Else m = Int(lb / 18) + 1
368.     fa$ = Right$(String$(m * 18, "0") + a$, m * 18)
369.     fb$ = Right$(String$(m * 18, "0") + b$, m * 18)
370.  
371.     'now taking 18 digits at a time Thanks Steve McNeill
372.     For g = 1 To m
373.         sa = Val(Mid$(fa$, m * 18 - g * 18 + 1, 18))
374.         sb = Val(Mid$(fb$, m * 18 - g * 18 + 1, 18))
375.         t$ = Right$(String$(36, "0") + _Trim$(Str$(sa + sb + co)), 36)
376.         co = Val(Mid$(t$, 1, 18))
377.         new$ = Mid$(t$, 19)
378.         result$ = new$ + result$
379.     Next
380.     If co Then result$ = Str$(co) + result$
381.     add$ = result$
382. End Function
383.  
384. ' String Math Helpers -----------------------------------------------
385.  
386. 'this function needs TrimLead0$(s$)
387. Function LTE (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings
388.     Dim ca$, cb$, la As Integer, lb As Integer, i As Integer
389.     ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
390.     la = Len(ca$): lb = Len(cb$)
391.     If ca$ = cb$ Then
392.         LTE = -1
393.     ElseIf la < lb Then ' a is smaller
394.         LTE = -1
395.     ElseIf la > lb Then ' a is bigger
396.         LTE = 0
397.     ElseIf la = lb Then ' equal lengths
398.         For i = 1 To Len(ca$)
399.             If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
400.                 LTE = 0: Exit Function
401.             ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
402.                 LTE = -1: Exit Function
403.             End If
404.         Next
405.     End If
406. End Function
407.  
408. ' ------------------------------------- use these for final display
409.  
410. Function TrimLead0$ (s$) 'for treating strings as number (pos integers)
411.     Dim copys$, i As Integer, find As Integer
412.     copys$ = _Trim$(s$) 'might as well remove spaces too
413.     i = 1: find = 0
414.     While i < Len(copys$) And Mid$(copys$, i, 1) = "0"
415.         i = i + 1: find = 1
416.     Wend
417.     If find = 1 Then copys$ = Mid$(copys$, i)
418.     If copys$ = "" Then TrimLead0$ = "0" Else TrimLead0$ = copys$
419. End Function
420.  
421. Function TrimTail0$ (s$)
422.     Dim copys$, dp As Integer, i As Integer, find As Integer
423.     copys$ = _Trim$(s$) 'might as well remove spaces too
424.     TrimTail0$ = copys$
425.     dp = InStr(copys$, ".")
426.     If dp > 0 Then
427.         i = Len(copys$): find = 0
428.         While i > dp And Mid$(copys$, i, 1) = "0"
429.             i = i - 1: find = 1
430.         Wend
431.         If find = 1 Then
432.             If i = dp Then
433.                 TrimTail0$ = Mid$(copys$, 1, dp - 1)
434.             Else
435.                 TrimTail0$ = Mid$(copys$, 1, i)
436.             End If
437.         End If
438.     End If
439. End Function
440.  
441. Function trim0$ (s$)
442.     Dim cs$, si$
443.     cs$ = s$
444.     si$ = Left$(cs$, 1)
445.     If si$ = "-" Then cs$ = Mid$(cs$, 2)
446.     cs$ = TrimLead0$(cs$)
447.     cs$ = TrimTail0$(cs$)
448.     If Right$(cs$, 1) = "." Then cs$ = Mid$(cs$, 1, Len(cs$) - 1)
449.     If si$ = "-" Then trim0$ = si$ + cs$ Else trim0$ = cs$
450. End Function
451.  
452. ' for displaying truncated numbers say to 60 digits
453. Function showDP$ (num$, nDP As Integer)
454.     Dim cNum$, dp As Integer, d As Integer, i As Integer
455.     cNum$ = num$ 'since num$ could get changed
456.     showDP$ = num$
457.     dp = InStr(num$, ".")
458.     If dp > 0 Then
459.         If Len(Mid$(cNum$, dp + 1)) > nDP Then
460.             d = Val(Mid$(cNum$, dp + nDP + 1, 1))
461.             If d > 4 Then
462.                 cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
463.                 dp = dp + 1
464.                 i = dp + nDP
465.                 While Mid$(cNum$, i, 1) = "9" Or Mid$(cNum$, i, 1) = "."
466.                     If Mid$(cNum$, i, 1) = "9" Then
467.                         Mid$(cNum$, i, 1) = "0"
468.                     End If
469.                     i = i - 1
470.                 Wend
471.                 Mid$(cNum$, i, 1) = _Trim$(Str$(Val(Mid$(cNum$, i, 1)) + 1)) 'last non 9 digit
472.                 cNum$ = Mid$(cNum$, 1, dp + nDP) 'chop it
473.                 showDP$ = trim0$(cNum$)
474.             Else
475.                 showDP$ = Mid$(cNum$, 1, dp + nDP)
476.             End If
477.         End If
478.     End If
479. End Function
480.  
481.  

[jack]

hi bplus
I don't understand your nInverse function, here's how I would implement the reciprocal
pseudo code
dim x as double
x=1#/val(n$) ' approximation
r$=_trim$(str$(x))  '<< you need to sift-out exponential notation
' Newton-Raphson iteration to improve the reciprocal - it doubles the accuracy per iteration
do
r$=r$*(2-n$*r$)
loop until satisfied '<< (2-n$*r$) approaches 1
or
do
r$=r$+r$*(1-r$*n$)
loop until satisfied '<<r$*(1-r$*n$) approaches 0

if you do r$=r$+r$*(1-r$*n$) then you could check r$*(1-r$*n$) until it's small enough
3 iterations would give over 120 digits accuracy

[jack]

your multiply don't work

Code: QB64: [Select]

1. Print mr$("1.000000000000000000000001000000000000000000000001", "*", "0.000000000000000000000000000000000000000000000001")
2.  

output
.1000000000000000000000001000000000000000000000001
was trying to test my nInverse but it fails due to the multiply bug

Code: QB64: [Select]

1. Function nInverse2$ (n$, DP As Integer) 'assume decimal at very start of the string of digits returned, no rounding
2.     Dim x As Double
3.     Dim As Integer d, e, k, l
4.     Dim As String r, r2
5.     If n$ = "0" Then nInverse2$ = "Div 0": Exit Function
6.     If n$ = "1" Then nInverse2$ = "1": Exit Function
7.     x = 1# / Val(n$)
8.     r = _Trim$(Str$(x))
9.     d = InStr(r, "D")
10.     If d > 0 Then
11.         e = Val(Mid$(r, d + 1))
12.         r = Left$(r, 1) + Mid$(Left$(r, d - 1), 3)
13.         l = Len(r)
14.         If e > 0 Then
15.             r = r + String$(e - l + 1, "0")
16.         ElseIf e < 0 Then
17.             r = "0." + String$(Abs(e) - 1, "0") + r
18.         End If
19.     End If
20.  
21.     For k = 1 To 7
22.         r2 = mr$(n$, "*", r)
23.         r2 = mr$("2", "-", r2)
24.         r = mr$(r, "*", r2)
25.     Next k
26.     nInverse2$ = r
27. End Function
28.  

[bplus]

Simple fix on multiply again problem with trimming leading 0's.

@jack I like your inverse function and started playing with in attempts to control when it should quit.
It works well finding inverse of STx number and the 115 terms of Fibonacci in that sequence.

I am not satisfied with significant digits because a difference between 816 and 817 was just one more iteration in your code loop yet it went from finding 64 terms in 4.22 secs to all 115 terms in around 13 secs. My inverse with fixed subtr$() was taking over 19 secs and needing about 2785 digits.

So your inverse better. I see you are working on reciprical, interesting!

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. ' 2021-06-06 fixed divide, subtr and mult, all were trimming lead 0's and messing up decimal settings.
6. ' 2021-06-06 test jack's nInverse2$() on STx # to find 115 terms of Fibannci.
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. ' jack error reported 2021-06-04 confirmed!   fixed
14. 'Print mr$(".00000000000000000000000000000000000000000000200000000000000054307978001764", "-", ".000000000000000000000000000000000000000000002")
15. 'Print ".00000000000000000000000000000000000000000000000000000000000054307978001764"
16.  
17. Dim r$, ruler$
18. ruler$ = "0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890" + Chr$(10)
19. ruler$ = ruler$ + "0         1         2         3         4         5         6         7         8         9        10        11        12"
20. ' debug tests
21. 'Print mr$("-5", "+", "-2100"), " OK if -2105"
22. 'Print mr$("." + String$(20, "0") + "1", "+", "1" + String$(40, "0") + "1") ' first real test of add
23. 'Print ruler$
24. 'Print Val("." + String$(20, "0") + "1") + Val("1" + String$(40, "0") + "1") ' test print of big and small val
25. 'Print mr$("-.00071", "+", ".00036" + String$(35, "0") + "9")
26. '-.00071
27. ' .00036000000000000000000000000000000000009
28. 'Print "-.00034999999999999999999999999999999999991"
29. 'Print ruler$
30. 'testing a different subtract sub
31. 'Print mr$("10", "-", "5"), " 5 OK"
32. 'Print mr$("-10", "+", "5"), " -5 OK"
33. 'Print mr$("-10", "-", "-5"), " -5 OK"
34. 'Print mr$("-10", "-", "5"), " -15  OK  added"
35. 'Print mr$("10", "-", "-5"), " 15  OK  added"
36. 'Print mr$("-.010", "-", "-5"), "4.99 OK"
37. 'Print mr$("-.010", "-", "5"), "-5.01  OK just added"
38. 'Print mr$(".010", "-", "5"), " -4.99 OK"
39. ' jack error reported 2021-06-04 confirmed!  variation below
40. 'r$ = mr$(".00000000200000000000000054307978001764", "-", ".0000000020000000000000001") '16 0 wrong  8 wrong
41. 'Print "   mr$ rtnd:"; r$
42. 'Print "    compare:.00000000000000000000000044307978001764" ' 2021-06-05 finally!
43. '                  .0000000020000000000000001
44. '                  .00000000200000000000000054307978001764
45.  
46. 'r$ = mr$(".00000000000000000100000000000000000011", "-", ".000000000000000001000000000000000001") ' bad too
47. 'Print "   mr$ rtnd:"; r$
48. '         ".000000000000000001000000000000000001"
49. 'Print "    compare:-.00000000000000000000000000000000000089"
50. 'r$ = mr$(".00000000000000000100000000000000000111", "-", ".000000000000000002000000000000000001")
51. '       ".000000000000000002000000000000000001"
52. '       ".00000000000000000100000000000000000111"
53. '       ".00000000000000000099999999999999999989"
54. 'Print "   mr$ rtnd:"; r$
55. 'Print "    compare:-.00000000000000000099999999999999999989"
56.  
57. 'r$ = mr$(".00000000000000000000000000999", "-", "1")
58. '-1.00000000000000000000000000000000000000000
59. '  .00000000000000000000000000999
60. ' -.99999999999999999999999999001
61. 'Print "   mr$ rtnd:"; r$
62. 'Print "    compare:-.99999999999999999999999999001"
63.  
64. 'r$ = mr$("1", "+", "-1000000000000000000000000000000000000000")
65. 'Print "   mr$ rtnd:"; r$
66. '1000000000000000000000000000000000000000
67. '-999999999999999999999999999999999999999
68. 'Print "    compare:-999999999999999999999999999999999999999"
69.  
70. ' check jack problems with FB translation  2021-06-03  errors must be in FB trans from QB64
71. 'Print Mid$(mr$(" .1", "/", "3"), 1, 100) ' too long?
72. 'Print Mid$(mr$("1.1", "/", "9"), 1, 100)
73. 'Print Mid$(mr$("1.38", "/", "1.2"), 1, 100)
74. 'Print ruler$
75.  
76. ' another error reported by jack 2021-06-06 fixed (same problem as subtr$)
77. Print mr$("1.000000000000000000000001000000000000000000000001", "*", ".000000000000000000000000000000000000000000000001")
78. Print ".000000000000000000000000000000000000000000000001"
79. Print "                                                1000000000000000000000001000000000000000000000001"
80. Print ruler$
81. 'Print "checking inverse of 50 = .02 "; nInverse$("50", 20) 'OK  .020000... length 20
82. 'Print ruler$
83. 'Print
84. 'Print "zzz... see inverse of STx number now takes close to 30 secs with fixed subtr$() sub,"
85. 'Print "Use to come up in a sneeze! It also looks different way more space on end but still"
86. 'Print "can find 115 Fibonacci terms in it."
87. 'Print "    The only difference is I am not trimming leading 0's in subst$() function!"
88. 'Sleep
89. 'Cls
90. Dim inverseSTx$, start, done
91. start = Timer(.001)
92. 'inverseSTx$ = nInverse$("999999999999999999999998999999999999999999999999", 2785) ' wow big delay! 19.52 secs +-
93. inverseSTx$ = nInverse2$("999999999999999999999998999999999999999999999999", 817)
94. ' 816 in 4.22 secs only 64 terms   817 sigDigits matching in 12.93 secs gets all 115 Fibonacci Terms
95. done = Timer(.001) - start
96. Print Mid$(inverseSTx$, 1, 3000)
97. Print
98. Dim As Long startSearch, termN, find
99. Dim f1$, f2$, searchFor$
100. f1$ = "1"
101. f2$ = "1"
102. startSearch = 1
103. termN = 2
104. Do
105.     searchFor$ = mr$(f1$, "+", f2$)
106.     find = InStr(startSearch, inverseSTx$, searchFor$)
107.     If find Then
108.         termN = termN + 1
109.         Print "Term Number"; termN; " = "; searchFor$; " found at"; find
110.         f1$ = f2$
111.         f2$ = searchFor$
112.         startSearch = find + Len(searchFor$)
113.     Else
114.         Print searchFor$; " not found."
115.         Exit Do
116.     End If
117. Loop
118. Print "Inverse time:"; done
119.  
120.  
121. 'Dim n$, result$
122. 'Do
123. '    'remember everything is strings
124. '    Input "Enter a number to find it's square root "; n$
125. '    If n$ = "" Then End
126. '    result$ = sqrRoot$(n$)
127. '    Print result$
128. '    Print "Length ="; Len(result$)
129. '    _Delay 2
130. '    result$ = SRbyNR$(n$)
131. '    Print result$
132. '    Print "Length ="; Len(result$)
133. '    Print
134. 'Loop
135.  
136. Function sqrRoot$ (nmbr$)
137.     Dim n$, guess$, lastGuess$, other$, sum$, imaginary$, loopcnt
138.     If Left$(nmbr$, 1) = "-" Then 'handle neg numbers
139.         imaginary$ = "*i": n$ = Mid$(nmbr$, 2)
140.     Else
141.         imaginary$ = "": n$ = nmbr$
142.     End If
143.     guess$ = mr$(n$, "/", "2")
144.     other$ = n$
145.     Do
146.         loopcnt = loopcnt + 1
147.         Print "loop cnt"; loopcnt
148.  
149.         If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then ' go past 100 matching digits for 100 digit precision
150.             sqrRoot$ = Mid$(other$, 1, 101) + imaginary$ ' try other factor for guess$  sometimes it nails answer without all digits
151.             Exit Function
152.         Else
153.             lastGuess$ = guess$
154.             sum$ = mr$(guess$, "+", other$)
155.             guess$ = mr$(sum$, "/", "2")
156.             other$ = mr$(n$, "/", guess$)
157.         End If
158.     Loop
159. End Function
160.  
161. Function SRbyNR$ (nmbr$) ' square root by Newton - Ralphson method my interpretation of GeorgeMcGinn
162.  
163.     Dim n$, guess$, lastGuess$, dx$, imaginary$, other$, loopcnt
164.     If Left$(nmbr$, 1) = "-" Then 'handle neg numbers
165.         imaginary$ = "*i": n$ = Mid$(nmbr$, 2)
166.     Else
167.         imaginary$ = "": n$ = nmbr$
168.     End If
169.  
170.     guess$ = mr$(n$, "/", "2") ' get this going first and then try better starting guess later
171.  
172.     Do
173.         loopcnt = loopcnt + 1
174.         Print "loop cnt"; loopcnt
175.         If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then ' go past 100 matching digits for 100 digit precision
176.             SRbyNR$ = Mid$(other$, 1, 101) + imaginary$
177.             Exit Function
178.         Else
179.             'dx = (x - A / x) / 2: x = x - dx ' Thanks George
180.             lastGuess$ = guess$
181.             dx$ = mr$(mr$(guess$, "-", mr$(n$, "/", guess$)), "/", "2")
182.             guess$ = mr$(guess$, "-", dx$)
183.             other$ = mr$(n$, "/", guess$) ' try other factor for guess$  sometimes it nails answer without all digits
184.         End If
185.     Loop
186. End Function
187.  
188. 'jacks nInverse2$ modified from using 7 interations to ending when a certain amount of significant digits match between r's
189. Function nInverse2$ (n$, SigDigits As Long) 'assume decimal at very start of the string of digits returned, no rounding
190.     Dim x As Double
191.     Dim As Integer d, e, k, l
192.     Dim As String r, r2, lastR
193.     If n$ = "0" Then nInverse2$ = "Div 0": Exit Function
194.     If n$ = "1" Then nInverse2$ = "1": Exit Function
195.     x = 1# / Val(n$)
196.     r = _Trim$(Str$(x))
197.     d = InStr(r, "D")
198.     If d > 0 Then
199.         e = Val(Mid$(r, d + 1))
200.         r = Left$(r, 1) + Mid$(Left$(r, d - 1), 3)
201.         l = Len(r)
202.         If e > 0 Then
203.             r = r + String$(e - l + 1, "0")
204.         ElseIf e < 0 Then
205.             r = "0." + String$(Abs(e) - 1, "0") + r
206.         End If
207.     End If
208.     While Mid$(lastR, 1, SigDigits) <> Mid$(r, 1, SigDigits) ' use to be 7 interations
209.         lastR = r
210.         r2 = mr$(n$, "*", r)
211.         r2 = mr$("2", "-", r2)
212.         r = mr$(r, "*", r2)
213.     Wend
214.     nInverse2$ = r
215. End Function
216.  
217. Function mr$ (a$, op$, b$) ' catchy? mr$ for math regulator
218.     Dim ca$, cb$, aSgn$, bSgn$, postOp$, sgn$
219.     Dim adp As Integer, bdp As Integer, dp As Integer, lpop As Integer
220.  
221.     op$ = _Trim$(op$) 'save fixing each time
222.     ca$ = _Trim$(a$): cb$ = _Trim$(b$) 'make copies in case we change
223.     'strip signs and decimals
224.     If Left$(ca$, 1) = "-" Then
225.         aSgn$ = "-": ca$ = Mid$(ca$, 2)
226.     Else
227.         aSgn$ = "": ca$ = ca$
228.     End If
229.     dp = InStr(ca$, ".")
230.     If dp > 0 Then
231.         adp = Len(ca$) - dp
232.         ca$ = Mid$(ca$, 1, dp - 1) + Mid$(ca$, dp + 1)
233.     Else
234.         adp = 0
235.     End If
236.     If Left$(cb$, 1) = "-" Then
237.         bSgn$ = "-": cb$ = Mid$(cb$, 2)
238.     Else
239.         bSgn$ = "": cb$ = cb$
240.     End If
241.     dp = InStr(cb$, ".")
242.     If dp > 0 Then
243.         bdp = Len(cb$) - dp
244.         cb$ = Mid$(cb$, 1, dp - 1) + Mid$(cb$, dp + 1)
245.     Else
246.         bdp = 0
247.     End If
248.  
249.     If op$ = "+" Or op$ = "-" Or op$ = "/" Then 'add or subtr  even up strings on right of decimal
250.         'even up the right sides of decimals if any
251.         If adp > bdp Then dp = adp Else dp = bdp
252.         If adp < dp Then ca$ = ca$ + String$(dp - adp, "0")
253.         If bdp < dp Then cb$ = cb$ + String$(dp - bdp, "0")
254.     ElseIf op$ = "*" Then
255.         dp = adp + bdp
256.     End If
257.     If op$ = "*" Or op$ = "/" Then
258.         If aSgn$ = bSgn$ Then sgn$ = "" Else sgn$ = "-"
259.     End If
260.     'now according to signs and op$ call add$ or subtr$
261.     If op$ = "+" Then
262.         If aSgn$ = bSgn$ Then 'really add
263.             postOp$ = aSgn$ + add$(ca$, cb$)
264.         Else 'have a case of subtraction
265.             If aSgn$ = "-" Then postOp$ = subtr$(cb$, ca$) Else postOp$ = subtr$(ca$, cb$)
266.         End If
267.     ElseIf op$ = "-" Then
268.         If bSgn$ = "-" Then 'really add but switch b sign
269.             bSgn$ = ""
270.             If aSgn$ = "-" Then
271.                 postOp$ = subtr$(cb$, ca$)
272.             Else 'aSgn = ""
273.                 postOp$ = add$(ca$, cb$)
274.             End If
275.         Else 'bSgn$ =""
276.             If aSgn$ = "-" Then
277.                 bSgn$ = "-"
278.                 postOp$ = aSgn$ + add$(ca$, cb$)
279.             Else
280.                 postOp$ = subtr$(ca$, cb$)
281.             End If
282.         End If
283.     ElseIf op$ = "*" Then
284.         postOp$ = sgn$ + mult$(ca$, cb$)
285.     ElseIf op$ = "/" Then
286.         postOp$ = sgn$ + divide$(ca$, cb$)
287.     End If ' which op
288.     'put dp back
289.     If op$ <> "/" Then
290.         lpop = Len(postOp$) ' put decimal back
291.         postOp$ = Mid$(postOp$, 1, lpop - dp) + "." + Mid$(postOp$, lpop - dp + 1)
292.     End If
293.     mr$ = trim0$(postOp$)
294. End Function
295.  
296. Function divide$ (n$, d$) ' goal here is 100 digits precision not 100 digits past decimal
297.     Dim di$, ndi$, nD As Integer
298.     If _Trim$(n$) = "0" Then divide$ = "0": Exit Function
299.     If _Trim$(d$) = "0" Then divide$ = "div 0": Exit Function
300.     If _Trim$(d$) = "1" Then divide$ = _Trim$(n$): Exit Function
301.  
302.     ' aha! found a bug when d$ gets really huge 100 is no where near enough!!!!
303.     ' 2021-06-03 fix by adding 100 to len(d$), plus have to go a little past 100 for 100 digit precision
304.     ' need to go past 100 for 100 precise digits (not decimal places)
305.     di$ = Mid$(nInverse$(d$, Len(d$) + 200), 2) 'chop off decimal point after
306.     nD = Len(di$)
307.     ndi$ = mult$(n$, di$)
308.     ndi$ = Mid$(ndi$, 1, Len(ndi$) - nD) + "." + Right$(String$(nD, "0") + Right$(ndi$, nD), nD)
309.     divide$ = trim0$(ndi$)
310. End Function
311.  
312. Function nInverse$ (n$, DP As Integer) 'assume decimal at very start of the string of digits returned, no rounding
313.     Dim m$(1 To 9), si$, r$, outstr$, d$
314.     Dim i As Integer
315.     For i = 1 To 9
316.         si$ = _Trim$(Str$(i))
317.         m$(i) = mult$(si$, n$)
318.     Next
319.     outstr$ = ""
320.     If n$ = "0" Then nInverse$ = "Div 0": Exit Function
321.     If n$ = "1" Then nInverse$ = "1": Exit Function
322.     outstr$ = "." 'everything else n > 1 is decimal 8/17
323.     r$ = "10"
324.     Do
325.         While Left$(subtr$(r$, n$), 1) = "-" '   r - n < 0
326.             outstr$ = outstr$ + "0" '            add 0 to the  output string
327.             If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function 'check if we've reached DP length
328.             r$ = r$ + "0"
329.         Wend
330.         For i = 9 To 1 Step -1
331.             If LTE(m$(i), r$) Then d$ = _Trim$(Str$(i)): Exit For
332.         Next
333.         outstr$ = outstr$ + d$
334.         If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function
335.         r$ = subtr$(r$, mult$(d$, n$)) 'r = r -d*n
336.         If r$ = "0" Then nInverse$ = outstr$: Exit Function 'found a perfect divisor
337.         r$ = r$ + "0" 'add another place
338.     Loop
339. End Function
340.  
341. Function mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
342.     Dim la As Integer, lb As Integer, m As Integer, g As Integer, dp As Integer
343.     Dim v18 As _Unsigned _Integer64, sd As _Unsigned _Integer64, co As _Unsigned _Integer64
344.     Dim f18$, f1$, t$, build$, accum$
345.     ' fixed mult$ don't trim lead 0's 2021-06-06
346.     If _Trim$(a$) = "0" Then mult$ = "0": Exit Function
347.     If _Trim$(b$) = "0" Then mult$ = "0": Exit Function
348.     If _Trim$(a$) = "1" Then mult$ = _Trim$(b$): Exit Function
349.     If _Trim$(b$) = "1" Then mult$ = _Trim$(a$): Exit Function
350.     'find the longer number and make it a mult of 18 to take 18 digits at a time from it
351.     la = Len(a$): lb = Len(b$)
352.     If la > lb Then
353.         m = Int(la / 18) + 1
354.         f18$ = Right$(String$(m * 18, "0") + a$, m * 18)
355.         f1$ = b$
356.     Else
357.         m = Int(lb / 18) + 1
358.         f18$ = Right$(String$(m * 18, "0") + b$, m * 18)
359.         f1$ = a$
360.     End If
361.     For dp = Len(f1$) To 1 Step -1 'dp = digit position of the f1$
362.         build$ = "" 'line builder
363.         co = 0
364.         'now taking 18 digits at a time Thanks Steve McNeill
365.         For g = 1 To m
366.             v18 = Val(Mid$(f18$, m * 18 - g * 18 + 1, 18))
367.             sd = Val(Mid$(f1$, dp, 1))
368.             t$ = Right$(String$(19, "0") + _Trim$(Str$(v18 * sd + co)), 19)
369.             co = Val(Mid$(t$, 1, 1))
370.             build$ = Mid$(t$, 2) + build$
371.         Next g
372.         If co Then build$ = _Trim$(Str$(co)) + build$
373.         If dp = Len(f1$) Then
374.             accum$ = build$
375.         Else
376.             accum$ = add$(accum$, build$ + String$(Len(f1$) - dp, "0"))
377.         End If
378.     Next dp
379.     mult$ = accum$
380. End Function
381.  
382. Function subtr$ (sum$, minus$) ' assume both numbers are positive all digits
383.     Dim m As Integer, g As Integer, p As Integer
384.     Dim VB As _Unsigned _Integer64, vs As _Unsigned _Integer64, tenE18 As _Unsigned _Integer64
385.     Dim ts$, tm$, sign$, LG$, sm$, t$, result$
386.  
387.     'ts$ = TrimLead0$(sum$): tm$ = TrimLead0$(minus$)   'orig with decent square root speed
388.     ts$ = _Trim$(sum$): tm$ = _Trim$(minus$) ' fixed subtr$ 2021-06-05
389.     If trim0(ts$) = trim0$(tm$) Then subtr$ = "0": Exit Function 'OK proceed with function knowing they are not equal
390.     tenE18 = 1000000000000000000 'yes!!! no dang E's
391.     If LTE(ts$, tm$) Then ' which is bigger? minus is bigger
392.         sign$ = "-"
393.         m = Int(Len(tm$) / 18) + 1
394.         LG$ = Right$(String$(m * 18, "0") + tm$, m * 18)
395.         sm$ = Right$(String$(m * 18, "0") + ts$, m * 18)
396.     Else 'sum is bigger
397.         sign$ = ""
398.         m = Int(Len(ts$) / 18) + 1
399.         LG$ = Right$(String$(m * 18, "0") + ts$, m * 18)
400.         sm$ = Right$(String$(m * 18, "0") + tm$, m * 18)
401.     End If
402.     'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
403.     For g = 1 To m
404.         VB = Val(Mid$(LG$, m * 18 - g * 18 + 1, 18))
405.         vs = Val(Mid$(sm$, m * 18 - g * 18 + 1, 18))
406.         If vs > VB Then
407.             t$ = Right$(String$(18, "0") + _Trim$(Str$(tenE18 - vs + VB)), 18)
408.             p = (m - g) * 18
409.             While p > 0 And Mid$(LG$, p, 1) = "0"
410.                 Mid$(LG$, p, 1) = "9"
411.                 p = p - 1
412.             Wend
413.             If p > 0 Then Mid$(LG$, p, 1) = _Trim$(Str$(Val(Mid$(LG$, p, 1)) - 1))
414.         Else
415.             t$ = Right$(String$(18, "0") + _Trim$(Str$(VB - vs)), 18)
416.         End If
417.         result$ = t$ + result$
418.     Next
419.     subtr$ = sign$ + result$
420. End Function
421.  
422. Function add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
423.     'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
424.     Dim la As Integer, lb As Integer, m As Integer, g As Integer
425.     Dim sa As _Unsigned _Integer64, sb As _Unsigned _Integer64, co As _Unsigned _Integer64
426.     Dim fa$, fb$, t$, new$, result$
427.     la = Len(a$): lb = Len(b$)
428.     If la > lb Then m = Int(la / 18) + 1 Else m = Int(lb / 18) + 1
429.     fa$ = Right$(String$(m * 18, "0") + a$, m * 18)
430.     fb$ = Right$(String$(m * 18, "0") + b$, m * 18)
431.  
432.     'now taking 18 digits at a time Thanks Steve McNeill
433.     For g = 1 To m
434.         sa = Val(Mid$(fa$, m * 18 - g * 18 + 1, 18))
435.         sb = Val(Mid$(fb$, m * 18 - g * 18 + 1, 18))
436.         t$ = Right$(String$(36, "0") + _Trim$(Str$(sa + sb + co)), 36)
437.         co = Val(Mid$(t$, 1, 18))
438.         new$ = Mid$(t$, 19)
439.         result$ = new$ + result$
440.     Next
441.     If co Then result$ = Str$(co) + result$
442.     add$ = result$
443. End Function
444.  
445. ' String Math Helpers -----------------------------------------------
446.  
447. 'this function needs TrimLead0$(s$) a and b have decimal removed and a and b lengths aligned on right
448. Function LTE (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings
449.     Dim ca$, cb$, la As Integer, lb As Integer, i As Integer
450.     ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
451.     la = Len(ca$): lb = Len(cb$)
452.     If ca$ = cb$ Then
453.         LTE = -1
454.     ElseIf la < lb Then ' a is smaller
455.         LTE = -1
456.     ElseIf la > lb Then ' a is bigger
457.         LTE = 0
458.     ElseIf la = lb Then ' equal lengths
459.         For i = 1 To Len(ca$)
460.             If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
461.                 LTE = 0: Exit Function
462.             ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
463.                 LTE = -1: Exit Function
464.             End If
465.         Next
466.     End If
467. End Function
468.  
469. ' ------------------------------------- use these for final display
470.  
471. Function TrimLead0$ (s$) 'for treating strings as number (pos integers)
472.     Dim copys$, i As Integer, find As Integer
473.     copys$ = _Trim$(s$) 'might as well remove spaces too
474.     i = 1: find = 0
475.     While i < Len(copys$) And Mid$(copys$, i, 1) = "0"
476.         i = i + 1: find = 1
477.     Wend
478.     If find = 1 Then copys$ = Mid$(copys$, i)
479.     If copys$ = "" Then TrimLead0$ = "0" Else TrimLead0$ = copys$
480. End Function
481.  
482. Function TrimTail0$ (s$)
483.     Dim copys$, dp As Integer, i As Integer, find As Integer
484.     copys$ = _Trim$(s$) 'might as well remove spaces too
485.     TrimTail0$ = copys$
486.     dp = InStr(copys$, ".")
487.     If dp > 0 Then
488.         i = Len(copys$): find = 0
489.         While i > dp And Mid$(copys$, i, 1) = "0"
490.             i = i - 1: find = 1
491.         Wend
492.         If find = 1 Then
493.             If i = dp Then
494.                 TrimTail0$ = Mid$(copys$, 1, dp - 1)
495.             Else
496.                 TrimTail0$ = Mid$(copys$, 1, i)
497.             End If
498.         End If
499.     End If
500. End Function
501.  
502. Function trim0$ (s$)
503.     Dim cs$, si$
504.     cs$ = s$
505.     si$ = Left$(cs$, 1)
506.     If si$ = "-" Then cs$ = Mid$(cs$, 2)
507.     cs$ = TrimLead0$(cs$)
508.     cs$ = TrimTail0$(cs$)
509.     If Right$(cs$, 1) = "." Then cs$ = Mid$(cs$, 1, Len(cs$) - 1)
510.     If si$ = "-" Then trim0$ = si$ + cs$ Else trim0$ = cs$
511. End Function
512.  
513. ' for displaying truncated numbers say to 60 digits
514. Function showDP$ (num$, nDP As Integer)
515.     Dim cNum$, dp As Integer, d As Integer, i As Integer
516.     cNum$ = num$ 'since num$ could get changed
517.     showDP$ = num$
518.     dp = InStr(num$, ".")
519.     If dp > 0 Then
520.         If Len(Mid$(cNum$, dp + 1)) > nDP Then
521.             d = Val(Mid$(cNum$, dp + nDP + 1, 1))
522.             If d > 4 Then
523.                 cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
524.                 dp = dp + 1
525.                 i = dp + nDP
526.                 While Mid$(cNum$, i, 1) = "9" Or Mid$(cNum$, i, 1) = "."
527.                     If Mid$(cNum$, i, 1) = "9" Then
528.                         Mid$(cNum$, i, 1) = "0"
529.                     End If
530.                     i = i - 1
531.                 Wend
532.                 Mid$(cNum$, i, 1) = _Trim$(Str$(Val(Mid$(cNum$, i, 1)) + 1)) 'last non 9 digit
533.                 cNum$ = Mid$(cNum$, 1, dp + nDP) 'chop it
534.                 showDP$ = trim0$(cNum$)
535.             Else
536.                 showDP$ = Mid$(cNum$, 1, dp + nDP)
537.             End If
538.         End If
539.     End If
540. End Function
541.  
542.  
543.  

[jack]

bplus
if you would set all your routines to a limit of say 128 digits - integer + fractional, then your operations would be relatively fast, nInverse would require only 3 iterations to give 128 digits of accuracy - you could dispense the loop and loop-test
as it is, your strings grow huge and the routines become very slow, that's why in my sqrt$ routine I would keep trimming the resulting strings
< edit > or you could go to 256 digits, nInverse would only require 4 iterations

[jack]

here's a different way to print the Fibonacci numbers

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. ' 2021-06-06 fixed divide, subtr and mult, all were trimming lead 0's and messing up decimal settings.
6. ' 2021-06-06 test jack's nInverse2$() on STx # to find 115 terms of Fibannci.
7.  
8. Randomize Timer 'now that it's seems to be running silent
9. Screen _NewImage(1200, 1000, 32)
10. _Delay .25
11. _ScreenMove _Middle
12.  
13. ' jack error reported 2021-06-04 confirmed!   fixed
14. 'Print mr$(".00000000000000000000000000000000000000000000200000000000000054307978001764", "-", ".000000000000000000000000000000000000000000002")
15. 'Print ".00000000000000000000000000000000000000000000000000000000000054307978001764"
16.  
17. Dim r$, ruler$
18. ruler$ = "0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890" + Chr$(10)
19. ruler$ = ruler$ + "0         1         2         3         4         5         6         7         8         9        10        11        12"
20. ' debug tests
21. 'Print mr$("-5", "+", "-2100"), " OK if -2105"
22. 'Print mr$("." + String$(20, "0") + "1", "+", "1" + String$(40, "0") + "1") ' first real test of add
23. 'Print ruler$
24. 'Print Val("." + String$(20, "0") + "1") + Val("1" + String$(40, "0") + "1") ' test print of big and small val
25. 'Print mr$("-.00071", "+", ".00036" + String$(35, "0") + "9")
26. '-.00071
27. ' .00036000000000000000000000000000000000009
28. 'Print "-.00034999999999999999999999999999999999991"
29. 'Print ruler$
30. 'testing a different subtract sub
31. 'Print mr$("10", "-", "5"), " 5 OK"
32. 'Print mr$("-10", "+", "5"), " -5 OK"
33. 'Print mr$("-10", "-", "-5"), " -5 OK"
34. 'Print mr$("-10", "-", "5"), " -15  OK  added"
35. 'Print mr$("10", "-", "-5"), " 15  OK  added"
36. 'Print mr$("-.010", "-", "-5"), "4.99 OK"
37. 'Print mr$("-.010", "-", "5"), "-5.01  OK just added"
38. 'Print mr$(".010", "-", "5"), " -4.99 OK"
39. ' jack error reported 2021-06-04 confirmed!  variation below
40. 'r$ = mr$(".00000000200000000000000054307978001764", "-", ".0000000020000000000000001") '16 0 wrong  8 wrong
41. 'Print "   mr$ rtnd:"; r$
42. 'Print "    compare:.00000000000000000000000044307978001764" ' 2021-06-05 finally!
43. '                  .0000000020000000000000001
44. '                  .00000000200000000000000054307978001764
45.  
46. 'r$ = mr$(".00000000000000000100000000000000000011", "-", ".000000000000000001000000000000000001") ' bad too
47. 'Print "   mr$ rtnd:"; r$
48. '         ".000000000000000001000000000000000001"
49. 'Print "    compare:-.00000000000000000000000000000000000089"
50. 'r$ = mr$(".00000000000000000100000000000000000111", "-", ".000000000000000002000000000000000001")
51. '       ".000000000000000002000000000000000001"
52. '       ".00000000000000000100000000000000000111"
53. '       ".00000000000000000099999999999999999989"
54. 'Print "   mr$ rtnd:"; r$
55. 'Print "    compare:-.00000000000000000099999999999999999989"
56.  
57. 'r$ = mr$(".00000000000000000000000000999", "-", "1")
58. '-1.00000000000000000000000000000000000000000
59. '  .00000000000000000000000000999
60. ' -.99999999999999999999999999001
61. 'Print "   mr$ rtnd:"; r$
62. 'Print "    compare:-.99999999999999999999999999001"
63.  
64. 'r$ = mr$("1", "+", "-1000000000000000000000000000000000000000")
65. 'Print "   mr$ rtnd:"; r$
66. '1000000000000000000000000000000000000000
67. '-999999999999999999999999999999999999999
68. 'Print "    compare:-999999999999999999999999999999999999999"
69.  
70. ' check jack problems with FB translation  2021-06-03  errors must be in FB trans from QB64
71. 'Print Mid$(mr$(" .1", "/", "3"), 1, 100) ' too long?
72. 'Print Mid$(mr$("1.1", "/", "9"), 1, 100)
73. 'Print Mid$(mr$("1.38", "/", "1.2"), 1, 100)
74. 'Print ruler$
75.  
76. ' another error reported by jack 2021-06-06 fixed (same problem as subtr$)
77. Print mr$("1.000000000000000000000001000000000000000000000001", "*", ".000000000000000000000000000000000000000000000001")
78. Print ".000000000000000000000000000000000000000000000001"
79. Print "                                                1000000000000000000000001000000000000000000000001"
80. Print ruler$
81. 'Print "checking inverse of 50 = .02 "; nInverse$("50", 20) 'OK  .020000... length 20
82. 'Print ruler$
83. 'Print
84. 'Print "zzz... see inverse of STx number now takes close to 30 secs with fixed subtr$() sub,"
85. 'Print "Use to come up in a sneeze! It also looks different way more space on end but still"
86. 'Print "can find 115 Fibonacci terms in it."
87. 'Print "    The only difference is I am not trimming leading 0's in subst$() function!"
88. 'Sleep
89. 'Cls
90. Dim inverseSTx$, start, done
91. start = Timer(.001)
92. 'inverseSTx$ = nInverse$("999999999999999999999998999999999999999999999999", 2785) ' wow big delay! 19.52 secs +-
93. inverseSTx$ = nInverse2$("999999999999999999999998999999999999999999999999", 817)
94. ' 816 in 4.22 secs only 64 terms   817 sigDigits matching in 12.93 secs gets all 115 Fibonacci Terms
95. done = Timer(.001) - start
96.  
97. Print Mid$(inverseSTx$, 1, 3000)
98. Print
99. Dim As Long startSearch, termN, find
100. Dim f1$, f2$, searchFor$
101. Dim As Long i, j
102. Print "inverseSTx$ length = "; Len(inverseSTx$)
103. j = InStr(inverseSTx$, ".")
104. inverseSTx$ = Mid$(inverseSTx$, j + 1)
105. j = 1
106. For i = 1 To 58
107.     Print Mid$(inverseSTx$, j, 24), Mid$(inverseSTx$, j + 24, 24)
108.     j = j + 48
109. Next
110.  
111. 'f1$ = "1"
112. 'f2$ = "1"
113. 'startSearch = 1
114. 'termN = 2
115. 'Do
116. '    searchFor$ = mr$(f1$, "+", f2$)
117. '    find = InStr(startSearch, inverseSTx$, searchFor$)
118. '    If find Then
119. '        termN = termN + 1
120. '        Print "Term Number"; termN; " = "; searchFor$; " found at"; find
121. '        f1$ = f2$
122. '        f2$ = searchFor$
123. '        startSearch = find + Len(searchFor$)
124. '    Else
125. '        Print searchFor$; " not found."
126. '        Exit Do
127. '    End If
128. 'Loop
129. 'Print "Inverse time:"; done
130.  
131.  
132. 'Dim n$, result$
133. 'Do
134. '    'remember everything is strings
135. '    Input "Enter a number to find it's square root "; n$
136. '    If n$ = "" Then End
137. '    result$ = sqrRoot$(n$)
138. '    Print result$
139. '    Print "Length ="; Len(result$)
140. '    _Delay 2
141. '    result$ = SRbyNR$(n$)
142. '    Print result$
143. '    Print "Length ="; Len(result$)
144. '    Print
145. 'Loop
146.  
147. Function sqrRoot$ (nmbr$)
148.     Dim n$, guess$, lastGuess$, other$, sum$, imaginary$, loopcnt
149.     If Left$(nmbr$, 1) = "-" Then 'handle neg numbers
150.         imaginary$ = "*i": n$ = Mid$(nmbr$, 2)
151.     Else
152.         imaginary$ = "": n$ = nmbr$
153.     End If
154.     guess$ = mr$(n$, "/", "2")
155.     other$ = n$
156.     Do
157.         loopcnt = loopcnt + 1
158.         Print "loop cnt"; loopcnt
159.  
160.         If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then ' go past 100 matching digits for 100 digit precision
161.             sqrRoot$ = Mid$(other$, 1, 101) + imaginary$ ' try other factor for guess$  sometimes it nails answer without all digits
162.             Exit Function
163.         Else
164.             lastGuess$ = guess$
165.             sum$ = mr$(guess$, "+", other$)
166.             guess$ = mr$(sum$, "/", "2")
167.             other$ = mr$(n$, "/", guess$)
168.         End If
169.     Loop
170. End Function
171.  
172. Function SRbyNR$ (nmbr$) ' square root by Newton - Ralphson method my interpretation of GeorgeMcGinn
173.  
174.     Dim n$, guess$, lastGuess$, dx$, imaginary$, other$, loopcnt
175.     If Left$(nmbr$, 1) = "-" Then 'handle neg numbers
176.         imaginary$ = "*i": n$ = Mid$(nmbr$, 2)
177.     Else
178.         imaginary$ = "": n$ = nmbr$
179.     End If
180.  
181.     guess$ = mr$(n$, "/", "2") ' get this going first and then try better starting guess later
182.  
183.     Do
184.         loopcnt = loopcnt + 1
185.         Print "loop cnt"; loopcnt
186.         If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then ' go past 100 matching digits for 100 digit precision
187.             SRbyNR$ = Mid$(other$, 1, 101) + imaginary$
188.             Exit Function
189.         Else
190.             'dx = (x - A / x) / 2: x = x - dx ' Thanks George
191.             lastGuess$ = guess$
192.             dx$ = mr$(mr$(guess$, "-", mr$(n$, "/", guess$)), "/", "2")
193.             guess$ = mr$(guess$, "-", dx$)
194.             other$ = mr$(n$, "/", guess$) ' try other factor for guess$  sometimes it nails answer without all digits
195.         End If
196.     Loop
197. End Function
198.  
199. 'jacks nInverse2$ modified from using 7 interations to ending when a certain amount of significant digits match between r's
200. Function nInverse2$ (n$, SigDigits As Long) 'assume decimal at very start of the string of digits returned, no rounding
201.     Dim x As Double
202.     Dim As Integer d, e, k, l
203.     Dim As String r, r2, lastR
204.     If n$ = "0" Then nInverse2$ = "Div 0": Exit Function
205.     If n$ = "1" Then nInverse2$ = "1": Exit Function
206.     x = 1# / Val(n$)
207.     r = _Trim$(Str$(x))
208.     d = InStr(r, "D")
209.     If d > 0 Then
210.         e = Val(Mid$(r, d + 1))
211.         r = Left$(r, 1) + Mid$(Left$(r, d - 1), 3)
212.         l = Len(r)
213.         If e > 0 Then
214.             r = r + String$(e - l + 1, "0")
215.         ElseIf e < 0 Then
216.             r = "0." + String$(Abs(e) - 1, "0") + r
217.         End If
218.     End If
219.     While Mid$(lastR, 1, SigDigits) <> Mid$(r, 1, SigDigits) ' use to be 7 interations
220.         lastR = r
221.         r2 = mr$(n$, "*", r)
222.         r2 = mr$("2", "-", r2)
223.         r = mr$(r, "*", r2)
224.     Wend
225.     nInverse2$ = r
226. End Function
227.  
228. Function mr$ (a$, op$, b$) ' catchy? mr$ for math regulator
229.     Dim ca$, cb$, aSgn$, bSgn$, postOp$, sgn$
230.     Dim adp As Integer, bdp As Integer, dp As Integer, lpop As Integer
231.  
232.     op$ = _Trim$(op$) 'save fixing each time
233.     ca$ = _Trim$(a$): cb$ = _Trim$(b$) 'make copies in case we change
234.     'strip signs and decimals
235.     If Left$(ca$, 1) = "-" Then
236.         aSgn$ = "-": ca$ = Mid$(ca$, 2)
237.     Else
238.         aSgn$ = "": ca$ = ca$
239.     End If
240.     dp = InStr(ca$, ".")
241.     If dp > 0 Then
242.         adp = Len(ca$) - dp
243.         ca$ = Mid$(ca$, 1, dp - 1) + Mid$(ca$, dp + 1)
244.     Else
245.         adp = 0
246.     End If
247.     If Left$(cb$, 1) = "-" Then
248.         bSgn$ = "-": cb$ = Mid$(cb$, 2)
249.     Else
250.         bSgn$ = "": cb$ = cb$
251.     End If
252.     dp = InStr(cb$, ".")
253.     If dp > 0 Then
254.         bdp = Len(cb$) - dp
255.         cb$ = Mid$(cb$, 1, dp - 1) + Mid$(cb$, dp + 1)
256.     Else
257.         bdp = 0
258.     End If
259.  
260.     If op$ = "+" Or op$ = "-" Or op$ = "/" Then 'add or subtr  even up strings on right of decimal
261.         'even up the right sides of decimals if any
262.         If adp > bdp Then dp = adp Else dp = bdp
263.         If adp < dp Then ca$ = ca$ + String$(dp - adp, "0")
264.         If bdp < dp Then cb$ = cb$ + String$(dp - bdp, "0")
265.     ElseIf op$ = "*" Then
266.         dp = adp + bdp
267.     End If
268.     If op$ = "*" Or op$ = "/" Then
269.         If aSgn$ = bSgn$ Then sgn$ = "" Else sgn$ = "-"
270.     End If
271.     'now according to signs and op$ call add$ or subtr$
272.     If op$ = "+" Then
273.         If aSgn$ = bSgn$ Then 'really add
274.             postOp$ = aSgn$ + add$(ca$, cb$)
275.         Else 'have a case of subtraction
276.             If aSgn$ = "-" Then postOp$ = subtr$(cb$, ca$) Else postOp$ = subtr$(ca$, cb$)
277.         End If
278.     ElseIf op$ = "-" Then
279.         If bSgn$ = "-" Then 'really add but switch b sign
280.             bSgn$ = ""
281.             If aSgn$ = "-" Then
282.                 postOp$ = subtr$(cb$, ca$)
283.             Else 'aSgn = ""
284.                 postOp$ = add$(ca$, cb$)
285.             End If
286.         Else 'bSgn$ =""
287.             If aSgn$ = "-" Then
288.                 bSgn$ = "-"
289.                 postOp$ = aSgn$ + add$(ca$, cb$)
290.             Else
291.                 postOp$ = subtr$(ca$, cb$)
292.             End If
293.         End If
294.     ElseIf op$ = "*" Then
295.         postOp$ = sgn$ + mult$(ca$, cb$)
296.     ElseIf op$ = "/" Then
297.         postOp$ = sgn$ + divide$(ca$, cb$)
298.     End If ' which op
299.     'put dp back
300.     If op$ <> "/" Then
301.         lpop = Len(postOp$) ' put decimal back
302.         postOp$ = Mid$(postOp$, 1, lpop - dp) + "." + Mid$(postOp$, lpop - dp + 1)
303.     End If
304.     mr$ = trim0$(postOp$)
305. End Function
306.  
307. Function divide$ (n$, d$) ' goal here is 100 digits precision not 100 digits past decimal
308.     Dim di$, ndi$, nD As Integer
309.     If _Trim$(n$) = "0" Then divide$ = "0": Exit Function
310.     If _Trim$(d$) = "0" Then divide$ = "div 0": Exit Function
311.     If _Trim$(d$) = "1" Then divide$ = _Trim$(n$): Exit Function
312.  
313.     ' aha! found a bug when d$ gets really huge 100 is no where near enough!!!!
314.     ' 2021-06-03 fix by adding 100 to len(d$), plus have to go a little past 100 for 100 digit precision
315.     ' need to go past 100 for 100 precise digits (not decimal places)
316.     di$ = Mid$(nInverse$(d$, Len(d$) + 200), 2) 'chop off decimal point after
317.     nD = Len(di$)
318.     ndi$ = mult$(n$, di$)
319.     ndi$ = Mid$(ndi$, 1, Len(ndi$) - nD) + "." + Right$(String$(nD, "0") + Right$(ndi$, nD), nD)
320.     divide$ = trim0$(ndi$)
321. End Function
322.  
323. Function nInverse$ (n$, DP As Integer) 'assume decimal at very start of the string of digits returned, no rounding
324.     Dim m$(1 To 9), si$, r$, outstr$, d$
325.     Dim i As Integer
326.     For i = 1 To 9
327.         si$ = _Trim$(Str$(i))
328.         m$(i) = mult$(si$, n$)
329.     Next
330.     outstr$ = ""
331.     If n$ = "0" Then nInverse$ = "Div 0": Exit Function
332.     If n$ = "1" Then nInverse$ = "1": Exit Function
333.     outstr$ = "." 'everything else n > 1 is decimal 8/17
334.     r$ = "10"
335.     Do
336.         While Left$(subtr$(r$, n$), 1) = "-" '   r - n < 0
337.             outstr$ = outstr$ + "0" '            add 0 to the  output string
338.             If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function 'check if we've reached DP length
339.             r$ = r$ + "0"
340.         Wend
341.         For i = 9 To 1 Step -1
342.             If LTE(m$(i), r$) Then d$ = _Trim$(Str$(i)): Exit For
343.         Next
344.         outstr$ = outstr$ + d$
345.         If Len(outstr$) = DP Then nInverse$ = outstr$: Exit Function
346.         r$ = subtr$(r$, mult$(d$, n$)) 'r = r -d*n
347.         If r$ = "0" Then nInverse$ = outstr$: Exit Function 'found a perfect divisor
348.         r$ = r$ + "0" 'add another place
349.     Loop
350. End Function
351.  
352. Function mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
353.     Dim la As Integer, lb As Integer, m As Integer, g As Integer, dp As Integer
354.     Dim v18 As _Unsigned _Integer64, sd As _Unsigned _Integer64, co As _Unsigned _Integer64
355.     Dim f18$, f1$, t$, build$, accum$
356.     ' fixed mult$ don't trim lead 0's 2021-06-06
357.     If _Trim$(a$) = "0" Then mult$ = "0": Exit Function
358.     If _Trim$(b$) = "0" Then mult$ = "0": Exit Function
359.     If _Trim$(a$) = "1" Then mult$ = _Trim$(b$): Exit Function
360.     If _Trim$(b$) = "1" Then mult$ = _Trim$(a$): Exit Function
361.     'find the longer number and make it a mult of 18 to take 18 digits at a time from it
362.     la = Len(a$): lb = Len(b$)
363.     If la > lb Then
364.         m = Int(la / 18) + 1
365.         f18$ = Right$(String$(m * 18, "0") + a$, m * 18)
366.         f1$ = b$
367.     Else
368.         m = Int(lb / 18) + 1
369.         f18$ = Right$(String$(m * 18, "0") + b$, m * 18)
370.         f1$ = a$
371.     End If
372.     For dp = Len(f1$) To 1 Step -1 'dp = digit position of the f1$
373.         build$ = "" 'line builder
374.         co = 0
375.         'now taking 18 digits at a time Thanks Steve McNeill
376.         For g = 1 To m
377.             v18 = Val(Mid$(f18$, m * 18 - g * 18 + 1, 18))
378.             sd = Val(Mid$(f1$, dp, 1))
379.             t$ = Right$(String$(19, "0") + _Trim$(Str$(v18 * sd + co)), 19)
380.             co = Val(Mid$(t$, 1, 1))
381.             build$ = Mid$(t$, 2) + build$
382.         Next g
383.         If co Then build$ = _Trim$(Str$(co)) + build$
384.         If dp = Len(f1$) Then
385.             accum$ = build$
386.         Else
387.             accum$ = add$(accum$, build$ + String$(Len(f1$) - dp, "0"))
388.         End If
389.     Next dp
390.     mult$ = accum$
391. End Function
392.  
393. Function subtr$ (sum$, minus$) ' assume both numbers are positive all digits
394.     Dim m As Integer, g As Integer, p As Integer
395.     Dim VB As _Unsigned _Integer64, vs As _Unsigned _Integer64, tenE18 As _Unsigned _Integer64
396.     Dim ts$, tm$, sign$, LG$, sm$, t$, result$
397.  
398.     'ts$ = TrimLead0$(sum$): tm$ = TrimLead0$(minus$)   'orig with decent square root speed
399.     ts$ = _Trim$(sum$): tm$ = _Trim$(minus$) ' fixed subtr$ 2021-06-05
400.     If trim0(ts$) = trim0$(tm$) Then subtr$ = "0": Exit Function 'OK proceed with function knowing they are not equal
401.     tenE18 = 1000000000000000000 'yes!!! no dang E's
402.     If LTE(ts$, tm$) Then ' which is bigger? minus is bigger
403.         sign$ = "-"
404.         m = Int(Len(tm$) / 18) + 1
405.         LG$ = Right$(String$(m * 18, "0") + tm$, m * 18)
406.         sm$ = Right$(String$(m * 18, "0") + ts$, m * 18)
407.     Else 'sum is bigger
408.         sign$ = ""
409.         m = Int(Len(ts$) / 18) + 1
410.         LG$ = Right$(String$(m * 18, "0") + ts$, m * 18)
411.         sm$ = Right$(String$(m * 18, "0") + tm$, m * 18)
412.     End If
413.     'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
414.     For g = 1 To m
415.         VB = Val(Mid$(LG$, m * 18 - g * 18 + 1, 18))
416.         vs = Val(Mid$(sm$, m * 18 - g * 18 + 1, 18))
417.         If vs > VB Then
418.             t$ = Right$(String$(18, "0") + _Trim$(Str$(tenE18 - vs + VB)), 18)
419.             p = (m - g) * 18
420.             While p > 0 And Mid$(LG$, p, 1) = "0"
421.                 Mid$(LG$, p, 1) = "9"
422.                 p = p - 1
423.             Wend
424.             If p > 0 Then Mid$(LG$, p, 1) = _Trim$(Str$(Val(Mid$(LG$, p, 1)) - 1))
425.         Else
426.             t$ = Right$(String$(18, "0") + _Trim$(Str$(VB - vs)), 18)
427.         End If
428.         result$ = t$ + result$
429.     Next
430.     subtr$ = sign$ + result$
431. End Function
432.  
433. Function add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no spaces or - signs
434.     'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
435.     Dim la As Integer, lb As Integer, m As Integer, g As Integer
436.     Dim sa As _Unsigned _Integer64, sb As _Unsigned _Integer64, co As _Unsigned _Integer64
437.     Dim fa$, fb$, t$, new$, result$
438.     la = Len(a$): lb = Len(b$)
439.     If la > lb Then m = Int(la / 18) + 1 Else m = Int(lb / 18) + 1
440.     fa$ = Right$(String$(m * 18, "0") + a$, m * 18)
441.     fb$ = Right$(String$(m * 18, "0") + b$, m * 18)
442.  
443.     'now taking 18 digits at a time Thanks Steve McNeill
444.     For g = 1 To m
445.         sa = Val(Mid$(fa$, m * 18 - g * 18 + 1, 18))
446.         sb = Val(Mid$(fb$, m * 18 - g * 18 + 1, 18))
447.         t$ = Right$(String$(36, "0") + _Trim$(Str$(sa + sb + co)), 36)
448.         co = Val(Mid$(t$, 1, 18))
449.         new$ = Mid$(t$, 19)
450.         result$ = new$ + result$
451.     Next
452.     If co Then result$ = Str$(co) + result$
453.     add$ = result$
454. End Function
455.  
456. ' String Math Helpers -----------------------------------------------
457.  
458. 'this function needs TrimLead0$(s$) a and b have decimal removed and a and b lengths aligned on right
459. Function LTE (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings
460.     Dim ca$, cb$, la As Integer, lb As Integer, i As Integer
461.     ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
462.     la = Len(ca$): lb = Len(cb$)
463.     If ca$ = cb$ Then
464.         LTE = -1
465.     ElseIf la < lb Then ' a is smaller
466.         LTE = -1
467.     ElseIf la > lb Then ' a is bigger
468.         LTE = 0
469.     ElseIf la = lb Then ' equal lengths
470.         For i = 1 To Len(ca$)
471.             If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
472.                 LTE = 0: Exit Function
473.             ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
474.                 LTE = -1: Exit Function
475.             End If
476.         Next
477.     End If
478. End Function
479.  
480. ' ------------------------------------- use these for final display
481.  
482. Function TrimLead0$ (s$) 'for treating strings as number (pos integers)
483.     Dim copys$, i As Integer, find As Integer
484.     copys$ = _Trim$(s$) 'might as well remove spaces too
485.     i = 1: find = 0
486.     While i < Len(copys$) And Mid$(copys$, i, 1) = "0"
487.         i = i + 1: find = 1
488.     Wend
489.     If find = 1 Then copys$ = Mid$(copys$, i)
490.     If copys$ = "" Then TrimLead0$ = "0" Else TrimLead0$ = copys$
491. End Function
492.  
493. Function TrimTail0$ (s$)
494.     Dim copys$, dp As Integer, i As Integer, find As Integer
495.     copys$ = _Trim$(s$) 'might as well remove spaces too
496.     TrimTail0$ = copys$
497.     dp = InStr(copys$, ".")
498.     If dp > 0 Then
499.         i = Len(copys$): find = 0
500.         While i > dp And Mid$(copys$, i, 1) = "0"
501.             i = i - 1: find = 1
502.         Wend
503.         If find = 1 Then
504.             If i = dp Then
505.                 TrimTail0$ = Mid$(copys$, 1, dp - 1)
506.             Else
507.                 TrimTail0$ = Mid$(copys$, 1, i)
508.             End If
509.         End If
510.     End If
511. End Function
512.  
513. Function trim0$ (s$)
514.     Dim cs$, si$
515.     cs$ = s$
516.     si$ = Left$(cs$, 1)
517.     If si$ = "-" Then cs$ = Mid$(cs$, 2)
518.     cs$ = TrimLead0$(cs$)
519.     cs$ = TrimTail0$(cs$)
520.     If Right$(cs$, 1) = "." Then cs$ = Mid$(cs$, 1, Len(cs$) - 1)
521.     If si$ = "-" Then trim0$ = si$ + cs$ Else trim0$ = cs$
522. End Function
523.  
524. ' for displaying truncated numbers say to 60 digits
525. Function showDP$ (num$, nDP As Integer)
526.     Dim cNum$, dp As Integer, d As Integer, i As Integer
527.     cNum$ = num$ 'since num$ could get changed
528.     showDP$ = num$
529.     dp = InStr(num$, ".")
530.     If dp > 0 Then
531.         If Len(Mid$(cNum$, dp + 1)) > nDP Then
532.             d = Val(Mid$(cNum$, dp + nDP + 1, 1))
533.             If d > 4 Then
534.                 cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
535.                 dp = dp + 1
536.                 i = dp + nDP
537.                 While Mid$(cNum$, i, 1) = "9" Or Mid$(cNum$, i, 1) = "."
538.                     If Mid$(cNum$, i, 1) = "9" Then
539.                         Mid$(cNum$, i, 1) = "0"
540.                     End If
541.                     i = i - 1
542.                 Wend
543.                 Mid$(cNum$, i, 1) = _Trim$(Str$(Val(Mid$(cNum$, i, 1)) + 1)) 'last non 9 digit
544.                 cNum$ = Mid$(cNum$, 1, dp + nDP) 'chop it
545.                 showDP$ = trim0$(cNum$)
546.             Else
547.                 showDP$ = Mid$(cNum$, 1, dp + nDP)
548.             End If
549.         End If
550.     End If
551. End Function
552.  

[NOVARSEG]

This link might help

https://www.qb64.org/forum/index.php?topic=3716.15

[bplus]

Here is current state of the art for String Math. A number of fixes and improvements including sqrRoot$(), approx 412 LOC for the copy/paste procedures into your app.

Code: QB64: [Select]

1. Option _Explicit
2. _Title "String Math 2021-06-14" ' b+ from SM2 (2021 June) a bunch of experiments to fix and improve speeds.
3. ' June 2021 fix some old String Math procedures, better nInverse with new LT frunction, remove experimental procedures.
4. ' Now with decent sqrRoot it works independent of Mr$() = Math Regulator that handles signs and decimals and calls to
5. ' add$(), subtr$, mult$, divide$ (100 significant digits),  add$(), subtr$, mult$ are exact!
6. ' If you need higher precsion divide, I recommend use nInverse on denominator (integer)
7. ' then add sign and decimal and mult$() that number with numerator to get divsion answer in higher precision than 100.
8. ' (See how Mr$() handles division and just call nInverse$ with what precision you need.)
9. ' The final function showDP$() is for displaying these number to a set amount of Decimal Places.
10.  
11. ' The main code is sampler of tests performed with these functions.
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. 'test new stuff
19. 'Print mult3$("11", "1001")
20. 'End
21.  
22. Dim r$, ruler$
23. ruler$ = "0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890" + Chr$(10)
24. ruler$ = ruler$ + "0         1         2         3         4         5         6         7         8         9        10        11        12"
25.  
26. ' jack error reported 2021-06-04 confirmed!   fixed
27. Print mr$(".00000000000000000000000000000000000000000000200000000000000054307978001764", "-", ".000000000000000000000000000000000000000000002")
28. Print ".00000000000000000000000000000000000000000000000000000000000054307978001764"
29. ' debug tests
30. Print mr$("-5", "+", "-2100"), " OK if -2105"
31. Print mr$("." + String$(20, "0") + "1", "+", "1" + String$(40, "0") + "1") ' first real test of add
32. Print ruler$
33. Print Val("." + String$(20, "0") + "1") + Val("1" + String$(40, "0") + "1") ' test print of big and small val
34. Print mr$("-.00071", "+", ".00036" + String$(35, "0") + "9")
35. '-.00071
36. ' .00036000000000000000000000000000000000009
37. Print "-.00034999999999999999999999999999999999991"
38.  
39. 'testing a different subtract sub
40. Print mr$("10", "-", "5"), " 5 OK"
41. Print mr$("-10", "+", "5"), " -5 OK"
42. Print mr$("-10", "-", "-5"), " -5 OK"
43. Print mr$("-10", "-", "5"), " -15  OK  added"
44. Print mr$("10", "-", "-5"), " 15  OK  added"
45. Print mr$("-.010", "-", "-5"), "4.99 OK"
46. Print mr$("-.010", "-", "5"), "-5.01  OK just added"
47. Print mr$(".010", "-", "5"), " -4.99 OK"
48. ' jack error reported 2021-06-04 confirmed!  variation below
49. r$ = mr$(".00000000200000000000000054307978001764", "-", ".0000000020000000000000001") '16 0 wrong  8 wrong
50. Print "   mr$ rtnd:"; r$
51. Print "    compare:.00000000000000000000000044307978001764" ' 2021-06-05 finally!
52. '                  .0000000020000000000000001
53. '                  .00000000200000000000000054307978001764
54.  
55. r$ = mr$(".00000000000000000100000000000000000011", "-", ".000000000000000001000000000000000001") ' bad too
56. Print "   mr$ rtnd:"; r$
57. '         ".000000000000000001000000000000000001"
58. Print "    compare:-.00000000000000000000000000000000000089"
59. r$ = mr$(".00000000000000000100000000000000000111", "-", ".000000000000000002000000000000000001")
60. '       ".000000000000000002000000000000000001"
61. '       ".00000000000000000100000000000000000111"
62. '       ".00000000000000000099999999999999999989"
63. Print "   mr$ rtnd:"; r$
64. Print "    compare:-.00000000000000000099999999999999999989"
65.  
66. r$ = mr$(".00000000000000000000000000999", "-", "1")
67. '-1.00000000000000000000000000000000000000000
68. '  .00000000000000000000000000999
69. ' -.99999999999999999999999999001
70. Print "   mr$ rtnd:"; r$
71. Print "    compare:-.99999999999999999999999999001"
72.  
73. r$ = mr$("1", "+", "-1000000000000000000000000000000000000000")
74. Print "   mr$ rtnd:"; r$
75. '1000000000000000000000000000000000000000
76. '-999999999999999999999999999999999999999
77. Print "    compare:-999999999999999999999999999999999999999"
78.  
79. ' check jack problems with FB translation  2021-06-03  errors must be in FB trans from QB64
80. Print Mid$(mr$(" .1", "/", "3"), 1, 100) ' too long?
81. Print Mid$(mr$("1.1", "/", "9"), 1, 100)
82. Print Mid$(mr$("1.38", "/", "1.2"), 1, 100)
83.  
84. ' another error reported by jack 2021-06-06 fixed (same problem as subtr$)
85. Print mr$("1.000000000000000000000001000000000000000000000001", "*", ".000000000000000000000000000000000000000000000001")
86. Print ".000000000000000000000000000000000000000000000001"
87. Print "                                                1000000000000000000000001000000000000000000000001"
88. Print ruler$
89. Print "checking inverse of 50 = .02 "; nInverse$("50", 20) 'OK  .020000... length 20
90. Print
91. Print "zzz... see inverse of STx number now takes 2.2 secs with fixed subtr$() sub,"
92. Print "can find 115 Fibonacci terms in it."
93. Sleep
94. Cls
95. Dim inverseSTx$, start, done
96. start = Timer(.001)
97. inverseSTx$ = nInverse$("999999999999999999999998999999999999999999999999", 2785) ' now 2.2 secs with new subtr from 19 secs
98. 'inverseSTx$ = nInverse2$("999999999999999999999998999999999999999999999999", 817) ' 13 sec damn added 7 secs! now 19.xx
99. ' 816 in 4.22 secs only 64 terms   817 sigDigits matching in 12.93 secs gets all 115 Fibonacci Terms
100. done = Timer(.001) - start
101. Print Mid$(inverseSTx$, 1, 3000)
102. Print
103. Print "Inverse time:"; done; "   zzz... press any to search for Fibonacci Terms"
104. Sleep
105. Dim As Long startSearch, termN, find
106. Dim f1$, f2$, searchFor$
107. f1$ = "1"
108. f2$ = "1"
109. startSearch = 1
110. termN = 2
111. Do
112.     searchFor$ = mr$(f1$, "+", f2$)
113.     find = InStr(startSearch, inverseSTx$, searchFor$)
114.     If find Then
115.         termN = termN + 1
116.         Print "Term Number"; termN; " = "; searchFor$; " found at"; find
117.         f1$ = f2$
118.         f2$ = searchFor$
119.         startSearch = find + Len(searchFor$)
120.     Else
121.         Print searchFor$; " not found."
122.         Exit Do
123.     End If
124. Loop
125. Print
126. ' test factorial speed
127. Dim fact$, i As _Unsigned _Integer64, refFact$, cont$
128. _KeyClear
129. Input "Press y for yes, let's do 10000 factorial test, takes quite a bit of time (3.25 mins) "; fact$
130. If fact$ = "y" Then
131.     start = Timer(.001)
132.     fact$ = "1"
133.     For i = 2 To 10000
134.         fact$ = TrimLead0$(mult$(fact$, _Trim$(Str$(i))))
135.         If i Mod 100 = 0 Then Print i; "factorial length ="; Len(fact$)
136.     Next
137.     done = Timer(.001) - start
138.     Print i, Len(fact$), done
139.     ' save it
140.     Open "calc 10000!.txt" For Output As #1
141.     Print #1, fact$
142.     Close #1
143.     Beep
144.     Print Len(fact$), done, "   zzz... press any to compare to reference 10000!."
145.     Sleep
146.     _KeyClear
147.     If _FileExists("10000!.txt") Then
148.         Open "10000!.txt" For Input As #1
149.         Input #1, refFact$
150.         Close #1
151.         Print "Comparing fact$ to reference fact$:"
152.         For i = 1 To Len(fact$)
153.             If Mid$(fact$, i, 1) <> Mid$(refFact$, i, 1) Then
154.                 Print i, Mid$(fact$, i, 1), Mid$(refFact$, i, 1)
155.                 Beep
156.                 Input "Mismatch! Continue? y for yes "; cont$
157.                 If cont$ <> "y" Then Exit For
158.             End If
159.         Next
160.         Print "Compare finished, mismatchs already noted if any."
161.     Else
162.         Print "Can't find 10000!.txt reference file."
163.     End If
164.     _KeyClear
165.     Print "zzz... press any to start sqr estimating"
166.     Sleep
167.     _KeyClear
168. End If
169.  
170. Dim n$, result$
171. Do
172.     'remember everything is strings
173.     Input "Enter a number to find it's square root, just enter to quit "; n$
174.     If n$ = "" Then End
175.     result$ = sqrRoot$(n$)
176.     Print result$
177.     Print "Length ="; Len(result$)
178.     Print
179. Loop
180.  
181. ' =========  String Math Procedure start here (aprox 412 LOC for copy/paste into your app) ======
182.  
183. Function sqrRoot$ (nmbr$)
184.     Dim n$, guess$, lastGuess$, other$, sum$, imaginary$, loopcnt
185.     If Left$(nmbr$, 1) = "-" Then 'handle neg numbers
186.         imaginary$ = "*i": n$ = Mid$(nmbr$, 2)
187.     Else
188.         imaginary$ = "": n$ = nmbr$
189.     End If
190.     guess$ = mr$(n$, "/", "2")
191.     other$ = n$
192.     Do
193.         loopcnt = loopcnt + 1
194.         If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then
195.             ' go past 100 matching digits for 100 digit precision
196.             sqrRoot$ = Mid$(other$, 1, 101) + imaginary$
197.             ' try other factor for guess$  sometimes it nails answer without all digits
198.             Exit Function
199.         Else
200.             lastGuess$ = guess$
201.             sum$ = mr$(guess$, "+", other$)
202.             guess$ = mr$(sum$, "/", "2")
203.             other$ = mr$(n$, "/", guess$)
204.         End If
205.     Loop
206. End Function
207.  
208. Function add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no - signs
209.     'set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
210.     Dim As Long la, lb, m, g
211.     Dim sa As _Unsigned _Integer64, sb As _Unsigned _Integer64, co As _Unsigned _Integer64
212.     Dim fa$, fb$, t$, new$, result$
213.     la = Len(a$): lb = Len(b$)
214.     If la > lb Then m = Int(la / 18) + 1 Else m = Int(lb / 18) + 1
215.     fa$ = Right$(String$(m * 18, "0") + a$, m * 18)
216.     fb$ = Right$(String$(m * 18, "0") + b$, m * 18)
217.  
218.     'now taking 18 digits at a time Thanks Steve McNeill
219.     For g = 1 To m
220.         sa = Val(Mid$(fa$, (m - g) * 18 + 1, 18))
221.         sb = Val(Mid$(fb$, (m - g) * 18 + 1, 18))
222.         t$ = Right$(String$(36, "0") + _Trim$(Str$(sa + sb + co)), 36)
223.         co = Val(Mid$(t$, 1, 18))
224.         new$ = Mid$(t$, 19)
225.         result$ = new$ + result$
226.     Next
227.     If co Then result$ = Str$(co) + result$
228.     add$ = result$
229. End Function
230.  
231. ' This is used in nInverse$ not by Mr$ because there it saves time!
232. Function subtr1$ (a$, b$)
233.     Dim As Long la, lb, lResult, i, ca, cb, w
234.     Dim result$, fa$, fb$
235.  
236.     la = Len(a$): lb = Len(b$)
237.     If la > lb Then lResult = la Else lResult = lb
238.     result$ = Space$(lResult)
239.     fa$ = result$: fb$ = result$
240.     Mid$(fa$, lResult - la + 1) = a$
241.     Mid$(fb$, lResult - lb + 1) = b$
242.     For i = lResult To 1 Step -1
243.         ca = Val(Mid$(fa$, i, 1))
244.         cb = Val(Mid$(fb$, i, 1))
245.         If cb > ca Then ' borrow 10
246.             Mid$(result$, i, 1) = Right$(Str$(10 + ca - cb), 1)
247.             w = i - 1
248.             While w > 0 And Mid$(fa$, w, 1) = "0"
249.                 Mid$(fa$, w, 1) = "9"
250.                 w = w - 1
251.             Wend
252.             Mid$(fa$, w, 1) = Right$(Str$(Val(Mid$(fa$, w, 1)) - 1), 1)
253.         Else
254.             Mid$(result$, i, 1) = Right$(Str$(ca - cb), 1)
255.         End If
256.     Next
257.     subtr1$ = result$
258. End Function
259.  
260. ' 2021-06-08 fix up with new mr call that decides the sign and puts the greater number first
261. Function subtr$ (sum$, minus$) ' assume both numbers are positive all digits
262.     Dim As Long m, g, p
263.     Dim VB As _Unsigned _Integer64, vs As _Unsigned _Integer64, tenE18 As _Unsigned _Integer64
264.     Dim ts$, tm$, sign$, LG$, sm$, t$, result$
265.  
266.     ts$ = _Trim$(sum$): tm$ = _Trim$(minus$) ' fixed subtr$ 2021-06-05
267.     If trim0(ts$) = trim0$(tm$) Then subtr$ = "0": Exit Function 'proceed knowing not equal
268.     tenE18 = 1000000000000000000 'yes!!! no dang E's
269.     sign$ = ""
270.     m = Int(Len(ts$) / 18) + 1
271.     LG$ = Right$(String$(m * 18, "0") + ts$, m * 18)
272.     sm$ = Right$(String$(m * 18, "0") + tm$, m * 18)
273.  
274.     'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
275.     For g = 1 To m
276.         VB = Val(Mid$(LG$, m * 18 - g * 18 + 1, 18))
277.         vs = Val(Mid$(sm$, m * 18 - g * 18 + 1, 18))
278.         If vs > VB Then
279.             t$ = Right$(String$(18, "0") + _Trim$(Str$(tenE18 - vs + VB)), 18)
280.             p = (m - g) * 18
281.             While p > 0 And Mid$(LG$, p, 1) = "0"
282.                 Mid$(LG$, p, 1) = "9"
283.                 p = p - 1
284.             Wend
285.             If p > 0 Then Mid$(LG$, p, 1) = _Trim$(Str$(Val(Mid$(LG$, p, 1)) - 1))
286.         Else
287.             t$ = Right$(String$(18, "0") + _Trim$(Str$(VB - vs)), 18)
288.         End If
289.         result$ = t$ + result$
290.     Next
291.     subtr$ = result$
292. End Function
293.  
294. Function TrimLead0$ (s$) 'for treating strings as number (pos integers)
295.     Dim copys$
296.     Dim As Long i, find
297.     copys$ = _Trim$(s$) 'might as well remove spaces too
298.     i = 1: find = 0
299.     While i < Len(copys$) And Mid$(copys$, i, 1) = "0"
300.         i = i + 1: find = 1
301.     Wend
302.     If find = 1 Then copys$ = Mid$(copys$, i)
303.     If copys$ = "" Then TrimLead0$ = "0" Else TrimLead0$ = copys$
304. End Function
305.  
306. ' catchy? mr$ for math regulator  cop$ = " + - * / " 1 of 4 basic arithmetics
307. ' Fixed so that add and subtract have signs calc'd in Mr and correct call to add or subtract made
308. ' with bigger minus smaller in subtr$() call
309. Function mr$ (a$, cop$, b$)
310.     Dim op$, ca$, cb$, aSgn$, bSgn$, postOp$, sgn$
311.     Dim As Long adp, bdp, dp, lpop, aLTb
312.  
313.     op$ = _Trim$(cop$) 'save fixing each time
314.     ca$ = _Trim$(a$): cb$ = _Trim$(b$) 'make copies in case we change
315.     'strip signs and decimals
316.     If Left$(ca$, 1) = "-" Then
317.         aSgn$ = "-": ca$ = Mid$(ca$, 2)
318.     Else
319.         aSgn$ = ""
320.     End If
321.     dp = InStr(ca$, ".")
322.     If dp > 0 Then
323.         adp = Len(ca$) - dp
324.         ca$ = Mid$(ca$, 1, dp - 1) + Mid$(ca$, dp + 1)
325.     Else
326.         adp = 0
327.     End If
328.     If Left$(cb$, 1) = "-" Then
329.         bSgn$ = "-": cb$ = Mid$(cb$, 2)
330.     Else
331.         bSgn$ = ""
332.     End If
333.     dp = InStr(cb$, ".")
334.     If dp > 0 Then
335.         bdp = Len(cb$) - dp
336.         cb$ = Mid$(cb$, 1, dp - 1) + Mid$(cb$, dp + 1)
337.     Else
338.         bdp = 0
339.     End If
340.     If op$ = "+" Or op$ = "-" Or op$ = "/" Then 'add or subtr  even up strings on right of decimal
341.         'even up the right sides of decimals if any
342.         If adp > bdp Then dp = adp Else dp = bdp
343.         If adp < dp Then ca$ = ca$ + String$(dp - adp, "0")
344.         If bdp < dp Then cb$ = cb$ + String$(dp - bdp, "0")
345.     ElseIf op$ = "*" Then
346.         dp = adp + bdp
347.     End If
348.     If op$ = "*" Or op$ = "/" Then
349.         If aSgn$ = bSgn$ Then sgn$ = "" Else sgn$ = "-"
350.     End If
351.  
352.     'now according to signs and op$ call add$ or subtr$
353.     If op$ = "-" Then ' make it adding according to signs because that is done for + next!
354.         If bSgn$ = "-" Then bSgn$ = "" Else bSgn$ = "-" ' flip bSgn$ with op$
355.         op$ = "+" ' turn this over to + op already done! below
356.     End If
357.     If op$ = "+" Then
358.         If aSgn$ = bSgn$ Then 'really add
359.             postOp$ = add$(ca$, cb$)
360.             sgn$ = aSgn$
361.         ElseIf aSgn$ <> bSgn$ Then 'have a case of subtraction
362.             'but which is first and which is 2nd and should final sign be pos or neg
363.             If TrimLead0$(ca$) = TrimLead0(cb$) Then 'remove case a = b
364.                 mr$ = "0": Exit Function
365.             Else
366.                 aLTb = LTE(ca$, cb$)
367.                 If aSgn$ = "-" Then
368.                     If aLTb Then ' b - a = pos
369.                         postOp$ = subtr$(cb$, ca$)
370.                         sgn$ = ""
371.                     Else '  a > b so a - sgn wins  - (a - b)
372.                         postOp$ = subtr$(ca$, cb$)
373.                         sgn$ = "-"
374.                     End If
375.                 Else ' b has the - sgn
376.                     If aLTb Then ' result is -
377.                         postOp$ = subtr$(cb$, ca$)
378.                         sgn$ = "-"
379.                     Else ' result is pos
380.                         postOp$ = subtr$(ca$, cb$)
381.                         sgn$ = ""
382.                     End If
383.                 End If
384.             End If
385.         End If
386.     ElseIf op$ = "*" Then
387.         postOp$ = mult$(ca$, cb$)
388.     ElseIf op$ = "/" Then
389.         postOp$ = divide$(ca$, cb$)
390.     End If ' which op
391.     If op$ <> "/" Then 'put dp back
392.         lpop = Len(postOp$) ' put decimal back if there is non zero stuff following it
393.         If Len(Mid$(postOp$, lpop - dp + 1)) Then ' fix 1 extra dot appearing in 10000! ?!
394.             If TrimLead0$(Mid$(postOp$, lpop - dp + 1)) <> "0" Then '  .0   or .00 or .000  ??
395.                 postOp$ = Mid$(postOp$, 1, lpop - dp) + "." + Mid$(postOp$, lpop - dp + 1)
396.             End If
397.         End If
398.     End If
399.     mr$ = trim0$(postOp$) 'trim lead 0's then tack on sign
400.     If mr$ <> "0" Then mr$ = sgn$ + mr$
401. End Function
402.  
403. Function divide$ (n$, d$) ' goal here is 100 digits precision not 100 digits past decimal
404.     Dim di$, ndi$
405.     Dim As Long nD
406.     If n$ = "0" Then divide$ = "0": Exit Function
407.     If d$ = "0" Then divide$ = "div 0": Exit Function
408.     If d$ = "1" Then divide$ = n$: Exit Function
409.  
410.     ' aha! found a bug when d$ gets really huge 100 is no where near enough!!!!
411.     ' 2021-06-03 fix by adding 100 to len(d$), plus have to go a little past 100 like 200
412.     di$ = Mid$(nInverse$(d$, Len(d$) + 200), 2) 'chop off decimal point after
413.     nD = Len(di$)
414.     ndi$ = mult$(n$, di$)
415.     ndi$ = Mid$(ndi$, 1, Len(ndi$) - nD) + "." + Right$(String$(nD, "0") + Right$(ndi$, nD), nD)
416.     divide$ = ndi$
417. End Function
418.  
419. ' This uses Subtr1$ is Positive Integer only!
420. ' DP = Decimal places = says when to quit if don't find perfect divisor before
421. Function nInverse$ (n$, DP As Long) 'assume decimal at very start of the string of digits returned
422.     Dim m$(1 To 9), si$, r$, outstr$, d$
423.     Dim i As Long
424.     For i = 1 To 9
425.         si$ = _Trim$(Str$(i))
426.         m$(i) = mult$(si$, n$)
427.     Next
428.     outstr$ = ""
429.     If n$ = "0" Then nInverse$ = "Div 0": Exit Function
430.     If n$ = "1" Then nInverse$ = "1": Exit Function
431.     outstr$ = "." 'everything else n > 1 is decimal 8/17
432.     r$ = "10"
433.     Do
434.         While LT(r$, n$) ' 2021-06-08 this should be strictly Less Than
435.             outstr$ = outstr$ + "0" '            add 0 to the  output string
436.             If Len(outstr$) = DP + 1 Then nInverse$ = outstr$: Exit Function 'DP length?
437.             r$ = r$ + "0"
438.         Wend
439.         For i = 9 To 1 Step -1
440.             If LTE(m$(i), r$) Then d$ = _Trim$(Str$(i)): Exit For
441.         Next
442.         outstr$ = outstr$ + d$
443.         If Len(outstr$) = DP + 1 Then nInverse$ = outstr$: Exit Function
444.         r$ = subtr1$(r$, mult$(d$, n$)) 'r = r -d*n    ' 2021-06-08 subtr1 works faster
445.         If TrimLead0$(r$) = "0" Then nInverse$ = outstr$: Exit Function ' add trimlead0$ 6/08
446.         r$ = r$ + "0" 'add another place
447.     Loop
448. End Function
449.  
450. Function mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
451.     Dim As Long la, lb, m, g, dp
452.     Dim As _Unsigned _Integer64 v18, sd, co
453.     Dim f18$, f1$, t$, build$, accum$
454.  
455.     If a$ = "0" Then mult$ = "0": Exit Function
456.     If b$ = "0" Then mult$ = "0": Exit Function
457.     If a$ = "1" Then mult$ = b$: Exit Function
458.     If b$ = "1" Then mult$ = a$: Exit Function
459.     'find the longer number and make it a mult of 18 to take 18 digits at a time from it
460.     la = Len(a$): lb = Len(b$)
461.     If la > lb Then
462.         m = Int(la / 18) + 1
463.         f18$ = Right$(String$(m * 18, "0") + a$, m * 18)
464.         f1$ = b$
465.     Else
466.         m = Int(lb / 18) + 1
467.         f18$ = Right$(String$(m * 18, "0") + b$, m * 18)
468.         f1$ = a$
469.     End If
470.     For dp = Len(f1$) To 1 Step -1 'dp = digit position of the f1$
471.         build$ = "" 'line builder
472.         co = 0
473.         'now taking 18 digits at a time Thanks Steve McNeill
474.         For g = 1 To m
475.             v18 = Val(Mid$(f18$, (m - g) * 18 + 1, 18))
476.             sd = Val(Mid$(f1$, dp, 1))
477.             t$ = Right$(String$(19, "0") + _Trim$(Str$(v18 * sd + co)), 19)
478.             co = Val(Mid$(t$, 1, 1))
479.             build$ = Mid$(t$, 2) + build$
480.         Next g
481.         If co Then build$ = _Trim$(Str$(co)) + build$
482.         If dp = Len(f1$) Then
483.             accum$ = build$
484.         Else
485.             accum$ = add$(accum$, build$ + String$(Len(f1$) - dp, "0"))
486.         End If
487.     Next dp
488.     mult$ = accum$
489. End Function
490.  
491. 'this function needs TrimLead0$(s$)
492. Function LTE (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings
493.     Dim ca$, cb$
494.     Dim As Long la, lb, i
495.     ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
496.     la = Len(ca$): lb = Len(cb$)
497.     If ca$ = cb$ Then
498.         LTE = -1
499.     ElseIf la < lb Then ' a is smaller
500.         LTE = -1
501.     ElseIf la > lb Then ' a is bigger
502.         LTE = 0
503.     ElseIf la = lb Then ' equal lengths
504.         For i = 1 To Len(ca$)
505.             If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
506.                 LTE = 0: Exit Function
507.             ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
508.                 LTE = -1: Exit Function
509.             End If
510.         Next
511.     End If
512. End Function
513.  
514. 'need this for ninverse faster than subtr$ for sign
515. Function LT (a$, b$) ' a$ Less Than or Equal b$  comparison of 2 strings
516.     Dim ca$, cb$
517.     Dim As Long la, lb, i
518.     ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
519.     la = Len(ca$): lb = Len(cb$)
520.     If la < lb Then ' a is smaller
521.         LT = -1
522.     ElseIf la > lb Then ' a is bigger
523.         LT = 0
524.     ElseIf la = lb Then ' equal lengths
525.         For i = 1 To Len(ca$)
526.             If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
527.                 LT = 0: Exit Function
528.             ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
529.                 LT = -1: Exit Function
530.             End If
531.         Next
532.     End If
533. End Function
534.  
535. Function TrimTail0$ (s$)
536.     Dim copys$
537.     Dim As Long dp, i, find
538.     copys$ = _Trim$(s$) 'might as well remove spaces too
539.     TrimTail0$ = copys$
540.     dp = InStr(copys$, ".")
541.     If dp > 0 Then
542.         i = Len(copys$): find = 0
543.         While i > dp And Mid$(copys$, i, 1) = "0"
544.             i = i - 1: find = 1
545.         Wend
546.         If find = 1 Then
547.             If i = dp Then
548.                 TrimTail0$ = Mid$(copys$, 1, dp - 1)
549.             Else
550.                 TrimTail0$ = Mid$(copys$, 1, i)
551.             End If
552.         End If
553.     End If
554. End Function
555.  
556. Function trim0$ (s$)
557.     Dim cs$, si$
558.     cs$ = s$
559.     si$ = Left$(cs$, 1)
560.     If si$ = "-" Then cs$ = Mid$(cs$, 2)
561.     cs$ = TrimLead0$(cs$)
562.     cs$ = TrimTail0$(cs$)
563.     If Right$(cs$, 1) = "." Then cs$ = Mid$(cs$, 1, Len(cs$) - 1)
564.     If si$ = "-" Then trim0$ = si$ + cs$ Else trim0$ = cs$
565. End Function
566.  
567. ' for displaying truncated numbers say to 60 digits
568. Function showDP$ (num$, nDP As Long)
569.     Dim cNum$
570.     Dim As Long dp, d, i
571.     cNum$ = num$ 'since num$ could get changed
572.     showDP$ = num$
573.     dp = InStr(num$, ".")
574.     If dp > 0 Then
575.         If Len(Mid$(cNum$, dp + 1)) > nDP Then
576.             d = Val(Mid$(cNum$, dp + nDP + 1, 1))
577.             If d > 4 Then
578.                 cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
579.                 dp = dp + 1
580.                 i = dp + nDP
581.                 While Mid$(cNum$, i, 1) = "9" Or Mid$(cNum$, i, 1) = "."
582.                     If Mid$(cNum$, i, 1) = "9" Then
583.                         Mid$(cNum$, i, 1) = "0"
584.                     End If
585.                     i = i - 1
586.                 Wend
587.                 Mid$(cNum$, i, 1) = _Trim$(Str$(Val(Mid$(cNum$, i, 1)) + 1)) 'last non 9 digit
588.                 cNum$ = Mid$(cNum$, 1, dp + nDP) 'chop it
589.                 showDP$ = trim0$(cNum$)
590.             Else
591.                 showDP$ = Mid$(cNum$, 1, dp + nDP)
592.             End If
593.         End If
594.     End If
595. End Function
596.  

The test code in main code area calculates 10000! and compares it to a reference file, if found.

Here is a copy if you'd like, the 3rd line in file is a link to where I got the number for reference in
10000!.txt:

[jack]

congrats bplus, 98 seconds for the factorial on my PC