Author Topic: String Math  (Read 15478 times)

0 Members and 1 Guest are viewing this topic.

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: String Math
« Reply #30 on: June 03, 2021, 06:20:31 pm »
My advice would be to pick any one of the many methods available, especially one you're comfortable with, and get it coded. I looked into it a while back, but I would extended my project into the time I wanted reserved for other projects. I mean square roots... and then... log, sine, cosign, etc. The list can get pretty long. I'm glad to see more bells and whistles are going into string math, as I do believe it is a valuable project for anyone who wants to work with very large figures, like Jenny Craig.

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: String Math
« Reply #31 on: June 03, 2021, 06:32:09 pm »
bplus, maybe this could work
Code: QB64: [Select]
  1.     Sub memcpy (ByVal dest As _Offset, Byval source As _Offset, Byval bytes As Long)
  2.  
  3.  
  4. Print approx_power(20000, 2#), Sqr(20000#)
  5.  
  6. x# = 1D100: y# = 7
  7. Print approx_power(x#, y#), x# ^ (1 / y#)
  8.  
  9. Function ipow# (x As Double, e As Integer)
  10.     'take x to an integer power
  11.     Dim As Double z, y
  12.     Dim As Integer n
  13.     y = x
  14.     n = Abs(e)
  15.     z = 1#
  16.     While n > 0
  17.         While (n Mod 2) = 0
  18.             n = n \ 2
  19.             y = y * y
  20.         Wend
  21.         n = n - 1
  22.         z = y * z
  23.     Wend
  24.     If e < 0 Then
  25.         ipow = 1# / z
  26.     Else
  27.         ipow = z
  28.     End If
  29.  
  30. Function approx_power# (x#, y#)
  31.     Dim As Double a, b
  32.     Dim As Long tmp
  33.     a = x#: b = 1# / y#
  34.     memcpy _Offset(tmp), _Offset(a) + 4, 4
  35.     tmp = (tmp - 1072632447) * b
  36.     tmp = tmp + 1072632447
  37.     memcpy _Offset(a) + 4, _Offset(tmp), 4
  38.     a = a - (ipow(a, y#) - x#) / (y# * ipow(a, y# - 1))
  39.     a = a - (ipow(a, y#) - x#) / (y# * ipow(a, y# - 1))
  40.     a = a - (ipow(a, y#) - x#) / (y# * ipow(a, y# - 1))
  41.     a = a - (ipow(a, y#) - x#) / (y# * ipow(a, y# - 1))
  42.     approx_power = a
  43.  
« Last Edit: June 06, 2021, 10:23:51 am by jack »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: String Math
« Reply #32 on: June 03, 2021, 08:43:39 pm »
I have the first sqrRoot$ compared side by side with the Square Root by Newton-Raphson Function (SRbyNR$) the first makes 3 calls to Mr$ Function while SRbyNR$ makes 5 per loop. I think it's noticeable but the real killer is . 20 0's 64, the first method returns a good result the 2nd is lost in infinite loop.

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

Offline jack

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

Offline George McGinn

  • Global Moderator
  • Forum Regular
  • Posts: 210
    • View Profile
    • Resume
Re: String Math
« Reply #34 on: June 03, 2021, 09:25:56 pm »
@bplus - Here is my version of the Square Root using strings.

I have integrated it into your MR program. However, as you will see from the result screen, it seems like it does not clear out what is in the decimal places.

I am using your add, subtract and divide routines, and I'm not yet sure if it is an error with your routines not clearing out the decimal places, or that they are not designed to be nested in a formula (the ones my friend and I wrote for the iPad/iPhone does work properly), or I just don't understand how your program fully works.

I created an OP code ">" to represent Square Root, and the second number is set to "" (can be any value really, as it is never referenced in my routine.

Because the iterations do not stop when dx$ = "10" I get an erroneous result. As you will see I have both the original formula expressed properly in your mr$ format, as well as it broken out in its components based on the order of operations. I get the same results in both, that is I get a carryover of the decimals from the prior iteration.

Code: QB64: [Select]
  1. PRINT "Square Root of 100 equals "; mr$("100", ">", "")    

Code: QB64: [Select]
  1. '*** Add in Square Root Function
  2.     ELSEIF op$ = ">" THEN
  3.         postOp$ = root_2$(ca$)
  4.  
  5.  

Code: QB64: [Select]
  1. FUNCTION root_2$ (A$)
  2.     DIM x$, dx$
  3.     DIM precision, max_iterations
  4.     DIM i AS INTEGER
  5.  
  6.     x$ = mr$(A$, "/", "2"): precision = 0.001: max_iterations = 30
  7.     FOR i = 1 TO max_iterations
  8. '*** Formula: dx = (x - A / x) / 2
  9. '*** Reduce x by dx:  x = x - dx
  10.  
  11.          dx$ = mr$(mr$(x$, "-", mr$(A$, "/", x$)), "/", "2")
  12.  
  13. '         dx$ = mr$(A$, "/", x$)
  14. '         dx$ = mr$(x$, "-", dx$)
  15. '         dx$ = mr$(dx$, "/", "2")
  16.          x$ = mr$(x$, "-", dx$)
  17.          PRINT "DX$ = "; dx$
  18.          PRINT "X$  = "; x$: PRINT
  19.          IF ABS(VAL(dx$)) < precision THEN i = max_iterations
  20.     NEXT i
  21.     root_2$ = x$


Here is my run of the function above. You will see that dx$ is right, but x$ should be just 10. If you want, I can post the entire MR program.
 
Screenshot from 2021-06-03 21-24-23.png

« Last Edit: June 03, 2021, 09:29:31 pm by George McGinn »
____________________________________________________________________
George McGinn
Theoretical/Applied Computer Scientist
Member: IEEE, IEEE Computer Society
Technical Council on Software Engineering
IEEE Standards Association
American Association for the Advancement of Science (AAAS)

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: String Math
« Reply #35 on: June 03, 2021, 09:39:39 pm »
@bplus
your string math does not understand numbers in exponential format so when the input number get big and the Sqr of the number is expressed in exponential format then my version fails, I suppose there may be a way to fix that

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: String Math
« Reply #36 on: June 03, 2021, 09:44:25 pm »
the Newton-Raphson formula for the square root is
r = r - (r^2-x)/(2*r)
in general the inverse function approximation is found by
Xi = Xi - ( f(Xi) -x)/ f ' (Xi)
« Last Edit: June 03, 2021, 09:51:06 pm by jack »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: String Math
« Reply #37 on: June 03, 2021, 09:50:21 pm »
@bplus
your string math does not understand numbers in exponential format so when the input number get big and the Sqr of the number is expressed in exponential format then my version fails, I suppose there may be a way to fix that

Right! String Math means no exponents, it's straight digits and though it takes longer it's accurate with the biggest and smallest of numbers
@jack your code here:
Code: QB64: [Select]
  1. Function sqrt$ (n$)
  2.     Dim As String r, tmp, r2
  3.     Dim As Integer k
  4.     r = _Trim$(Str$(Sqr(Val(n$)))) ' <<<<<<<<<<<<
  5.     For k = 1 To 3
  6.         tmp = mr$(r, "*", r)
  7.         tmp = mr$(tmp, "-", n$)
  8.         r2 = mr$(r, "+", r)
  9.         tmp = mr$(tmp, "/", r2)
  10.         r = mr$(r, "-", tmp)
  11.         If Len(r) > 101 Then r = Left$(r, 101)
  12.     Next k 'Loop Until Abs(Val(tmp)) < 1D-100
  13.     sqrt$ = r
  14.  
Uses 2 functions not available to String Math,
 
VAL() because there are only string type variables
EDIT: well maybe VAL() will work on smaller strings but I don't see it handling a string a 100 digits long?

SQR() heck! that's exactly what we are looking for, of course it's faster but only works for regular type numbers, integers, longs, single, double... not a string of digits.
EDIT: Unless you are somehow dividing the string into workable sections and taking SQR() of those and string together a giant construction like we do with the add$, mult$, subtract$ then I am misunderstanding, apologies.
In fact I have something like that from way back doing SQR, like we learned in school.

 
Jack code.PNG
« Last Edit: June 03, 2021, 10:35:44 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: String Math
« Reply #38 on: June 03, 2021, 09:53:23 pm »
the Newton-Raphson formula for the square root is
r = r - (r^2-x)/(2*r)
in general the inverse function approximation is found by
Xi = Xi - ( f(Xi) -x)/ f ' (Xi)

I was going by George McGinn example which did seem to be working for big numbers (but not dot 20-0's64 or .0000000000000000000064).

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: String Math
« Reply #39 on: June 03, 2021, 10:32:37 pm »
@bplus - Here is my version of the Square Root using strings.

I have integrated it into your MR program. However, as you will see from the result screen, it seems like it does not clear out what is in the decimal places.

I am using your add, subtract and divide routines, and I'm not yet sure if it is an error with your routines not clearing out the decimal places, or that they are not designed to be nested in a formula (the ones my friend and I wrote for the iPad/iPhone does work properly), or I just don't understand how your program fully works.

I created an OP code ">" to represent Square Root, and the second number is set to "" (can be any value really, as it is never referenced in my routine.

Because the iterations do not stop when dx$ = "10" I get an erroneous result. As you will see I have both the original formula expressed properly in your mr$ format, as well as it broken out in its components based on the order of operations. I get the same results in both, that is I get a carryover of the decimals from the prior iteration.

Code: QB64: [Select]
  1. PRINT "Square Root of 100 equals "; mr$("100", ">", "")    

Code: QB64: [Select]
  1. '*** Add in Square Root Function
  2.     ELSEIF op$ = ">" THEN
  3.         postOp$ = root_2$(ca$)
  4.  
  5.  

Code: QB64: [Select]
  1. FUNCTION root_2$ (A$)
  2.     DIM x$, dx$
  3.     DIM precision, max_iterations
  4.     DIM i AS INTEGER
  5.  
  6.     x$ = mr$(A$, "/", "2"): precision = 0.001: max_iterations = 30
  7.     FOR i = 1 TO max_iterations
  8. '*** Formula: dx = (x - A / x) / 2
  9. '*** Reduce x by dx:  x = x - dx
  10.  
  11.          dx$ = mr$(mr$(x$, "-", mr$(A$, "/", x$)), "/", "2")
  12.  
  13. '         dx$ = mr$(A$, "/", x$)
  14. '         dx$ = mr$(x$, "-", dx$)
  15. '         dx$ = mr$(dx$, "/", "2")
  16.          x$ = mr$(x$, "-", dx$)
  17.          PRINT "DX$ = "; dx$
  18.          PRINT "X$  = "; x$: PRINT
  19.          IF ABS(VAL(dx$)) < precision THEN i = max_iterations
  20.     NEXT i
  21.     root_2$ = x$


Here is my run of the function above. You will see that dx$ is right, but x$ should be just 10. If you want, I can post the entire MR program.
 
Screenshot from 2021-06-03 21-24-23.png


@George McGinn are we so different?
Code: QB64: [Select]
  1. Function SRbyNR$ (nmbr$) ' square root by Newton - Ralphson method my interpretation of GeorgeMcGinn
  2.  
  3.     Dim n$, guess$, lastGuess$, dx$, imaginary$, other$, loopcnt
  4.     If Left$(nmbr$, 1) = "-" Then 'handle neg numbers
  5.         imaginary$ = "*i": n$ = Mid$(nmbr$, 2)
  6.     Else
  7.         imaginary$ = "": n$ = nmbr$
  8.     End If
  9.  
  10.     guess$ = mr$(n$, "/", "2") ' get this going first and then try better starting guess later
  11.  
  12.     Do
  13.         loopcnt = loopcnt + 1
  14.         Print "loop cnt"; loopcnt
  15.         If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then ' go past 100 matching digits for 100 digit precision
  16.             SRbyNR$ = Mid$(other$, 1, 101) + imaginary$
  17.             Exit Function
  18.         Else
  19.             'dx = (x - A / x) / 2: x = x - dx ' Thanks George
  20.             lastGuess$ = guess$
  21.             dx$ = mr$(mr$(guess$, "-", mr$(n$, "/", guess$)), "/", "2")
  22.             guess$ = mr$(guess$, "-", dx$)
  23.             other$ = mr$(n$, "/", guess$) ' try other factor for guess$  sometimes it nails answer without all digits
  24.         End If
  25.     Loop

dx$ = mr$(mr$(guess$, "-", mr$(n$, "/", guess$)), "/", "2") ' yes you can team functions up like this that is fine!
dx$ = mr$(mr$(x$, "-", mr$(A$, "/", x$)), "/", "2")

We just use different variables with the main formula.

This is where we differ, Finished conditional-
yours:
Code: QB64: [Select]
  1. IF ABS(VAL(dx$)) < precision THEN i = max_iterations
ABS() needs a number type and I don't trust VAL() to handle 100 plus digit strings.
Hence I don't trust < to work as expected.

mine:
Code: QB64: [Select]
  1. If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then
So I went the route of matching strings down until the first 100 digits of last guess match first 100 digits of current guess. Oddly our method would rather go 100-9's, 1.9999999...'s, than go to 2.0 for the square root of 4!
If guess is always growing larger towards 2, the other factor is gaining 0's after decimal such that it looks exactly right when we cut off after 100 digits of 0's (for 2.0000000000...) have been accumulated.
« Last Edit: June 03, 2021, 11:42:06 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: String Math
« Reply #40 on: June 03, 2021, 10:47:31 pm »
@jack no exponents, is that a paradigm shift? do you feel the freedom or do you feel like you lost your best friend? like you are dealing with stone age folks!

Obviously it's slow as hell but the accuracy!
« Last Edit: June 03, 2021, 10:49:23 pm by bplus »

Offline George McGinn

  • Global Moderator
  • Forum Regular
  • Posts: 210
    • View Profile
    • Resume
Re: String Math
« Reply #41 on: June 04, 2021, 12:01:48 am »
@bplus - DUH, you're right. I saw the word 'guess" which threw me off.

I put your routine in with mine to test it out.

Both produces 2 as the square root of 4, but when I do SRQ(100) I get 5. ... from mine (which is the issue I outlined) but yours does not produce a result.

Are we having the same issue?
____________________________________________________________________
George McGinn
Theoretical/Applied Computer Scientist
Member: IEEE, IEEE Computer Society
Technical Council on Software Engineering
IEEE Standards Association
American Association for the Advancement of Science (AAAS)

Offline George McGinn

  • Global Moderator
  • Forum Regular
  • Posts: 210
    • View Profile
    • Resume
Re: String Math
« Reply #42 on: June 04, 2021, 12:06:23 am »
This was the reason why my friend and I decided to add a precision check.

As for the question about VAL working on a string of 100 digits/decimal places, it works fine from my testing on both mobile devices (from the original code) to what I ported over to QB64.


I was going by George McGinn example which did seem to be working for big numbers (but not dot 20-0's64 or .0000000000000000000064).
____________________________________________________________________
George McGinn
Theoretical/Applied Computer Scientist
Member: IEEE, IEEE Computer Society
Technical Council on Software Engineering
IEEE Standards Association
American Association for the Advancement of Science (AAAS)

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: String Math
« Reply #43 on: June 04, 2021, 07:20:19 am »
@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.  
Quote
Enter a number to find it's square root ?  20000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
 26.375  141421356237309504880168872420969807856967187537694807317667.9737990732478462107038850387534327641572
 .0546875          141421356237309504880168872420969807856967187537694807317667.9737990732478462107038850387534327641572
about 482 times faster
« Last Edit: June 04, 2021, 07:50:12 am by jack »

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: String Math
« Reply #44 on: June 04, 2021, 08:21:09 am »
bplus, there's a bug in your subtract routine
Code: QB64: [Select]
  1. result$ = mr$(".00000000000000000000000000000000000000000000200000000000000054307978001764", "-", ".000000000000000000000000000000000000000000002")
  2. Print result$
  3.  
the output
Quote
.000000000000000000000054307978001764
it should be
Quote
.00000000000000000000000000000000000000000000000000000000000054307978001764