FOR i = 1 TO 100

    _LIMIT 10

    PRINT fibIter(i)

NEXT i





FUNCTION fibIter~&& (n)

    IF n < 2 THEN

        fibIter = n

    ELSE

        fibPrev = 1

        fib = 1

        FOR i = 2 TO n - 1

            fibPrevTemp = fib

            fib = fib + fibPrev

            fibPrev = fibPrevTemp

        NEXT i

        fibIter = fib

    END IF

END FUNCTION

_Title "Fibonacci"



$Console:Only

_Dest _Console



'$include: 'LibTomMath.bi'



Dim As mp_int fibIter

Dim As Long i, ok

Dim As Double t

t = Timer(.0001)

If mp_init(fibIter) <> 0 Then Print "failed to initialize"



For i = 1 To 5000 - 1

    fibonacci fibIter, i

    Print i, mp_str(fibIter, 10)

Next i

t = Timer(.0001) - t

Print "elapsed time - "; t; " seconds"

mp_clear fibIter



Sub fibonacci (f As mp_int, n As Long)

    Dim As Long i

    Dim As mp_int fib, fibPrev, fibPrevTemp

    If mp_init(fib) <> 0 Then Print "failed to initialize"

    If mp_init(fibPrev) <> 0 Then Print "failed to initialize"

    If mp_init(fibPrevTemp) <> 0 Then Print "failed to initialize"

    If n < 2 Then

        mp_set_i32 f, n

    Else

        mp_set_i32 fibPrev, 1

        mp_set_i32 fib, 1

        For i = 2 To n - 1

            ok = mp_copy(fib, fibPrevTemp)

            ok = mp_add&(fibPrev, fib, fib)

            ok = mp_copy(fibPrevTemp, fibPrev)

        Next i

        ok = mp_copy(fib, f)

        mp_clear fibPrevTemp

        mp_clear fibPrev

        mp_clear fib

    End If

End Sub



'$include: 'LibTomMath.bm'

_Title "libpari-fib-demo"

$Console:Only

_Dest _Console



Declare Dynamic Library "libpari"

    Sub pari_init (ByVal parisize~&&, Byval maxprime~&&)

    Sub pari_close ()

    Sub pari_print_version ()

    Function setdefault~&& (s As String, v As String, Byval flag&&)

    Function strtoGENstr~&& (s As String)

    Function setrealprecision&& (ByVal n&&, prec&&)

    Function GENtostr$ (ByVal x~&&)

    Function geval~&& (ByVal x~&&)

    Sub outmat (ByVal x~&&)

    Function gp_input~&& ()

    Function stoi~&& (ByVal x&&)

    Function abscmpiu& (ByVal x~&&, Byval y As _Unsigned _Integer64)

    Function abscmpui& (ByVal x As _Unsigned _Integer64, Byval y~&&)

    Function absequaliu& (ByVal x~&&, Byval y As _Unsigned _Integer64)

    Function gequal& (ByVal x~&&, Byval y~&&)

    Function gcmp& (ByVal x~&&, Byval y~&&)

End Declare



Dim As _Unsigned _Integer64 a, b, c, d, e, f

Dim As String s1, s2, s3

Dim As _Integer64 flag, prec



pari_init 80000000, 500000

'pari_print_version

Print



s1 = "fibonacci(5000)" + Chr$(0)

a = strtoGENstr(s1) 'convert to GEN string

b = geval(a) 'eval the string in a

'outmat b

s3 = GENtostr(b)

Print "fibonacci(5000) = "; s3



pari_close

• Windows 11 Pro, x64-based PC
  
• Version 10.0 Build 22621 
  
• Intel Core i7 w/6 cores and 12 Logical Processors
  
• 16 GB RAM
  

Screen _NewImage(1280, 720, 32)

Limit = 10000

Print "Fib"; Limit; "="

last2$ = "0"

last$ = "1"

time## = Timer

For i = 1 To Limit - 2

    result$ = StringAdd(last$, last2$)

    last2$ = last$

    last$ = result$

Next

Print result$

Print Using "###.### seconds to run."; Timer - time##



End



