OK here is the StringMath 2025-04-01.bm file
The main functions are listed at top comments:
' mr$(a$, cop$, b$) a$ and b$ two numbers in string form, cop$ = + - * or /
' bigSQR$(number$) big square root expansion of number$
' nLn$(x$) ' natural log of x$
' eToTheX$(x$) ' e^x
' Bin2Dec$(bn$) ' convert binary to decimal
' Dec2Bin$(Dec$, nDP) ' convert decimal to binary with nDP number of decimal places
'
' two handy functions
' showDP$(number$, nDP) ' display number limit decimal places to nDP
' S2N$(exp$) ' removes sci notation if any from number in string form adds 0's as needed
The main functions are listed at top comments:
' mr$(a$, cop$, b$) a$ and b$ two numbers in string form, cop$ = + - * or /
' bigSQR$(number$) big square root expansion of number$
' nLn$(x$) ' natural log of x$
' eToTheX$(x$) ' e^x
' Bin2Dec$(bn$) ' convert binary to decimal
' Dec2Bin$(Dec$, nDP) ' convert decimal to binary with nDP number of decimal places
'
' two handy functions
' showDP$(number$, nDP) ' display number limit decimal places to nDP
' S2N$(exp$) ' removes sci notation if any from number in string form adds 0's as needed
Code: (Select All)
' cut out the ones that don't work 2025-04-01
' mr$(a$, cop$, b$) a$ and b$ two numbers in string form, cop$ = + - * or /
' bigSQR$(number$) big square root expansion of number$
' nLn$(x$) ' natural log of x$
' eToTheX$(x$) ' e^x
' Bin2Dec$(bn$) ' convert binary to decimal
' Dec2Bin$(Dec$, nDP) ' convert decimal to binary with nDP number of decimal places
'
' two handy functions
' showDP$(number$, nDP) ' display number limit decimal places to nDP
' S2N$(exp$) ' removes sci notation if any from number in string form adds 0's as needed
' the rest of the functions here are helpers to the above main ones
' 2023-10-15 Mr$() moved to top for rework
' 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
' 2023-10-15 something in here is fouling up when addition needs to co and new digit
' I wish I wrote down what reasons were for some of this code.
' this order is correct
' 1st return decimal
' 2nd trim 0's off left and right?
' 3rd finally put back the negative sign
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! ?!
' debug 10-15
'Print "postOp$, lpop, dp :"; postOp$, lpop, dp
'Print "TrimLead0$(Mid$(postOp$, lpop - dp + 1))"; TrimLead0$(Mid$(postOp$, lpop - dp + 1)) 'debug"
' 10-15 what is this line checking??? It seems to interfere with decimal
'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)
'Else
'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 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
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
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
' New stuff
Function Dec2Bin$ (Dec$, numDigits As Long)
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 <= numDigits '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
' 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
Function N2S$ (EXP$) 'remove scientific Notation to String (~40 LOC)
'SMcNeill Jan 7, 2020 ref: https://www.qb64.org/forum/index.php?topic=1555.msg112989#msg112989
'Last Function in code marked Best Answer (removed debug comments and blank lines added these 2 lines.)
ReDim t$, sign$, l$, r$, r&&
ReDim dp As Long, dm As Long, ep As Long, em As Long, check1 As Long, l As Long, i As Long
t$ = LTrim$(RTrim$(EXP$))
If Left$(t$, 1) = "-" Or Left$(t$, 1) = "N" Then sign$ = "-": t$ = Mid$(t$, 2)
dp = InStr(t$, "D+"): dm = InStr(t$, "D-")
ep = InStr(t$, "E+"): em = InStr(t$, "E-")
check1 = Sgn(dp) + Sgn(dm) + Sgn(ep) + Sgn(em)
If check1 < 1 Or check1 > 1 Then N2S = _Trim$(EXP$): Exit Function 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
Select Case l 'l now tells us where the SN starts at.
Case Is < dp: l = dp
Case Is < dm: l = dm
Case Is < ep: l = ep
Case Is < em: l = em
End Select
l$ = Left$(t$, l - 1) 'The left of the SN
r$ = Mid$(t$, l + 1): r&& = Val(r$) 'The right of the SN, turned into a workable long
If InStr(l$, ".") Then 'Location of the decimal, if any
If r&& > 0 Then
r&& = r&& - Len(l$) + 2
Else
r&& = r&& + 1
End If
l$ = Left$(l$, 1) + Mid$(l$, 3)
End If
Select Case r&&
Case 0 'what the heck? We solved it already?
'l$ = l$
Case Is < 0
For i = 1 To -r&&
l$ = "0" + l$
Next
l$ = "." + l$
Case Else
For i = 1 To r&&
l$ = l$ + "0"
Next
l$ = l$
End Select
N2S$ = sign$ + l$
End Function
' helper routines to the above
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
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
b = b + ...