Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
b+ String Math Update
#1
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 Function
b = b + ...
Reply


Messages In This Thread
b+ String Math Update - by bplus - 09-26-2022, 06:01 PM
RE: b+ String Math Update - by Pete - 09-26-2022, 06:27 PM
RE: b+ String Math Update - by bplus - 09-26-2022, 06:38 PM
RE: b+ String Math Update - by Pete - 09-26-2022, 06:53 PM
RE: b+ String Math Update - by vince - 09-29-2022, 03:16 AM
RE: b+ String Math Update - by bplus - 09-29-2022, 09:26 AM
RE: b+ String Math Update - by Pete - 09-29-2022, 07:59 PM
RE: b+ String Math Update - by bplus - 10-01-2022, 05:22 PM
RE: b+ String Math Update - by bplus - 10-01-2022, 05:30 PM
RE: b+ String Math Update - by Pete - 10-01-2022, 06:09 PM
RE: b+ String Math Update - by bplus - 10-01-2022, 06:45 PM
RE: b+ String Math Update - by bplus - 10-02-2022, 01:49 AM



Users browsing this thread: 8 Guest(s)