Function StringAdd$ (tempa$, tempb$)

    a$ = tempa$: b$ = tempb$ 'don't alter our original numbers

    Dim As _Unsigned _Integer64 a, b, c, carryover 'to hold our values



    'first fix the numbers to notmalize their lengths

    FixNumbers a$, b$

    'find the signs and strip them off

    If Left$(a$, 1) = "-" Then sa$ = "-": a$ = Mid$(a$, 2) Else sa$ = " "

    If Left$(b$, 1) = "-" Then sb$ = "-": b$ = Mid$(b$, 2) Else sb$ = " "

    'find the decimal position

    dp = InStr(a$, ".")

    If dp > 0 Then 'remove the decimal place from our numbers.  We can put it back later, in its proper position

        righta$ = Mid$(a$, dp + 1)

        rightb$ = Mid$(b$, dp + 1)

        a$ = Left$(a$, dp - 1) + righta$

        b$ = Left$(b$, dp - 1) + rightb$

    End If

    'our strings are now nothing but numbers with no signs and no decimals to deal with.  Let's start adding!

    'are we adding or really subtracting?



    If sa$ <> sb$ Then 'we're subtracting the two values if the signs aren't the same.

        Select Case a$

            Case Is < b$: s$ = sb$: Swap a$, b$ 'our sign is going to be determiined by b$

            Case Is = b$ 'if the two values are the same and are subtracting, our result is zero!

                StringAdd$ = "0" 'How easy was that?

                Exit Function

            Case Else: s$ = sa$ 'our sign is determined by a$

        End Select

        Do

            lb = Len(b$)

            a = Val(Right$(a$, 18)): a$ = Left$(a$, Len(a$) - 18)

            b = Val(Right$(b$, 18)): b$ = Left$(b$, Len(b$) - 18)

            If borrow Then b = b + 1~&& 'in case we had to borrow a digit for the last subtraction

            If a < b Then

                If lb < 18 Then a = a + 10 ^ lb Else a = a + 10 ^ 18

                borrow = -1

            Else

                borrow = 0

            End If

            c = a - b

            temp$ = _Trim$(Str$(c))

            answer$ = String$(18 - Len(temp$), "0") + temp$ + answer$

        Loop Until Len(a$) = 0

        'remove leading 0's

        Do Until Left$(answer$, 1) <> "0"

            answer$ = Mid$(answer$, 2)

        Loop

        'remember to add in the decimal place before finished

        dp = Len(righta$)

        If dp > 0 Then

            answer$ = Left$(answer$, Len(answer$) - dp) + "." + Right$(answer$, dp)

        End If

        StringAdd$ = s$ + answer$

        Exit Function

    End If



    Do

        a1$ = Right$(a$, 18)

        b1$ = Right$(b$, 18)

        a = Val(Right$(a$, 18)): a$ = Left$(a$, Len(a$) - 18)

        b = Val(Right$(b$, 18)): b$ = Left$(b$, Len(b$) - 18)

        c = a + b + carryover

        temp$ = _Trim$(Str$(c))

        If Len(temp$) > 18 Then 'see if we have an answer that is more than 18 digits

            temp$ = Right$(temp$, 18) 'keep 18 digits

            carryover = 1 'store one for carry over

        Else

            carryover = 0 'no carryover

        End If

        answer$ = String$(18 - Len(temp$), "0") + temp$ + answer$

    Loop Until Len(a$) = 0

    If carryover Then answer$ = "1" + answer$

    'remember to add in the decimal place before finished

    dp = Len(righta$)

    If dp > 0 Then

        answer$ = Left$(answer$, Len(answer$) - dp) + "." + Right$(answer$, dp)

    End If

    'remove leading 0's

    Do Until Left$(answer$, 1) <> "0"

        answer$ = Mid$(answer$, 2)

    Loop

    StringAdd$ = sa$ + answer$

End Function



Function StringSubtract$ (tempa$, tempb$)

    a$ = tempa$: b$ = tempb$

    FixNumbers a$, b$

    If Left$(b$, 1) = "-" Then b$ = Mid$(b$, 2) Else b$ = "-" + b$

    StringSubtract$ = StringAdd$(a$, b$)

