09-26-2022, 06:01 PM
(This post was last modified: 09-26-2022, 06:23 PM by bplus.
Edit Reason: Removed 1 on a line, console is even less likely to be on top when start pressing keys in test Run.
)
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
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 Function
b = b + ...
