_Title "Math regulator mr test sqr estimating" ' b+ start 2021-06-02 ' divide$ found fix? 2021-06-03 comment in that function
' 2021-06-03 update with new sqrRoot$ Function
'remember everything is strings
Input "Enter a number to find it's square root "; n$
result$ = sqrRoot$(n$)
result$ = SRbyNR$(n$)
Dim n$
, guess$
, lastGuess$
, other$
, sum$
, imaginary$
, loopcnt
imaginary$
= "*i": n$
= Mid$(nmbr$
, 2) imaginary$ = "": n$ = nmbr$
guess$ = mr$(n$, "/", "2")
other$ = n$
loopcnt = loopcnt + 1
Print "loop cnt"; loopcnt
If (Mid$(guess$
, 1, 105) = Mid$(lastGuess$
, 1, 105)) Then ' go past 100 matching digits for 100 digit precision sqrRoot$
= Mid$(other$
, 1, 101) + imaginary$
' try other factor for guess$ sometimes it nails answer without all digits lastGuess$ = guess$
sum$ = mr$(guess$, "+", other$)
guess$ = mr$(sum$, "/", "2")
other$ = mr$(n$, "/", guess$)
Function SRbyNR$
(nmbr$
) ' square root by Newton - Ralphson method my interpretation of GeorgeMcGinn
Dim n$
, guess$
, lastGuess$
, dx$
, imaginary$
, other$
, loopcnt
imaginary$
= "*i": n$
= Mid$(nmbr$
, 2) imaginary$ = "": n$ = nmbr$
guess$ = mr$(n$, "/", "2") ' get this going first and then try better starting guess later
loopcnt = loopcnt + 1
Print "loop cnt"; loopcnt
If (Mid$(guess$
, 1, 105) = Mid$(lastGuess$
, 1, 105)) Then ' go past 100 matching digits for 100 digit precision SRbyNR$
= Mid$(other$
, 1, 101) + imaginary$
'dx = (x - A / x) / 2: x = x - dx ' Thanks George
lastGuess$ = guess$
dx$ = mr$(mr$(guess$, "-", mr$(n$, "/", guess$)), "/", "2")
guess$ = mr$(guess$, "-", dx$)
other$ = mr$(n$, "/", guess$) ' try other factor for guess$ sometimes it nails answer without all digits
Function mr$
(a$
, op$
, b$
) ' catchy? mr$ for math regulator Dim ca$
, cb$
, aSgn$
, bSgn$
, postOp$
, sgn$
op$
= _Trim$(op$
) 'save fixing each time ca$
= _Trim$(a$
): cb$
= _Trim$(b$
) 'make copies in case we change 'strip signs and decimals
aSgn$
= "-": ca$
= Mid$(ca$
, 2) aSgn$ = "": ca$ = ca$
ca$
= Mid$(ca$
, 1, dp
- 1) + Mid$(ca$
, dp
+ 1) adp = 0
bSgn$
= "-": cb$
= Mid$(cb$
, 2) bSgn$ = "": cb$ = cb$
cb$
= Mid$(cb$
, 1, dp
- 1) + Mid$(cb$
, dp
+ 1) bdp = 0
If op$
= "+" Or op$
= "-" Or op$
= "/" Then 'add or subtr even up strings on right of decimal 'even up the right sides of decimals if any
dp = adp + bdp
'now according to signs and op$ call add$ or subtr$
If aSgn$
= bSgn$
Then 'really add postOp$ = aSgn$ + add$(ca$, cb$)
Else 'have a case of subtraction If aSgn$
= "-" Then postOp$
= subtr$
(cb$
, ca$
) Else postOp$
= subtr$
(ca$
, cb$
) If bSgn$
= "-" Then 'really add but switch b sign bSgn$ = ""
postOp$ = subtr$(cb$, ca$)
postOp$ = add$(ca$, cb$)
bSgn$ = "-"
postOp$ = aSgn$ + add$(ca$, cb$)
postOp$ = subtr$(ca$, cb$)
postOp$
= sgn$
+ mult$
(ca$
, cb$
) postOp$
= sgn$
+ divide$
(ca$
, cb$
) 'put dp back
lpop
= Len(postOp$
) ' put decimal back postOp$
= Mid$(postOp$
, 1, lpop
- dp
) + "." + Mid$(postOp$
, lpop
- dp
+ 1) mr$ = trim0$(postOp$)
Function divide$
(n$
, d$
) ' goal here is 100 digits precision not 100 digits past decimal
' aha! found a bug when d$ gets really huge 100 is no where near enough!!!!
' 2021-06-03 fix by adding 100 to len(d$), plus have to go a little past 100 for 100 digit precision
' need to go past 100 for 100 precise digits (not decimal places)
di$
= Mid$(nInverse$
(d$
, Len(d$
) + 200), 2) 'chop off decimal point after ndi$ = mult$(n$, di$)
divide$ = trim0$(ndi$)
Function nInverse$
(n$
, DP
As Integer) 'assume decimal at very start of the string of digits returned, no rounding Dim m$
(1 To 9), si$
, r$
, outstr$
, d$
m$(i) = mult$(si$, n$)
outstr$ = ""
outstr$ = "." 'everything else n > 1 is decimal 8/17
r$ = "10"
outstr$ = outstr$ + "0" ' add 0 to the output string
r$ = r$ + "0"
outstr$ = outstr$ + d$
r$ = subtr$(r$, mult$(d$, n$)) 'r = r -d*n
r$ = r$ + "0" 'add another place
Function mult$
(a$
, b$
) 'assume both positive integers prechecked as all digits strings Dim f18$
, f1$
, t$
, build$
, accum$
'find the longer number and make it a mult of 18 to take 18 digits at a time from it
f1$ = b$
f1$ = a$
For dp
= Len(f1$
) To 1 Step -1 'dp = digit position of the f1$ build$ = "" 'line builder
co = 0
'now taking 18 digits at a time Thanks Steve McNeill
v18
= Val(Mid$(f18$
, m
* 18 - g
* 18 + 1, 18)) build$
= Mid$(t$
, 2) + build$
accum$ = build$
accum$
= add$
(accum$
, build$
+ String$(Len(f1$
) - dp
, "0")) mult$ = accum$
Function subtr$
(sum$
, minus$
) ' assume both numbers are positive all digits Dim ts$
, tm$
, sign$
, LG$
, sm$
, t$
, result$
ts$ = TrimLead0$(sum$): tm$ = TrimLead0$(minus$)
If trim0
(ts$
) = trim0$
(tm$
) Then subtr$
= "0":
Exit Function 'OK proceed with function knowing they are not equal tenE18 = 1000000000000000000 'yes!!! no dang E's
If LTE
(ts$
, tm$
) Then ' which is bigger? minus is bigger sign$ = "-"
sign$ = ""
'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
VB
= Val(Mid$(LG$
, m
* 18 - g
* 18 + 1, 18)) vs
= Val(Mid$(sm$
, m
* 18 - g
* 18 + 1, 18)) p = (m - g) * 18
p = p - 1
result$ = t$ + result$
subtr$ = sign$ + result$
Function add$
(a$
, b$
) 'add 2 positive integers assume a and b are just numbers no spaces or - signs 'first thing is to set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
Dim fa$
, fb$
, t$
, new$
, result$
'now taking 18 digits at a time Thanks Steve McNeill
sa
= Val(Mid$(fa$
, m
* 18 - g
* 18 + 1, 18)) sb
= Val(Mid$(fb$
, m
* 18 - g
* 18 + 1, 18)) result$ = new$ + result$
add$ = result$
' String Math Helpers -----------------------------------------------
'this function needs TrimLead0$(s$)
Function LTE
(a$
, b$
) ' a$ Less Than or Equal b$ comparison of 2 strings ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
LTE = -1
LTE = -1
LTE = 0
' ------------------------------------- use these for final display
Function TrimLead0$
(s$
) 'for treating strings as number (pos integers) copys$
= _Trim$(s$
) 'might as well remove spaces too i = 1: find = 0
i = i + 1: find = 1
If copys$
= "" Then TrimLead0$
= "0" Else TrimLead0$
= copys$
copys$
= _Trim$(s$
) 'might as well remove spaces too TrimTail0$ = copys$
i
= Len(copys$
): find
= 0 i = i - 1: find = 1
TrimTail0$
= Mid$(copys$
, 1, dp
- 1) TrimTail0$
= Mid$(copys$
, 1, i
)
cs$ = s$
cs$ = TrimLead0$(cs$)
cs$ = TrimTail0$(cs$)
If si$
= "-" Then trim0$
= si$
+ cs$
Else trim0$
= cs$
' for displaying truncated numbers say to 60 digits
cNum$ = num$ 'since num$ could get changed
showDP$ = num$
d
= Val(Mid$(cNum$
, dp
+ nDP
+ 1, 1)) cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
dp = dp + 1
i = dp + nDP
i = i - 1
cNum$
= Mid$(cNum$
, 1, dp
+ nDP
) 'chop it showDP$ = trim0$(cNum$)
showDP$
= Mid$(cNum$
, 1, dp
+ nDP
)