End Function





Sub FixNumbers (a$, b$)

    'first remove scientific notation and spaces from both

    a$ = _Trim$(N2S$(a$)): b$ = _Trim$(N2S$(b$))

    'then find the decimal position for both and normalize the expressions

    d1 = InStr(a$, "."): d2 = InStr(b$, ".")

    If d1 <> 0 Then 'break down the left and right side of the decimal point for ease of processing  (this is a$)

        lefta$ = Left$(a$, d1 - 1)

        righta$ = Mid$(a$, d1)

    Else

        lefta$ = a$

    End If

    If d2 <> 0 Then 'break down the left and right side of the decimal point for ease of processing  (this is b$)

        leftb$ = Left$(b$, d2 - 1)

        rightb$ = Mid$(b$, d2)

    Else

        leftb$ = b$

    End If



    'normalize the right side of our expressions

    l1 = Len(righta$): l2 = Len(rightb$)

    If l1 < l2 Then

        addzero = l2 - l1

        If l1 = 0 Then righta$ = ".": addzero = addzero - 1

        righta$ = righta$ + String$(addzero, "0")

    ElseIf l1 > l2 Then

        addzero = l1 - l2

        'If l2 = 0 Then rightb$ = ".": addzero = addzero - 1

        rightb$ = rightb$ + String$(addzero, "0")

    End If







    'strip off any plus/minus signs from the two numbers.

    If Left$(lefta$, 1) = "-" Then signa$ = "-": lefta$ = Mid$(lefta$, 2)

    If Left$(leftb$, 1) = "-" Then signb$ = "-": leftb$ = Mid$(leftb$, 2)

    If Left$(lefta$, 1) = "+" Then signa$ = "": lefta$ = Mid$(lefta$, 2)

    If Left$(leftb$, 1) = "+" Then signb$ = "": leftb$ = Mid$(leftb$, 2)

    'normalize the left side of our expressions

    l1 = Len(lefta$): l2 = Len(leftb$)

    If l1 < l2 Then

        addzero = l2 - l1

        lefta$ = String$(addzero, "0") + lefta$

    ElseIf l1 > l2 Then

        addzero = l1 - l2

        leftb$ = String$(addzero, "0") + leftb$

    End If

    'and then put it all together

    a$ = signa$ + lefta$ + righta$

    b$ = signb$ + leftb$ + rightb$

End Sub











Function N2S$ (exp$) 'scientific Notation to String



    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 = 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$ = "0." + l$

        Case Else

            For i = 1 To r&&

                l$ = l$ + "0"

            Next

    End Select



    N2S$ = sign$ + l$

End Function





Function DWD$ (exp$) 'Deal With Duplicates

    'To deal with duplicate operators in our code.

    'Such as --  becomes a +

    '++ becomes a +

    '+- becomes a -

    '-+ becomes a -

    t$ = exp$

    Do

        bad = 0

        Do

            l = InStr(t$, "++")

            If l Then t$ = Left$(t$, l - 1) + "+" + Mid$(t$, l + 2): bad = -1

        Loop Until l = 0

        Do

            l = InStr(t$, "+-")

            If l Then t$ = Left$(t$, l - 1) + "-" + Mid$(t$, l + 2): bad = -1

        Loop Until l = 0

        Do

            l = InStr(t$, "-+")

            If l Then t$ = Left$(t$, l - 1) + "-" + Mid$(t$, l + 2): bad = -1

        Loop Until l = 0

        Do

            l = InStr(t$, "--")

            If l Then t$ = Left$(t$, l - 1) + "+" + Mid$(t$, l + 2): bad = -1

        Loop Until l = 0

    Loop Until Not bad

    DWD$ = t$

End Function

(07-09-2023, 02:20 PM)SMcNeill Wrote:

Code: (Select All)

Screen _NewImage(1280, 720, 32)

Limit = 10000

Print "Fib"; Limit; "="

last2$ = "0"

last$ = "1"

time## = Timer

For i = 1 To Limit - 2

    result$ = StringAdd(last$, last2$)

    last2$ = last$

    last$ = result$

Next

Print result$

Print Using "###.### seconds to run."; Timer - time##



