+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://staging.qb64phoenix.com/forumdisplay.php?fid=9)
+---- Thread: b+ String Math Update (/showthread.php?tid=924)
Pages:
1
2
b+ String Math Update - bplus - 09-26-2022
I have Square Root worked out better faster and accurate to any decimal places (currently set 100) and conversions Dec2Bin$ strings and Bin2Dec$, still working on Real Number Power$
Dec2Bin$ and Bin2Dec$ don't work like bit math for negative values but like decimal numbers ie a minus sign says it's negative and no sign means it's positive. There is no checking if the test$ binary you enter is just 1's and zero's so don't test that and say it's not working. So to test -8.375 try -1000.011
Code: (Select All)
Option _Explicit
_Title "String Math Powers 2022-09-22" ' b+ try to do powers with string math
' directly from "String Math 2021-06-14" ' b+ from SM2 (2021 June) a bunch of experiments to fix and improve speeds.
' June 2021 fix some old String Math procedures, better nInverse with new LT frunction, remove experimental procedures.
' Now with decent sqrRoot it works independent of Mr$() = Math Regulator that handles signs and decimals and calls to
' add$(), subtr$, mult$, divide$ (100 significant digits), add$(), subtr$, mult$ are exact!
' If you need higher precsion divide, I recommend use nInverse on denominator (integer)
' then add sign and decimal and mult$() that number with numerator to get divsion answer in higher precision than 100.
' (See how Mr$() handles division and just call nInverse$ with what precision you need.)
' The final function showDP$() is for displaying these number to a set amount of Decimal Places.
' The main code is sampler of tests performed with these functions.
' 2022-09-22 a little fix to MR$ for Function change versions QB64 v2.0+
' Attempt to do Powers with SQRs of 2 Multipliers
' needs to be able to convert a number into a binary String
' might also need a Table setup for nested SQR's of 2
' needs a decent BigSQR$ string function for SQR
' 2022-09-25 this is one frustration after another LT does not work for strings??? but < does?
' try some more with BigSQR concentrate on Integer part first, just get that right
' 2022-09-26 Bin2Dec$ Function seems OK
$Console:Only
Randomize Timer
'Dim As Double i ' testing Dec2Bin$
'Dim p2$, x$, sum$
'p2$ = "1"
'For i = 1 To 50
' p2$ = mr$(p2$, "/", "2")
' x$ = mr$(x$, "+", "1")
' sum$ = mr$(x$, "+", p2$)
' Print sum$, Dec2Bin$(sum$)
' 'Sleep
'Next
'Print: Print " Square Roots:"
'Dim b$, intger$
'For i = 1 To 50
' b$ = Str$(i + 1 / (2 ^ i))
' Print b$, bigSQR$(b$)
'Next
'intger$ = "10000000000000000000000000000000000000000000000000000000000000000"
'Print: Print "Bonus SQR of "; intger$; " Len = "; Len(intger$); " is:"
'b$ = bigSQR$(intger$)
'Print b$, " Len Integer Part ="; Len(Mid$(b$, 1, InStr(b$, ".") - 1))
'intger$ = "100000000000000000000000000000000000000000000000000000000000000000"
'Print: Print "Bonus SQR of "; intger$; " Len = "; Len(intger$); " is:"
'b$ = bigSQR$(intger$)
'Print b$, " Len Integer Part ="; Len(Mid$(b$, 1, InStr(b$, ".") - 1))
'Print: Print " Square Roots:"
' ============ For comparison this was the old routine
'Print: Print "Square Roots the old way of estimation:"
'For i = 1 To 50
' b$ = Str$(i + 1 / (2 ^ i))
' Print b$, sqrRoot$(b$)
'Next
'intger$ = "10000000000000000000000000000000000000000000000000000000000000000"
'Print: Print "Bonus SQR of "; intger$; " Len = "; Len(intger$); " is:"
'b$ = sqrRoot$(intger$)
'Print b$, " Len Integer Part ="; Len(b$)
'intger$ = "100000000000000000000000000000000000000000000000000000000000000000"
'Print: Print "Bonus SQR of "; intger$; " Len = "; Len(intger$); " is:"
'b$ = sqrRoot$(intger$)
'Print b$, " Len Integer Part ="; Len(Mid$(b$, 1, InStr(b$, ".") - 1))
' ============================================================================
' OK now test the new Power$ routine
'Print power$("5", ".333333333333333333333333333333333") ' 2 ' no this ain't work in well at all
Dim test$, ans$
Do
Input "Enter a Binary with/without - sgn or decimal "; test$
ans$ = Bin2Dec$(test$)
Print "Decimal is: "; ans$
Print "Check conversion back: "; Dec2Bin$(ans$)
Loop Until test$ = ""
' x to the power of pow
Function power$ (xx$, pow$) ' so far this sucks, decimal is lost and digits only good for about 10 places 10% of dp in SQR(2)'s
Dim build$, ip$, fp$, x$, bs$, runningXSQR$
Dim As Long dot, i
x$ = _Trim$(xx$)
dot = InStr(pow$, ".")
If dot Then
ip$ = Mid$(pow$, 1, dot - 1)
fp$ = Mid$(pow$, dot) ' keep dot
Else
ip$ = pow$
fp$ = ""
End If
'integer part or power
build$ = "1"
If ip$ <> "" Then
While LTE("0", ip$)
build$ = mr$(build$, "*", x$)
ip$ = mr$(ip$, "-", "1")
Wend
End If
If fp$ = "" Or fp$ = "." Then power$ = build$: Exit Function
build$ = build$ + "."
'now for the fraction part convert decimal to Binary
bs$ = Dec2Bin$(fp$)
'at moment we haven't taken any sqr of x
runningXSQR$ = mr$(x$, "*", x$)
'run through all the 0's and 1's in the bianry expansion of the fraction part of the power float
For i = 1 To Len(bs$)
'this is the matching sqr of the sqr of the sqr... of x
runningXSQR$ = bigSQR$(runningXSQR$)
'for every 1 in the expansion, multiple our build with the running sqr of ... sqr of x
If Mid$(bs$, i, 1) = "1" Then build$ = mr$(build$, "*", runningXSQR$)
Next
'our build should be a estimate or x to power of pow
power$ = build$
End Function
Function Bin2Dec$ (bn$) ' bn$ is binary string number with possible neg sign and decimal
Dim b$, sgn$, ip$, fp$, p2$, build$
Dim As Long dot, i
b$ = _Trim$(bn$)
If Left$(b$, 1) = "-" Then sgn$ = "-": b$ = Mid$(b$, 2) Else sgn$ = ""
dot = InStr(b$, ".")
If dot Then
ip$ = Mid$(b$, 1, dot - 1)
fp$ = Mid$(b$, dot + 1)
Else
ip$ = b$
fp$ = ""
End If
p2$ = "1"
For i = Len(ip$) To 1 Step -1
If Mid$(ip$, i, 1) = "1" Then build$ = mr$(build$, "+", p2$)
p2$ = mr$(p2$, "*", "2")
Next
If fp$ <> "" Then
build$ = build$ + "."
p2$ = "1"
For i = 1 To Len(fp$)
p2$ = mr$(p2$, "/", "2")
If Mid$(fp$, i, 1) = "1" Then build$ = mr$(build$, "+", p2$)
Next
End If
Bin2Dec$ = sgn$ + build$
End Function
Function bigSQR$ (number$)
Dim ip$, fp$, n$, calc$, remainder$, new$, test$
Dim As Long dot, dp, i, pulldown, cal, digit, maxDec
maxDec = 100
' divide number into integer part, ip$ and fraction part, fp$ , figure decimal places to left of decimal then even up front and back
dot = InStr(number$, ".")
If dot Then
ip$ = _Trim$(Mid$(number$, 1, dot - 1))
fp$ = Left$(_Trim$(Mid$(number$, dot + 1)) + String$(2 * maxDec, "0"), 2 * maxDec)
Else
ip$ = _Trim$(number$)
If Len(ip$) Mod 2 = 1 Then ip$ = "0" + ip$
fp$ = String$(2 * maxDec, "0")
End If
dp = Int((Len(ip$) + 1) / 2)
If Len(ip$) Mod 2 = 1 Then ip$ = "0" + ip$
n$ = ip$ + fp$
For i = 1 To Len(n$) Step 2
pulldown = Val(Mid$(n$, i, 2))
If i = 1 Then
cal = Int(Sqr(pulldown))
remainder$ = _Trim$(Str$(pulldown - cal * cal))
calc$ = _Trim$(Str$(cal))
Else
new$ = mr$("100", "*", remainder$)
new$ = mr$(new$, "+", _Trim$(Str$(pulldown)))
For digit = 9 To 0 Step -1
'test$ = (20 * Val(calc$) + digit) * digit
test$ = mr$("20", "*", calc$)
test$ = mr$(test$, "+", _Trim$(Str$(digit)))
test$ = mr$(test$, "*", _Trim$(Str$(digit)))
If LTE(test$, new$) Then Exit For
Next
calc$ = calc$ + _Trim$(Str$(digit))
remainder$ = mr$(new$, "-", test$)
End If
Next
If dp Then
calc$ = Mid$(calc$, 1, dp) + "." + Mid$(calc$, dp + 1)
Else
calc$ = "." + calc$
End If
bigSQR$ = calc$
End Function
' New stuff
Function Dec2Bin$ (Dec$)
Dim sgn$, d$, ip$, fp$, b$, tp$
Dim As Long dot, c
If _Trim$(Left$(Dec$, 1)) = "-" Then
sgn$ = "-": d$ = Mid$(_Trim$(Dec$), 2)
Else
sgn$ = "": d$ = _Trim$(Dec$)
End If
dot = InStr(d$, ".")
If dot Then
ip$ = Mid$(d$, 1, dot - 1): fp$ = Mid$(d$, dot)
Else ' all integer
ip$ = d$: fp$ = "."
End If
tp$ = "2"
If LTE(tp$, ip$) Then
While LTE(tp$, ip$)
tp$ = mr$(tp$, "*", "2")
Wend
End If
While LT("1", tp$)
tp$ = mr$(tp$, "/", "2")
If LTE(tp$, "1") Then b$ = b$ + ip$: Exit While
If LT(ip$, tp$) Then
b$ = b$ + "0"
Else
b$ = b$ + "1"
ip$ = mr$(ip$, "-", tp$)
End If
Wend
b$ = b$ + "." ' cross over point to fractions
tp$ = "1"
'Print "start fp$ "; fp$
While c < 200 'And LT("0", fp$)
tp$ = mr$(tp$, "/", "2")
'If LT(fp$, tp$) Then ' for some reason LT is not working but < is
If fp$ < tp$ Then ' for some reason LT is not working but < is
b$ = b$ + "0"
Else
b$ = b$ + "1"
fp$ = mr$(fp$, "-", tp$)
If LTE(fp$, "0") Then Exit While
End If
c = c + 1
Wend
Dec2Bin$ = sgn$ + b$ ' b$ = build of 0,1 and .
End Function
' 2022-09-25 Use BigSQR$ it's way faster, no estimating!
' == String Math 2021-06-14 Procedure start here (aprox 412 LOC for copy/paste into your app) ==
Function sqrRoot$ (nmbr$)
Dim n$, guess$, lastGuess$, other$, sum$, imaginary$, loopcnt
If Left$(nmbr$, 1) = "-" Then 'handle neg numbers
imaginary$ = "*i": n$ = Mid$(nmbr$, 2)
Else
imaginary$ = "": n$ = nmbr$
End If
guess$ = mr$(n$, "/", "2")
other$ = n$
Do
loopcnt = loopcnt + 1
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
Exit Function
Else
lastGuess$ = guess$
sum$ = mr$(guess$, "+", other$)
guess$ = mr$(sum$, "/", "2")
other$ = mr$(n$, "/", guess$)
End If
Loop
End Function
Function add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no - signs
'set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
Dim As Long la, lb, m, g
Dim sa As _Unsigned _Integer64, sb As _Unsigned _Integer64, co As _Unsigned _Integer64
Dim fa$, fb$, t$, new$, result$
la = Len(a$): lb = Len(b$)
If la > lb Then m = Int(la / 18) + 1 Else m = Int(lb / 18) + 1
fa$ = Right$(String$(m * 18, "0") + a$, m * 18)
fb$ = Right$(String$(m * 18, "0") + b$, m * 18)
'now taking 18 digits at a time Thanks Steve McNeill
For g = 1 To m
sa = Val(Mid$(fa$, (m - g) * 18 + 1, 18))
sb = Val(Mid$(fb$, (m - g) * 18 + 1, 18))
t$ = Right$(String$(36, "0") + _Trim$(Str$(sa + sb + co)), 36)
co = Val(Mid$(t$, 1, 18))
new$ = Mid$(t$, 19)
result$ = new$ + result$
Next
If co Then result$ = Str$(co) + result$
add$ = result$
End Function
' This is used in nInverse$ not by Mr$ because there it saves time!
Function subtr1$ (a$, b$)
Dim As Long la, lb, lResult, i, ca, cb, w
Dim result$, fa$, fb$
la = Len(a$): lb = Len(b$)
If la > lb Then lResult = la Else lResult = lb
result$ = Space$(lResult)
fa$ = result$: fb$ = result$
Mid$(fa$, lResult - la + 1) = a$
Mid$(fb$, lResult - lb + 1) = b$
For i = lResult To 1 Step -1
ca = Val(Mid$(fa$, i, 1))
cb = Val(Mid$(fb$, i, 1))
If cb > ca Then ' borrow 10
Mid$(result$, i, 1) = Right$(Str$(10 + ca - cb), 1)
w = i - 1
While w > 0 And Mid$(fa$, w, 1) = "0"
Mid$(fa$, w, 1) = "9"
w = w - 1
Wend
Mid$(fa$, w, 1) = Right$(Str$(Val(Mid$(fa$, w, 1)) - 1), 1)
Else
Mid$(result$, i, 1) = Right$(Str$(ca - cb), 1)
End If
Next
subtr1$ = result$
End Function
' 2021-06-08 fix up with new mr call that decides the sign and puts the greater number first
Function subtr$ (sum$, minus$) ' assume both numbers are positive all digits
Dim As Long m, g, p
Dim VB As _Unsigned _Integer64, vs As _Unsigned _Integer64, tenE18 As _Unsigned _Integer64
Dim ts$, tm$, sign$, LG$, sm$, t$, result$
ts$ = _Trim$(sum$): tm$ = _Trim$(minus$) ' fixed subtr$ 2021-06-05
If trim0(ts$) = trim0$(tm$) Then subtr$ = "0": Exit Function 'proceed knowing not equal
tenE18 = 1000000000000000000 'yes!!! no dang E's
sign$ = ""
m = Int(Len(ts$) / 18) + 1
LG$ = Right$(String$(m * 18, "0") + ts$, m * 18)
sm$ = Right$(String$(m * 18, "0") + tm$, m * 18)
'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
For g = 1 To m
VB = Val(Mid$(LG$, m * 18 - g * 18 + 1, 18))
vs = Val(Mid$(sm$, m * 18 - g * 18 + 1, 18))
If vs > VB Then
t$ = Right$(String$(18, "0") + _Trim$(Str$(tenE18 - vs + VB)), 18)
p = (m - g) * 18
While p > 0 And Mid$(LG$, p, 1) = "0"
Mid$(LG$, p, 1) = "9"
p = p - 1
Wend
If p > 0 Then Mid$(LG$, p, 1) = _Trim$(Str$(Val(Mid$(LG$, p, 1)) - 1))
Else
t$ = Right$(String$(18, "0") + _Trim$(Str$(VB - vs)), 18)
End If
result$ = t$ + result$
Next
subtr$ = result$
End Function
Function TrimLead0$ (s$) 'for treating strings as number (pos integers)
Dim copys$
Dim As Long i, find
copys$ = _Trim$(s$) 'might as well remove spaces too
i = 1: find = 0
While i < Len(copys$) And Mid$(copys$, i, 1) = "0"
i = i + 1: find = 1
Wend
If find = 1 Then copys$ = Mid$(copys$, i)
If copys$ = "" Then TrimLead0$ = "0" Else TrimLead0$ = copys$
End Function
' catchy? mr$ for math regulator cop$ = " + - * / " 1 of 4 basic arithmetics
' Fixed so that add and subtract have signs calc'd in Mr and correct call to add or subtract made
' with bigger minus smaller in subtr$() call
Function mr$ (a$, cop$, b$)
Dim op$, ca$, cb$, aSgn$, bSgn$, postOp$, sgn$, rtn$
Dim As Long adp, bdp, dp, lpop, aLTb
op$ = _Trim$(cop$) 'save fixing each time
ca$ = _Trim$(a$): cb$ = _Trim$(b$) 'make copies in case we change
'strip signs and decimals
If Left$(ca$, 1) = "-" Then
aSgn$ = "-": ca$ = Mid$(ca$, 2)
Else
aSgn$ = ""
End If
dp = InStr(ca$, ".")
If dp > 0 Then
adp = Len(ca$) - dp
ca$ = Mid$(ca$, 1, dp - 1) + Mid$(ca$, dp + 1)
Else
adp = 0
End If
If Left$(cb$, 1) = "-" Then
bSgn$ = "-": cb$ = Mid$(cb$, 2)
Else
bSgn$ = ""
End If
dp = InStr(cb$, ".")
If dp > 0 Then
bdp = Len(cb$) - dp
cb$ = Mid$(cb$, 1, dp - 1) + Mid$(cb$, dp + 1)
Else
bdp = 0
End If
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
If adp > bdp Then dp = adp Else dp = bdp
If adp < dp Then ca$ = ca$ + String$(dp - adp, "0")
If bdp < dp Then cb$ = cb$ + String$(dp - bdp, "0")
ElseIf op$ = "*" Then
dp = adp + bdp
End If
If op$ = "*" Or op$ = "/" Then
If aSgn$ = bSgn$ Then sgn$ = "" Else sgn$ = "-"
End If
'now according to signs and op$ call add$ or subtr$
If op$ = "-" Then ' make it adding according to signs because that is done for + next!
If bSgn$ = "-" Then bSgn$ = "" Else bSgn$ = "-" ' flip bSgn$ with op$
op$ = "+" ' turn this over to + op already done! below
End If
If op$ = "+" Then
If aSgn$ = bSgn$ Then 'really add
postOp$ = add$(ca$, cb$)
sgn$ = aSgn$
ElseIf aSgn$ <> bSgn$ Then 'have a case of subtraction
'but which is first and which is 2nd and should final sign be pos or neg
If TrimLead0$(ca$) = TrimLead0(cb$) Then 'remove case a = b
mr$ = "0": Exit Function
Else
aLTb = LTE(ca$, cb$)
If aSgn$ = "-" Then
If aLTb Then ' b - a = pos
postOp$ = subtr$(cb$, ca$)
sgn$ = ""
Else ' a > b so a - sgn wins - (a - b)
postOp$ = subtr$(ca$, cb$)
sgn$ = "-"
End If
Else ' b has the - sgn
If aLTb Then ' result is -
postOp$ = subtr$(cb$, ca$)
sgn$ = "-"
Else ' result is pos
postOp$ = subtr$(ca$, cb$)
sgn$ = ""
End If
End If
End If
End If
ElseIf op$ = "*" Then
postOp$ = mult$(ca$, cb$)
ElseIf op$ = "/" Then
postOp$ = divide$(ca$, cb$)
End If ' which op
If op$ <> "/" Then 'put dp back
lpop = Len(postOp$) ' put decimal back if there is non zero stuff following it
If Len(Mid$(postOp$, lpop - dp + 1)) Then ' fix 1 extra dot appearing in 10000! ?!
If TrimLead0$(Mid$(postOp$, lpop - dp + 1)) <> "0" Then ' .0 or .00 or .000 ??
postOp$ = Mid$(postOp$, 1, lpop - dp) + "." + Mid$(postOp$, lpop - dp + 1)
End If
End If
End If
rtn$ = trim0$(postOp$) 'trim lead 0's then tack on sign
If rtn$ <> "0" Then mr$ = sgn$ + rtn$ Else mr$ = rtn$
End Function
Function divide$ (n$, d$) ' goal here is 100 digits precision not 100 digits past decimal
Dim di$, ndi$
Dim As Long nD
If n$ = "0" Then divide$ = "0": Exit Function
If d$ = "0" Then divide$ = "div 0": Exit Function
If d$ = "1" Then divide$ = n$: Exit Function
' 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 like 200
di$ = Mid$(nInverse$(d$, Len(d$) + 200), 2) 'chop off decimal point after
nD = Len(di$)
ndi$ = mult$(n$, di$)
ndi$ = Mid$(ndi$, 1, Len(ndi$) - nD) + "." + Right$(String$(nD, "0") + Right$(ndi$, nD), nD)
divide$ = ndi$
End Function
' This uses Subtr1$ is Positive Integer only!
' DP = Decimal places = says when to quit if don't find perfect divisor before
Function nInverse$ (n$, DP As Long) 'assume decimal at very start of the string of digits returned
Dim m$(1 To 9), si$, r$, outstr$, d$
Dim i As Long
For i = 1 To 9
si$ = _Trim$(Str$(i))
m$(i) = mult$(si$, n$)
Next
outstr$ = ""
If n$ = "0" Then nInverse$ = "Div 0": Exit Function
If n$ = "1" Then nInverse$ = "1": Exit Function
outstr$ = "." 'everything else n > 1 is decimal 8/17
r$ = "10"
Do
While LT(r$, n$) ' 2021-06-08 this should be strictly Less Than
outstr$ = outstr$ + "0" ' add 0 to the output string
If Len(outstr$) = DP + 1 Then nInverse$ = outstr$: Exit Function 'DP length?
r$ = r$ + "0"
Wend
For i = 9 To 1 Step -1
If LTE(m$(i), r$) Then d$ = _Trim$(Str$(i)): Exit For
Next
outstr$ = outstr$ + d$
If Len(outstr$) = DP + 1 Then nInverse$ = outstr$: Exit Function
r$ = subtr1$(r$, mult$(d$, n$)) 'r = r -d*n ' 2021-06-08 subtr1 works faster
If TrimLead0$(r$) = "0" Then nInverse$ = outstr$: Exit Function ' add trimlead0$ 6/08
r$ = r$ + "0" 'add another place
Loop
End Function
Function mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
Dim As Long la, lb, m, g, dp
Dim As _Unsigned _Integer64 v18, sd, co
Dim f18$, f1$, t$, build$, accum$
If a$ = "0" Then mult$ = "0": Exit Function
If b$ = "0" Then mult$ = "0": Exit Function
If a$ = "1" Then mult$ = b$: Exit Function
If b$ = "1" Then mult$ = a$: Exit Function
'find the longer number and make it a mult of 18 to take 18 digits at a time from it
la = Len(a$): lb = Len(b$)
If la > lb Then
m = Int(la / 18) + 1
f18$ = Right$(String$(m * 18, "0") + a$, m * 18)
f1$ = b$
Else
m = Int(lb / 18) + 1
f18$ = Right$(String$(m * 18, "0") + b$, m * 18)
f1$ = a$
End If
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
For g = 1 To m
v18 = Val(Mid$(f18$, (m - g) * 18 + 1, 18))
sd = Val(Mid$(f1$, dp, 1))
t$ = Right$(String$(19, "0") + _Trim$(Str$(v18 * sd + co)), 19)
co = Val(Mid$(t$, 1, 1))
build$ = Mid$(t$, 2) + build$
Next g
If co Then build$ = _Trim$(Str$(co)) + build$
If dp = Len(f1$) Then
accum$ = build$
Else
accum$ = add$(accum$, build$ + String$(Len(f1$) - dp, "0"))
End If
Next dp
mult$ = accum$
End Function
'this function needs TrimLead0$(s$) ' dang I can't remember if a$ and b$ can have decimals or not
Function LTE (a$, b$) ' a$ Less Than or Equal b$ comparison of 2 strings
Dim ca$, cb$
Dim As Long la, lb, i
ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
la = Len(ca$): lb = Len(cb$)
If ca$ = cb$ Then
LTE = -1
ElseIf la < lb Then ' a is smaller
LTE = -1
ElseIf la > lb Then ' a is bigger
LTE = 0
ElseIf la = lb Then ' equal lengths
For i = 1 To Len(ca$)
If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
LTE = 0: Exit Function
ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
LTE = -1: Exit Function
End If
Next
End If
End Function
'need this for ninverse faster than subtr$ for sign
Function LT (a$, b$) ' a$ Less Than or Equal b$ comparison of 2 strings
Dim ca$, cb$
Dim As Long la, lb, i
ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
la = Len(ca$): lb = Len(cb$)
If la < lb Then ' a is smaller
LT = -1
ElseIf la > lb Then ' a is bigger
LT = 0
ElseIf la = lb Then ' equal lengths
For i = 1 To Len(ca$)
If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
LT = 0: Exit Function
ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
LT = -1: Exit Function
End If
Next
End If
End Function
Function TrimTail0$ (s$)
Dim copys$
Dim As Long dp, i, find
copys$ = _Trim$(s$) 'might as well remove spaces too
TrimTail0$ = copys$
dp = InStr(copys$, ".")
If dp > 0 Then
i = Len(copys$): find = 0
While i > dp And Mid$(copys$, i, 1) = "0"
i = i - 1: find = 1
Wend
If find = 1 Then
If i = dp Then
TrimTail0$ = Mid$(copys$, 1, dp - 1)
Else
TrimTail0$ = Mid$(copys$, 1, i)
End If
End If
End If
End Function
Function trim0$ (s$)
Dim cs$, si$
cs$ = s$
si$ = Left$(cs$, 1)
If si$ = "-" Then cs$ = Mid$(cs$, 2)
cs$ = TrimLead0$(cs$)
cs$ = TrimTail0$(cs$)
If Right$(cs$, 1) = "." Then cs$ = Mid$(cs$, 1, Len(cs$) - 1)
If si$ = "-" Then trim0$ = si$ + cs$ Else trim0$ = cs$
End Function
' for displaying truncated numbers say to 60 digits
Function showDP$ (num$, nDP As Long)
Dim cNum$
Dim As Long dp, d, i
cNum$ = num$ 'since num$ could get changed
showDP$ = num$
dp = InStr(num$, ".")
If dp > 0 Then
If Len(Mid$(cNum$, dp + 1)) > nDP Then
d = Val(Mid$(cNum$, dp + nDP + 1, 1))
If d > 4 Then
cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
dp = dp + 1
i = dp + nDP
While Mid$(cNum$, i, 1) = "9" Or Mid$(cNum$, i, 1) = "."
If Mid$(cNum$, i, 1) = "9" Then
Mid$(cNum$, i, 1) = "0"
End If
i = i - 1
Wend
Mid$(cNum$, i, 1) = _Trim$(Str$(Val(Mid$(cNum$, i, 1)) + 1)) 'last non 9 digit
cNum$ = Mid$(cNum$, 1, dp + nDP) 'chop it
showDP$ = trim0$(cNum$)
Else
showDP$ = Mid$(cNum$, 1, dp + nDP)
End If
End If
End If
End FunctionRE: b+ String Math Update - Pete - 09-26-2022
So this converts binary to decimal and checks conversion back. Since it uses string math, what was your reason for limiting to 100-digits?
As far as powers go. Easy to do integers. A batch to do decimals by approximation methods. You would need some either documented rounding formulas to straighten them out or a take-forever checking / approximation method to iron out the dependencies. Since powers and roots are inversely related, I'm considering using my nth root calculator as a way to do decimal powers.
Side note: I think we are about even up on line numbers to accomplish this stuff. So for anyone who thinks string math is "simple" and could be done in one or two hundred lines of code, guess again.
Pete
RE: b+ String Math Update - bplus - 09-26-2022
100 digits is enough for Proof of Concept for Binary Conversions and BigSQR's both.
I think I am doing 100 digits with division as well, unless you bypass Mr$ and do NInverse$ directly.
I confess I don't remember if LTE (<=) and LT (<) for number strings work with decimals or not... I suspect NOT.
So I might have to rework them to handle at least decimals maybe negs too.
I know there was a reason you can't use <= and < for number strings but don't remember what goes wrong.
RE: b+ String Math Update - Pete - 09-26-2022
That's what I thought, developer defined limit.
Although in theory string math seems unlimited, it is not practical to design a system it that way. For instance, I use routines limited by loops using _integer64, and use integer math with that variable type to handle groups of numbers. For iterations, that limits my system to whatever 9,223,372,036,854,775,807 gets me in string results. Also, at some point, even with hybrid string-math-numeric model I created, there comes a point where the user is simply waiting too long for results. My goal is to produce up to 1,000 digits in under two minutes for any operation. It only takes a few seconds with straight arithmetic calculations, but complex powers and roots take longer.
Pete
RE: b+ String Math Update - vince - 09-29-2022
nice work, bplus, beat him at his own game!
RE: b+ String Math Update - bplus - 09-29-2022
Not trying to beat Pete, we are at slightly different purposes and interesting as heck to compare approaches.
BTW when I am talking about a Power function I mean a number raised to any Real number including .5 or 1/2 AKA Square Root and .333... or 1/3 AKA Cube root.
The "roots" are special cases of powers in general.
RE: b+ String Math Update - Pete - 09-29-2022
(09-29-2022, 09:26 AM)bplus Wrote: Not trying to beat Pete, we are at slightly different purposes and interesting as heck to compare approaches.
BTW when I am talking about a Power function I mean a number raised to any Real number including .5 or 1/2 AKA Square Root and .333... or 1/3 AKA Cube root.
The "roots" are special cases of powers in general.
@bplus
I updated my work in this area, also shows decimal point now: https://staging.qb64phoenix.com/showthread.php?tid=929&pid=7225#pid7225
You can try things like 8.5 root 2.2 or 8.5^2.2, etc.
Pete
RE: b+ String Math Update - bplus - 10-01-2022
OK here is x^y calculated by way of e^(y*ln(x)) with string math routines for eToTheX$(x$) and nLn$(x$) both used for power$(x, y)
Code: (Select All)
Option _Explicit
_Title "String Math Powers 2022-09-22" ' b+ try to do powers with string math
' directly from "String Math 2021-06-14" ' b+ from SM2 (2021 June) a bunch of experiments to fix and improve speeds.
' June 2021 fix some old String Math procedures, better nInverse with new LT frunction, remove experimental procedures.
' Now with decent sqrRoot it works independent of Mr$() = Math Regulator that handles signs and decimals and calls to
' add$(), subtr$, mult$, divide$ (100 significant digits), add$(), subtr$, mult$ are exact!
' If you need higher precsion divide, I recommend use nInverse on denominator (integer)
' then add sign and decimal and mult$() that number with numerator to get divsion answer in higher precision than 100.
' (See how Mr$() handles division and just call nInverse$ with what precision you need.)
' The final function showDP$() is for displaying these number to a set amount of Decimal Places.
' The main code is sampler of tests performed with these functions.
' 2022-09-22 a little fix to MR$ for Function change versions QB64 v2.0+
' Attempt to do Powers with SQRs of 2 Multipliers
' needs to be able to convert a number into a binary String
' might also need a Table setup for nested SQR's of 2
' needs a decent BigSQR$ string function for SQR
' 2022-09-25 this is one frustration after another LT does not work for strings??? but < does?
' try some more with BigSQR concentrate on Integer part first, just get that right
' 2022-09-26 Bin2Dec$ Function seems OK
' 2022-09-30 current status using new nLn$ for natural logs in string math calculation
' and eToTheX$ for raising e to some x power, power$ then is x^y = e^(y*ln(x)) in String math functions.
' Started using ShowDP$ to eliminate excess digits so calculations don't hang up all day long...
$Console:Only
Randomize Timer
'Dim As Double i ' testing Dec2Bin$
'Dim p2$, x$, sum$
'p2$ = "1"
'For i = 1 To 50
' p2$ = mr$(p2$, "/", "2")
' x$ = mr$(x$, "+", "1")
' sum$ = mr$(x$, "+", p2$)
' Print sum$, Dec2Bin$(sum$)
' 'Sleep
'Next
'Print: Print " Square Roots:"
'Dim b$, intger$
'For i = 1 To 50
' b$ = Str$(i + 1 / (2 ^ i))
' Print b$, bigSQR$(b$)
'Next
'intger$ = "10000000000000000000000000000000000000000000000000000000000000000"
'Print: Print "Bonus SQR of "; intger$; " Len = "; Len(intger$); " is:"
'b$ = bigSQR$(intger$)
'Print b$, " Len Integer Part ="; Len(Mid$(b$, 1, InStr(b$, ".") - 1))
'intger$ = "100000000000000000000000000000000000000000000000000000000000000000"
'Print: Print "Bonus SQR of "; intger$; " Len = "; Len(intger$); " is:"
'b$ = bigSQR$(intger$)
'Print b$, " Len Integer Part ="; Len(Mid$(b$, 1, InStr(b$, ".") - 1))
'Print: Print " Square Roots:"
' ============ For comparison this was the old routine
'Print: Print "Square Roots the old way of estimation:"
'For i = 1 To 50
' b$ = Str$(i + 1 / (2 ^ i))
' Print b$, sqrRoot$(b$)
'Next
'intger$ = "10000000000000000000000000000000000000000000000000000000000000000"
'Print: Print "Bonus SQR of "; intger$; " Len = "; Len(intger$); " is:"
'b$ = sqrRoot$(intger$)
'Print b$, " Len Integer Part ="; Len(b$)
'intger$ = "100000000000000000000000000000000000000000000000000000000000000000"
'Print: Print "Bonus SQR of "; intger$; " Len = "; Len(intger$); " is:"
'b$ = sqrRoot$(intger$)
'Print b$, " Len Integer Part ="; Len(Mid$(b$, 1, InStr(b$, ".") - 1))
' ============================================================================
' OK now test the new Power$ routine
Print showDP$(power$("8", mr$("1", "/", "1025")), 30)
'Dim test$, ans$
'Do
' Input "Enter a Binary with/without - sgn or decimal "; test$
' ans$ = Bin2Dec$(test$)
' Print "Decimal is: "; ans$
' Print "Check conversion back: "; Dec2Bin$(ans$)
'Loop Until test$ = ""
Function power$ (x$, exponent$) ' this power is getting bogged down by tons of digits not making significant change to final value
Dim step1$
step1$ = mr$(exponent$, "*", nLn$(x$))
step1$ = showDP$(step1$, 100) ' cut x$ down to 100 places
Print step1$
power$ = eToTheX$(step1$)
End Function
Function nLn$ (x$)
Dim term1$, term2$, term$, xbase$, coef$, sum$, newsum$
Dim As Long k, count, kPower
newsum$ = "0"
term1$ = mr$(x$, "-", "1")
term2$ = mr$(x$, "+", "1")
term$ = mr$(term1$, "/", term2$)
xbase$ = "1"
Do
sum$ = newsum$
'Print newsum$
'coef$ = 2 / (2 * k + 1)
coef$ = mr$("2", "/", _Trim$(Str$(2 * k + 1)))
kPower = 2 * k + 1
While count < kPower
xbase$ = showDP$(mr$(xbase$, "*", term$), 100)
count = count + 1
Wend
newsum$ = showDP$(mr$(coef$, "*", xbase$), 100)
newsum$ = mr$(sum$, "+", newsum$)
k = k + 1
Loop Until (sum$ = newsum$) Or (kPower > 2500)
nLn$ = newsum$
End Function
Function eToTheX$ (x$)
Dim sum$, t1$, t2$
Dim As Long n, i
sum$ = "1": n = 100
For i = n - 1 To 1 Step -1
'sum$ = "1" + x$ * sum / i
t1$ = mr$(sum$, "/", _Trim$(Str$(i)))
t2$ = mr$(x$, "*", t1$)
sum$ = mr$("1", "+", t2$)
sum$ = showDP$(sum$, 100) ' trim down all the digits building up
'Print showDP$(sum$, 20)
Next
eToTheX$ = sum$
End Function
' x to the power of pow
Function BinPower$ (xx$, pow$) ' so far this sucks, decimal is lost and digits only good for about 10 places 10% of dp in SQR(2)'s
Dim build$, ip$, fp$, x$, bs$, runningXSQR$
Dim As Long dot, i
x$ = _Trim$(xx$)
dot = InStr(pow$, ".")
If dot Then
ip$ = Mid$(pow$, 1, dot - 1)
fp$ = Mid$(pow$, dot) ' keep dot
Else
ip$ = pow$
fp$ = ""
End If
'integer part or power
build$ = "1"
If ip$ <> "" Then
While LTE("0", ip$)
build$ = mr$(build$, "*", x$)
ip$ = mr$(ip$, "-", "1")
Wend
End If
If fp$ = "" Or fp$ = "." Then BinPower$ = build$: Exit Function
build$ = build$ + "."
'now for the fraction part convert decimal to Binary
bs$ = Dec2Bin$(fp$)
'at moment we haven't taken any sqr of x
runningXSQR$ = mr$(x$, "*", x$)
'run through all the 0's and 1's in the bianry expansion of the fraction part of the power float
For i = 1 To Len(bs$)
'this is the matching sqr of the sqr of the sqr... of x
runningXSQR$ = bigSQR$(runningXSQR$)
'for every 1 in the expansion, multiple our build with the running sqr of ... sqr of x
If Mid$(bs$, i, 1) = "1" Then build$ = mr$(build$, "*", runningXSQR$)
Next
'our build should be a estimate or x to power of pow
BinPower$ = build$
End Function
Function Bin2Dec$ (bn$) ' bn$ is binary string number with possible neg sign and decimal
Dim b$, sgn$, ip$, fp$, p2$, build$
Dim As Long dot, i
b$ = _Trim$(bn$)
If Left$(b$, 1) = "-" Then sgn$ = "-": b$ = Mid$(b$, 2) Else sgn$ = ""
dot = InStr(b$, ".")
If dot Then
ip$ = Mid$(b$, 1, dot - 1)
fp$ = Mid$(b$, dot + 1)
Else
ip$ = b$
fp$ = ""
End If
p2$ = "1"
For i = Len(ip$) To 1 Step -1
If Mid$(ip$, i, 1) = "1" Then build$ = mr$(build$, "+", p2$)
p2$ = mr$(p2$, "*", "2")
Next
If fp$ <> "" Then
build$ = build$ + "."
p2$ = "1"
For i = 1 To Len(fp$)
p2$ = mr$(p2$, "/", "2")
If Mid$(fp$, i, 1) = "1" Then build$ = mr$(build$, "+", p2$)
Next
End If
Bin2Dec$ = sgn$ + build$
End Function
Function bigSQR$ (number$)
Dim ip$, fp$, n$, calc$, remainder$, new$, test$
Dim As Long dot, dp, i, pulldown, cal, digit, maxDec
maxDec = 100
' divide number into integer part, ip$ and fraction part, fp$ , figure decimal places to left of decimal then even up front and back
dot = InStr(number$, ".")
If dot Then
ip$ = _Trim$(Mid$(number$, 1, dot - 1))
fp$ = Left$(_Trim$(Mid$(number$, dot + 1)) + String$(2 * maxDec, "0"), 2 * maxDec)
Else
ip$ = _Trim$(number$)
If Len(ip$) Mod 2 = 1 Then ip$ = "0" + ip$
fp$ = String$(2 * maxDec, "0")
End If
dp = Int((Len(ip$) + 1) / 2)
If Len(ip$) Mod 2 = 1 Then ip$ = "0" + ip$
n$ = ip$ + fp$
For i = 1 To Len(n$) Step 2
pulldown = Val(Mid$(n$, i, 2))
If i = 1 Then
cal = Int(Sqr(pulldown))
remainder$ = _Trim$(Str$(pulldown - cal * cal))
calc$ = _Trim$(Str$(cal))
Else
new$ = mr$("100", "*", remainder$)
new$ = mr$(new$, "+", _Trim$(Str$(pulldown)))
For digit = 9 To 0 Step -1
'test$ = (20 * Val(calc$) + digit) * digit
test$ = mr$("20", "*", calc$)
test$ = mr$(test$, "+", _Trim$(Str$(digit)))
test$ = mr$(test$, "*", _Trim$(Str$(digit)))
If LTE(test$, new$) Then Exit For
Next
calc$ = calc$ + _Trim$(Str$(digit))
remainder$ = mr$(new$, "-", test$)
End If
Next
If dp Then
calc$ = Mid$(calc$, 1, dp) + "." + Mid$(calc$, dp + 1)
Else
calc$ = "." + calc$
End If
bigSQR$ = calc$
End Function
' New stuff
Function Dec2Bin$ (Dec$)
Dim sgn$, d$, ip$, fp$, b$, tp$
Dim As Long dot, c
If _Trim$(Left$(Dec$, 1)) = "-" Then
sgn$ = "-": d$ = Mid$(_Trim$(Dec$), 2)
Else
sgn$ = "": d$ = _Trim$(Dec$)
End If
dot = InStr(d$, ".")
If dot Then
ip$ = Mid$(d$, 1, dot - 1): fp$ = Mid$(d$, dot)
Else ' all integer
ip$ = d$: fp$ = "."
End If
tp$ = "2"
If LTE(tp$, ip$) Then
While LTE(tp$, ip$)
tp$ = mr$(tp$, "*", "2")
Wend
End If
While LT("1", tp$)
tp$ = mr$(tp$, "/", "2")
If LTE(tp$, "1") Then b$ = b$ + ip$: Exit While
If LT(ip$, tp$) Then
b$ = b$ + "0"
Else
b$ = b$ + "1"
ip$ = mr$(ip$, "-", tp$)
End If
Wend
b$ = b$ + "." ' cross over point to fractions
tp$ = "1"
'Print "start fp$ "; fp$
While c < 200 'And LT("0", fp$)
tp$ = mr$(tp$, "/", "2")
'If LT(fp$, tp$) Then ' for some reason LT is not working but < is
If fp$ < tp$ Then ' for some reason LT is not working but < is
b$ = b$ + "0"
Else
b$ = b$ + "1"
fp$ = mr$(fp$, "-", tp$)
If LTE(fp$, "0") Then Exit While
End If
c = c + 1
Wend
Dec2Bin$ = sgn$ + b$ ' b$ = build of 0,1 and .
End Function
Function add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no - signs
'set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
Dim As Long la, lb, m, g
Dim sa As _Unsigned _Integer64, sb As _Unsigned _Integer64, co As _Unsigned _Integer64
Dim fa$, fb$, t$, new$, result$
la = Len(a$): lb = Len(b$)
If la > lb Then m = Int(la / 18) + 1 Else m = Int(lb / 18) + 1
fa$ = Right$(String$(m * 18, "0") + a$, m * 18)
fb$ = Right$(String$(m * 18, "0") + b$, m * 18)
'now taking 18 digits at a time Thanks Steve McNeill
For g = 1 To m
sa = Val(Mid$(fa$, (m - g) * 18 + 1, 18))
sb = Val(Mid$(fb$, (m - g) * 18 + 1, 18))
t$ = Right$(String$(36, "0") + _Trim$(Str$(sa + sb + co)), 36)
co = Val(Mid$(t$, 1, 18))
new$ = Mid$(t$, 19)
result$ = new$ + result$
Next
If co Then result$ = Str$(co) + result$
add$ = result$
End Function
' This is used in nInverse$ not by Mr$ because there it saves time!
Function subtr1$ (a$, b$)
Dim As Long la, lb, lResult, i, ca, cb, w
Dim result$, fa$, fb$
la = Len(a$): lb = Len(b$)
If la > lb Then lResult = la Else lResult = lb
result$ = Space$(lResult)
fa$ = result$: fb$ = result$
Mid$(fa$, lResult - la + 1) = a$
Mid$(fb$, lResult - lb + 1) = b$
For i = lResult To 1 Step -1
ca = Val(Mid$(fa$, i, 1))
cb = Val(Mid$(fb$, i, 1))
If cb > ca Then ' borrow 10
Mid$(result$, i, 1) = Right$(Str$(10 + ca - cb), 1)
w = i - 1
While w > 0 And Mid$(fa$, w, 1) = "0"
Mid$(fa$, w, 1) = "9"
w = w - 1
Wend
Mid$(fa$, w, 1) = Right$(Str$(Val(Mid$(fa$, w, 1)) - 1), 1)
Else
Mid$(result$, i, 1) = Right$(Str$(ca - cb), 1)
End If
Next
subtr1$ = result$
End Function
' 2021-06-08 fix up with new mr call that decides the sign and puts the greater number first
Function subtr$ (sum$, minus$) ' assume both numbers are positive all digits
Dim As Long m, g, p
Dim VB As _Unsigned _Integer64, vs As _Unsigned _Integer64, tenE18 As _Unsigned _Integer64
Dim ts$, tm$, sign$, LG$, sm$, t$, result$
ts$ = _Trim$(sum$): tm$ = _Trim$(minus$) ' fixed subtr$ 2021-06-05
If trim0(ts$) = trim0$(tm$) Then subtr$ = "0": Exit Function 'proceed knowing not equal
tenE18 = 1000000000000000000 'yes!!! no dang E's
sign$ = ""
m = Int(Len(ts$) / 18) + 1
LG$ = Right$(String$(m * 18, "0") + ts$, m * 18)
sm$ = Right$(String$(m * 18, "0") + tm$, m * 18)
'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
For g = 1 To m
VB = Val(Mid$(LG$, m * 18 - g * 18 + 1, 18))
vs = Val(Mid$(sm$, m * 18 - g * 18 + 1, 18))
If vs > VB Then
t$ = Right$(String$(18, "0") + _Trim$(Str$(tenE18 - vs + VB)), 18)
p = (m - g) * 18
While p > 0 And Mid$(LG$, p, 1) = "0"
Mid$(LG$, p, 1) = "9"
p = p - 1
Wend
If p > 0 Then Mid$(LG$, p, 1) = _Trim$(Str$(Val(Mid$(LG$, p, 1)) - 1))
Else
t$ = Right$(String$(18, "0") + _Trim$(Str$(VB - vs)), 18)
End If
result$ = t$ + result$
Next
subtr$ = result$
End Function
Function TrimLead0$ (s$) 'for treating strings as number (pos integers)
Dim copys$
Dim As Long i, find
copys$ = _Trim$(s$) 'might as well remove spaces too
i = 1: find = 0
While i < Len(copys$) And Mid$(copys$, i, 1) = "0"
i = i + 1: find = 1
Wend
If find = 1 Then copys$ = Mid$(copys$, i)
If copys$ = "" Then TrimLead0$ = "0" Else TrimLead0$ = copys$
End Function
' catchy? mr$ for math regulator cop$ = " + - * / " 1 of 4 basic arithmetics
' Fixed so that add and subtract have signs calc'd in Mr and correct call to add or subtract made
' with bigger minus smaller in subtr$() call
Function mr$ (a$, cop$, b$)
Dim op$, ca$, cb$, aSgn$, bSgn$, postOp$, sgn$, rtn$
Dim As Long adp, bdp, dp, lpop, aLTb
op$ = _Trim$(cop$) 'save fixing each time
ca$ = _Trim$(a$): cb$ = _Trim$(b$) 'make copies in case we change
'strip signs and decimals
If Left$(ca$, 1) = "-" Then
aSgn$ = "-": ca$ = Mid$(ca$, 2)
Else
aSgn$ = ""
End If
dp = InStr(ca$, ".")
If dp > 0 Then
adp = Len(ca$) - dp
ca$ = Mid$(ca$, 1, dp - 1) + Mid$(ca$, dp + 1)
Else
adp = 0
End If
If Left$(cb$, 1) = "-" Then
bSgn$ = "-": cb$ = Mid$(cb$, 2)
Else
bSgn$ = ""
End If
dp = InStr(cb$, ".")
If dp > 0 Then
bdp = Len(cb$) - dp
cb$ = Mid$(cb$, 1, dp - 1) + Mid$(cb$, dp + 1)
Else
bdp = 0
End If
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
If adp > bdp Then dp = adp Else dp = bdp
If adp < dp Then ca$ = ca$ + String$(dp - adp, "0")
If bdp < dp Then cb$ = cb$ + String$(dp - bdp, "0")
ElseIf op$ = "*" Then
dp = adp + bdp
End If
If op$ = "*" Or op$ = "/" Then
If aSgn$ = bSgn$ Then sgn$ = "" Else sgn$ = "-"
End If
'now according to signs and op$ call add$ or subtr$
If op$ = "-" Then ' make it adding according to signs because that is done for + next!
If bSgn$ = "-" Then bSgn$ = "" Else bSgn$ = "-" ' flip bSgn$ with op$
op$ = "+" ' turn this over to + op already done! below
End If
If op$ = "+" Then
If aSgn$ = bSgn$ Then 'really add
postOp$ = add$(ca$, cb$)
sgn$ = aSgn$
ElseIf aSgn$ <> bSgn$ Then 'have a case of subtraction
'but which is first and which is 2nd and should final sign be pos or neg
If TrimLead0$(ca$) = TrimLead0(cb$) Then 'remove case a = b
mr$ = "0": Exit Function
Else
aLTb = LTE(ca$, cb$)
If aSgn$ = "-" Then
If aLTb Then ' b - a = pos
postOp$ = subtr$(cb$, ca$)
sgn$ = ""
Else ' a > b so a - sgn wins - (a - b)
postOp$ = subtr$(ca$, cb$)
sgn$ = "-"
End If
Else ' b has the - sgn
If aLTb Then ' result is -
postOp$ = subtr$(cb$, ca$)
sgn$ = "-"
Else ' result is pos
postOp$ = subtr$(ca$, cb$)
sgn$ = ""
End If
End If
End If
End If
ElseIf op$ = "*" Then
postOp$ = mult$(ca$, cb$)
ElseIf op$ = "/" Then
postOp$ = divide$(ca$, cb$)
End If ' which op
If op$ <> "/" Then 'put dp back
lpop = Len(postOp$) ' put decimal back if there is non zero stuff following it
If Len(Mid$(postOp$, lpop - dp + 1)) Then ' fix 1 extra dot appearing in 10000! ?!
If TrimLead0$(Mid$(postOp$, lpop - dp + 1)) <> "0" Then ' .0 or .00 or .000 ??
postOp$ = Mid$(postOp$, 1, lpop - dp) + "." + Mid$(postOp$, lpop - dp + 1)
End If
End If
End If
rtn$ = trim0$(postOp$) 'trim lead 0's then tack on sign
If rtn$ <> "0" Then mr$ = sgn$ + rtn$ Else mr$ = rtn$
End Function
Function divide$ (n$, d$) ' goal here is 100 digits precision not 100 digits past decimal
Dim di$, ndi$
Dim As Long nD
If n$ = "0" Then divide$ = "0": Exit Function
If d$ = "0" Then divide$ = "div 0": Exit Function
If d$ = "1" Then divide$ = n$: Exit Function
' 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 like 200
di$ = Mid$(nInverse$(d$, Len(d$) + 200), 2) 'chop off decimal point after
nD = Len(di$)
ndi$ = mult$(n$, di$)
ndi$ = Mid$(ndi$, 1, Len(ndi$) - nD) + "." + Right$(String$(nD, "0") + Right$(ndi$, nD), nD)
divide$ = ndi$
End Function
' This uses Subtr1$ is Positive Integer only!
' DP = Decimal places = says when to quit if don't find perfect divisor before
Function nInverse$ (n$, DP As Long) 'assume decimal at very start of the string of digits returned
Dim m$(1 To 9), si$, r$, outstr$, d$
Dim i As Long
For i = 1 To 9
si$ = _Trim$(Str$(i))
m$(i) = mult$(si$, n$)
Next
outstr$ = ""
If n$ = "0" Then nInverse$ = "Div 0": Exit Function
If n$ = "1" Then nInverse$ = "1": Exit Function
outstr$ = "." 'everything else n > 1 is decimal 8/17
r$ = "10"
Do
While LT(r$, n$) ' 2021-06-08 this should be strictly Less Than
outstr$ = outstr$ + "0" ' add 0 to the output string
If Len(outstr$) = DP + 1 Then nInverse$ = outstr$: Exit Function 'DP length?
r$ = r$ + "0"
Wend
For i = 9 To 1 Step -1
If LTE(m$(i), r$) Then d$ = _Trim$(Str$(i)): Exit For
Next
outstr$ = outstr$ + d$
If Len(outstr$) = DP + 1 Then nInverse$ = outstr$: Exit Function
r$ = subtr1$(r$, mult$(d$, n$)) 'r = r -d*n ' 2021-06-08 subtr1 works faster
If TrimLead0$(r$) = "0" Then nInverse$ = outstr$: Exit Function ' add trimlead0$ 6/08
r$ = r$ + "0" 'add another place
Loop
End Function
Function mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
Dim As Long la, lb, m, g, dp
Dim As _Unsigned _Integer64 v18, sd, co
Dim f18$, f1$, t$, build$, accum$
If a$ = "0" Then mult$ = "0": Exit Function
If b$ = "0" Then mult$ = "0": Exit Function
If a$ = "1" Then mult$ = b$: Exit Function
If b$ = "1" Then mult$ = a$: Exit Function
'find the longer number and make it a mult of 18 to take 18 digits at a time from it
la = Len(a$): lb = Len(b$)
If la > lb Then
m = Int(la / 18) + 1
f18$ = Right$(String$(m * 18, "0") + a$, m * 18)
f1$ = b$
Else
m = Int(lb / 18) + 1
f18$ = Right$(String$(m * 18, "0") + b$, m * 18)
f1$ = a$
End If
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
For g = 1 To m
v18 = Val(Mid$(f18$, (m - g) * 18 + 1, 18))
sd = Val(Mid$(f1$, dp, 1))
t$ = Right$(String$(19, "0") + _Trim$(Str$(v18 * sd + co)), 19)
co = Val(Mid$(t$, 1, 1))
build$ = Mid$(t$, 2) + build$
Next g
If co Then build$ = _Trim$(Str$(co)) + build$
If dp = Len(f1$) Then
accum$ = build$
Else
accum$ = add$(accum$, build$ + String$(Len(f1$) - dp, "0"))
End If
Next dp
mult$ = accum$
End Function
'this function needs TrimLead0$(s$) ' dang I can't remember if a$ and b$ can have decimals or not
Function LTE (a$, b$) ' a$ Less Than or Equal b$ comparison of 2 strings
Dim ca$, cb$
Dim As Long la, lb, i
ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
la = Len(ca$): lb = Len(cb$)
If ca$ = cb$ Then
LTE = -1
ElseIf la < lb Then ' a is smaller
LTE = -1
ElseIf la > lb Then ' a is bigger
LTE = 0
ElseIf la = lb Then ' equal lengths
For i = 1 To Len(ca$)
If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
LTE = 0: Exit Function
ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
LTE = -1: Exit Function
End If
Next
End If
End Function
'need this for ninverse faster than subtr$ for sign
Function LT (a$, b$) ' a$ Less Than or Equal b$ comparison of 2 strings
Dim ca$, cb$
Dim As Long la, lb, i
ca$ = TrimLead0$(a$): cb$ = TrimLead0(b$)
la = Len(ca$): lb = Len(cb$)
If la < lb Then ' a is smaller
LT = -1
ElseIf la > lb Then ' a is bigger
LT = 0
ElseIf la = lb Then ' equal lengths
For i = 1 To Len(ca$)
If Val(Mid$(ca$, i, 1)) > Val(Mid$(cb$, i, 1)) Then
LT = 0: Exit Function
ElseIf Val(Mid$(ca$, i, 1)) < Val(Mid$(cb$, i, 1)) Then
LT = -1: Exit Function
End If
Next
End If
End Function
Function TrimTail0$ (s$)
Dim copys$
Dim As Long dp, i, find
copys$ = _Trim$(s$) 'might as well remove spaces too
TrimTail0$ = copys$
dp = InStr(copys$, ".")
If dp > 0 Then
i = Len(copys$): find = 0
While i > dp And Mid$(copys$, i, 1) = "0"
i = i - 1: find = 1
Wend
If find = 1 Then
If i = dp Then
TrimTail0$ = Mid$(copys$, 1, dp - 1)
Else
TrimTail0$ = Mid$(copys$, 1, i)
End If
End If
End If
End Function
Function trim0$ (s$)
Dim cs$, si$
cs$ = s$
si$ = Left$(cs$, 1)
If si$ = "-" Then cs$ = Mid$(cs$, 2)
cs$ = TrimLead0$(cs$)
cs$ = TrimTail0$(cs$)
If Right$(cs$, 1) = "." Then cs$ = Mid$(cs$, 1, Len(cs$) - 1)
If si$ = "-" Then trim0$ = si$ + cs$ Else trim0$ = cs$
End Function
' for displaying truncated numbers say to 60 digits
Function showDP$ (num$, nDP As Long)
Dim cNum$
Dim As Long dp, d, i
cNum$ = num$ 'since num$ could get changed
showDP$ = num$
dp = InStr(num$, ".")
If dp > 0 Then
If Len(Mid$(cNum$, dp + 1)) > nDP Then
d = Val(Mid$(cNum$, dp + nDP + 1, 1))
If d > 4 Then
cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
dp = dp + 1
i = dp + nDP
While Mid$(cNum$, i, 1) = "9" Or Mid$(cNum$, i, 1) = "."
If Mid$(cNum$, i, 1) = "9" Then
Mid$(cNum$, i, 1) = "0"
End If
i = i - 1
Wend
Mid$(cNum$, i, 1) = _Trim$(Str$(Val(Mid$(cNum$, i, 1)) + 1)) 'last non 9 digit
cNum$ = Mid$(cNum$, 1, dp + nDP) 'chop it
showDP$ = trim0$(cNum$)
Else
showDP$ = Mid$(cNum$, 1, dp + nDP)
End If
End If
End If
End FunctionI used Pete's test example 8 ^ (1/1025) and matched M$ calculator but not in speed. The first number shown in screen shot below is (1/1025) * ln(8) before raised with e^x.
RE: b+ String Math Update - bplus - 10-01-2022
BTW here is copy of proof of concept where I tested this method of Power$ calculation with the QB64 _Float Type:
Code: (Select All)
Option _Explicit
Print power##(8, 1 / 1025)
Function power## (x As _Float, exponent As _Float)
Dim step1 As _Float
step1 = exponent * nLn##(x)
power## = eToTheX##(step1)
End Function
Function nLn## (x As _Float)
Dim As _Float term, xbase, coef, sum, newsum
Dim As Long k, count, kPower
sum = 0
term = (x - 1) / (x + 1)
k = 0
xbase = 1
Do
sum = newsum
coef = 2 / (2 * k + 1) ' 2
kPower = 2 * k + 1 ' 1
While count < kPower
xbase = xbase * term
count = count + 1
Wend
newsum = sum + coef * xbase
k = k + 1
Loop Until sum = newsum
nLn## = sum
End Function
Function eToTheX## (x As _Float)
Dim As _Float sum
Dim As Long n, i
sum = 1: n = 50
For i = n - 1 To 1 Step -1
sum = 1 + x * sum / i
Next
eToTheX## = sum
End FunctionRE: b+ String Math Update - Pete - 10-01-2022
I did a lot of that proof type testing with my original string +-*/ routines. It's a time saver.
I'll have a look see tonight. Interested in trying a log method. It would be great to have a string method of squares and powers that could handle something like: 104729 root 8 = 1.0000198556 according to an online nth root calculator. Obviously needs more precision but powering it back gets fairly close to 8. This takes just a second on an online nth root calculator, and the radicand is a PRIME number, so no factoring is involved. Log method, maybe?
Pete