End



Function StringAdd$ (tempa$, tempb$)

    a$ = tempa$: b$ = tempb$ 'don't alter our original numbers

    Dim As _Unsigned _Integer64 a, b, c, carryover 'to hold our values



    'first fix the numbers to notmalize their lengths

    FixNumbers a$, b$

    'find the signs and strip them off

    If Left$(a$, 1) = "-" Then sa$ = "-": a$ = Mid$(a$, 2) Else sa$ = " "

    If Left$(b$, 1) = "-" Then sb$ = "-": b$ = Mid$(b$, 2) Else sb$ = " "

    'find the decimal position

    dp = InStr(a$, ".")

    If dp > 0 Then 'remove the decimal place from our numbers.  We can put it back later, in its proper position

        righta$ = Mid$(a$, dp + 1)

        rightb$ = Mid$(b$, dp + 1)

        a$ = Left$(a$, dp - 1) + righta$

        b$ = Left$(b$, dp - 1) + rightb$

    End If

    'our strings are now nothing but numbers with no signs and no decimals to deal with.  Let's start adding!

    'are we adding or really subtracting?



    If sa$ <> sb$ Then 'we're subtracting the two values if the signs aren't the same.

        Select Case a$

            Case Is < b$: s$ = sb$: Swap a$, b$ 'our sign is going to be determiined by b$

            Case Is = b$ 'if the two values are the same and are subtracting, our result is zero!

                StringAdd$ = "0" 'How easy was that?

                Exit Function

            Case Else: s$ = sa$ 'our sign is determined by a$

        End Select

        Do

            lb = Len(b$)

            a = Val(Right$(a$, 18)): a$ = Left$(a$, Len(a$) - 18)

            b = Val(Right$(b$, 18)): b$ = Left$(b$, Len(b$) - 18)

            If borrow Then b = b + 1~&& 'in case we had to borrow a digit for the last subtraction

            If a < b Then

                If lb < 18 Then a = a + 10 ^ lb Else a = a + 10 ^ 18

                borrow = -1

            Else

                borrow = 0

            End If

            c = a - b

            temp$ = _Trim$(Str$(c))

            answer$ = String$(18 - Len(temp$), "0") + temp$ + answer$

        Loop Until Len(a$) = 0

        'remove leading 0's

        Do Until Left$(answer$, 1) <> "0"

            answer$ = Mid$(answer$, 2)

        Loop

        'remember to add in the decimal place before finished

        dp = Len(righta$)

        If dp > 0 Then

            answer$ = Left$(answer$, Len(answer$) - dp) + "." + Right$(answer$, dp)

        End If

        StringAdd$ = s$ + answer$

        Exit Function

    End If



    Do

        a1$ = Right$(a$, 18)

        b1$ = Right$(b$, 18)

        a = Val(Right$(a$, 18)): a$ = Left$(a$, Len(a$) - 18)

        b = Val(Right$(b$, 18)): b$ = Left$(b$, Len(b$) - 18)

        c = a + b + carryover

        temp$ = _Trim$(Str$(c))

        If Len(temp$) > 18 Then 'see if we have an answer that is more than 18 digits

            temp$ = Right$(temp$, 18) 'keep 18 digits

            carryover = 1 'store one for carry over

        Else

            carryover = 0 'no carryover

        End If

        answer$ = String$(18 - Len(temp$), "0") + temp$ + answer$

    Loop Until Len(a$) = 0

    If carryover Then answer$ = "1" + answer$

    'remember to add in the decimal place before finished

    dp = Len(righta$)

    If dp > 0 Then

        answer$ = Left$(answer$, Len(answer$) - dp) + "." + Right$(answer$, dp)

    End If

    'remove leading 0's

    Do Until Left$(answer$, 1) <> "0"

        answer$ = Mid$(answer$, 2)

    Loop

    StringAdd$ = sa$ + answer$

End Function



Function StringSubtract$ (tempa$, tempb$)

    a$ = tempa$: b$ = tempb$

    FixNumbers a$, b$

    If Left$(b$, 1) = "-" Then b$ = Mid$(b$, 2) Else b$ = "-" + b$

    StringSubtract$ = StringAdd$(a$, b$)

End Function





Sub FixNumbers (a$, b$)

    'first remove scientific notation and spaces from both

    a$ = _Trim$(N2S$(a$)): b$ = _Trim$(N2S$(b$))

    'then find the decimal position for both and normalize the expressions

    d1 = InStr(a$, "."): d2 = InStr(b$, ".")

    If d1 <> 0 Then 'break down the left and right side of the decimal point for ease of processing  (this is a$)

        lefta$ = Left$(a$, d1 - 1)

        righta$ = Mid$(a$, d1)

    Else

        lefta$ = a$

    End If

    If d2 <> 0 Then 'break down the left and right side of the decimal point for ease of processing  (this is b$)

        leftb$ = Left$(b$, d2 - 1)

        rightb$ = Mid$(b$, d2)

    Else

        leftb$ = b$

    End If



    'normalize the right side of our expressions

    l1 = Len(righta$): l2 = Len(rightb$)

    If l1 < l2 Then

        addzero = l2 - l1

        If l1 = 0 Then righta$ = ".": addzero = addzero - 1

        righta$ = righta$ + String$(addzero, "0")

    ElseIf l1 > l2 Then

        addzero = l1 - l2

        'If l2 = 0 Then rightb$ = ".": addzero = addzero - 1

        rightb$ = rightb$ + String$(addzero, "0")

    End If







    'strip off any plus/minus signs from the two numbers.

    If Left$(lefta$, 1) = "-" Then signa$ = "-": lefta$ = Mid$(lefta$, 2)

    If Left$(leftb$, 1) = "-" Then signb$ = "-": leftb$ = Mid$(leftb$, 2)

    If Left$(lefta$, 1) = "+" Then signa$ = "": lefta$ = Mid$(lefta$, 2)

    If Left$(leftb$, 1) = "+" Then signb$ = "": leftb$ = Mid$(leftb$, 2)

    'normalize the left side of our expressions

    l1 = Len(lefta$): l2 = Len(leftb$)

    If l1 < l2 Then

        addzero = l2 - l1

        lefta$ = String$(addzero, "0") + lefta$

    ElseIf l1 > l2 Then

        addzero = l1 - l2

        leftb$ = String$(addzero, "0") + leftb$

    End If

    'and then put it all together

    a$ = signa$ + lefta$ + righta$

    b$ = signb$ + leftb$ + rightb$

End Sub











Function N2S$ (exp$) 'scientific Notation to String



    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 = 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$ = "0." + l$

        Case Else

            For i = 1 To r&&

                l$ = l$ + "0"

            Next

    End Select



    N2S$ = sign$ + l$

End Function





Function DWD$ (exp$) 'Deal With Duplicates

    'To deal with duplicate operators in our code.

    'Such as --  becomes a +

    '++ becomes a +

    '+- becomes a -

    '-+ becomes a -

    t$ = exp$

    Do

        bad = 0

        Do

            l = InStr(t$, "++")

            If l Then t$ = Left$(t$, l - 1) + "+" + Mid$(t$, l + 2): bad = -1

        Loop Until l = 0

        Do

            l = InStr(t$, "+-")

            If l Then t$ = Left$(t$, l - 1) + "-" + Mid$(t$, l + 2): bad = -1

        Loop Until l = 0

        Do

            l = InStr(t$, "-+")

            If l Then t$ = Left$(t$, l - 1) + "-" + Mid$(t$, l + 2): bad = -1

        Loop Until l = 0

        Do

            l = InStr(t$, "--")

            If l Then t$ = Left$(t$, l - 1) + "+" + Mid$(t$, l + 2): bad = -1

        Loop Until l = 0

    Loop Until Not bad

    DWD$ = t$

End Function

(07-09-2023, 02:25 PM)TerryRitchie Wrote: Holy cow that's fast!

(07-09-2023, 02:27 PM)SMcNeill Wrote:

(07-09-2023, 02:25 PM)TerryRitchie Wrote: Holy cow that's fast!

Not as fast as I'd like as it's all string math, but it's about as fast as you're going to get a string math routine to work for you, without direct memory manipulation.