Dynamic ArrayList (with circular doubly linked list under the hood)

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
fxm
Moderator
Posts: 12465
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Dynamic ArrayList (with circular doubly linked list under the hood)

Post by fxm »

File to include "DynamicArrayList.bi" : Improvement of the Swap method performance by using multi-threading

From the execution time point of view, the more penalizing item is traversing the nodes from a known position to the targeted position, for large lists.
Unfortunately the traversing task itself can not be parallelized by using several threads because the address of each node is determined from the previous or the next one.
The single case of possible parallelization is for the Swap method because two node traversing must be executed, and those can be executed in parallel by using two threads.

1. Multi-threading constraints:
- The thread synchronization latency must be taken into account to determine the parallelization conditions inducing a gain in execution time and not the opposite.
- If T1 and T2 are the corresponding execution times of each traversing and T the thread synchronization latency, the total execution time improvement is obtained only for T + T1 < T1 + T2 and T + T2 < T1 + T2, so only for T1 > T and T2 > T.
- Therefore the thread synchronization latency must be minimized.

2. Multi-threading design principle chosen:
- A single child thread is launched by the constructor and runs a permanent waiting loop (to avoid a thread launching latency at each time).
- Synchronization between main and child thread to start the two traversing procedures is triggered by means of one mutex (unlock in main thread and lock in child thread) .
- The detection of the traversing procedure end in the thread is marked by means of a simple flag set by the child thread and a flag test loop in the main thread (this waiting time in the main thread is nul or negligible if the procedure of longer time is always executed by the main thread, thus the latency brought by a second mutex can be avoided).
- So using a single mutex and a simple flag, the thread synchronization latency is optimized and corresponds to the execution time for traversing about 250 nodes (on average) in the traversing procedure (about 0.8 µs on average for my PC). The final threshold is set at 500 nodes after testing (probably to account for execution time fluctuation).

3. Thread synchronization code principle:

Code: Select all

#include "DynamicArrayList.bi"

Dim Shared As Any Ptr mutex0, mutex, pt
Dim Shared As Integer flag, quit
Dim As Double t

Sub ThreadMutexFlag(Byval p As Any Ptr)
    Mutexunlock(mutex0)  '' unlock mutex for main thread
    For I As Integer = 1 to 100000
        Mutexlock(mutex)  '' wait for mutex unlock from main thread
        ' child thread task executed concurrently with main thread task
        flag = 1  '' set flag for main thread
    Next I
End Sub

mutex0 = Mutexcreate()
mutex = Mutexcreate()
Mutexlock(mutex0)
Mutexlock(mutex)

pt = ThreadCreate(@ThreadMutexFlag)
Mutexlock(mutex0)  '' wait for thread launch (mutex unlock from child thread)
Print "Thread synchronization latency by mutex and flag:"
t = Timer
For I As Integer = 1 To 100000
    Mutexunlock(mutex)  '' mutex unlock for child thread
    ' main thread task executed concurrently with child thread task
    While flag = 0  '' wait for flag set from child thread
    Wend
    flag = 0
Next I
t = Timer - t
Threadwait(pt)
Print Using "####.### microseconds per double synchronization (round trip)"; t * 10
Print

Mutexdestroy(mutex0)
Mutexdestroy(mutex)

'------------------------------------------------------------------------------------------

Sub PrintList(Byref dal As DynamicArrayList)
    Print "   list:";
    If dal.ReturnNumberOfPosition() = 0 Then
        Print " empty";
    Elseif dal.ReturnNumberOfPosition() <= 10 Then
        For I As Integer = 1 To dal.ReturnNumberOfPosition()
            Print *Cptr(Long Ptr, dal.ReturnFromNthPosition(I));
        Next I
    Else
        For I As Integer = 1 To 5
            Print *Cptr(Long Ptr, dal.ReturnFromNthPosition(I));
        Next I
        Print " .....";
        For I As Integer = dal.ReturnNumberOfPosition() - 4 To dal.ReturnNumberOfPosition()
            Print *Cptr(Long Ptr, dal.ReturnFromNthPosition(I));
        Next I
    End If
    Print
End Sub

Print "Creating a list of 1000000 with 1000000 pre-allocated nodes:"
Dim As DynamicArrayList dal = DynamicArrayList(1000000)
For I As Integer = 1 To 1000000
    dal.InsertInNthPosition(New Long(I), 0)
Next I
PrintList(dal)
Print "Accessing the element at position 250000 from first dummy node:"
t = Timer
Dim As Any Ptr p = dal.ReturnFromNthPosition(250000)
t = Timer - t
Print Using "   element: #########"; *Cptr(Long Ptr, p)
Print Using "   runtime:####.### milliseconds"; t * 1000
Print Using "   ==>:####.### microseconds for traversing 250 nodes"; t * 1000
Print "Suppressing all 1000000 elements:"
While dal.ReturnNumberOfPosition() > 0
        Delete Cptr(Long Ptr, dal.SuppressTheNthPosition(1))
    Wend
PrintList(dal)
Print

'------------------------------------------------------------------------------------------

Print "If execution time of child thread procedure <= that of main thread procedure,"
Print "then thread synchronization by mutex and flag (no CPU overload in this case):"
Print "   '1': Main thread procedure running"
Print "   '2': Child thread procedure running"
Print "   '.': Main thread other task running"

Sub Prnt(Byref s As String, Byval n As Integer)
    For I As Integer = 1 To n
        Sleep 15, 1
        Print s;
    Next I
End Sub

Sub Thread(Byval p As Any Ptr)
    Do
        Mutexlock(mutex)           '' wait for mutex unlock from main thread
        If quit = 1 Then Exit Sub  '' exit the threading loop
        Prnt("2", 5)               '' execute the procedure synchronously with that of the main thread
        flag = 1                   '' set flag for main thread
    Loop
End Sub

mutex = Mutexcreate()
Mutexlock(mutex)

pt = ThreadCreate(@Thread)
For I As Integer = 1 To 10
    Prnt(".", 10)       '' execute other task
    Mutexunlock(mutex)  '' mutex unlock for child thread
    Prnt("1", 5)        '' execute the procedure synchronously with that of the child thread
    While flag = 0      '' wait for flag set from child thread
    Wend
    flag = 0
    Prnt(".", 10)       '' execute other task
Next I
quit = 1                '' set flag for child thread
Mutexunlock(mutex)      '' mutex unlock for child thread
Threadwait(pt)          '' wait for child thread to end
Print

Mutexdestroy(mutex)

Sleep
  • Example of output:

    Code: Select all

    Thread synchronization latency by mutex and flag:
       0.843 microseconds per double synchronization (round trip)
    
    Creating a list of 1000000 with 1000000 pre-allocated nodes:
       list: 1 2 3 4 5 ..... 999996 999997 999998 999999 1000000
    Accessing the element at position 250000 from first dummy node:
       element:    250000
       runtime:   0.819 milliseconds
       ==>:   0.819 microseconds for traversing 250 nodes
    Suppressing all 1000000 elements:
       list: empty
    
    If execution time of child thread procedure <= that of main thread procedure,
    then thread synchronization by mutex and flag (no CPU overload in this case):
       '1': Main thread procedure running
       '2': Child thread procedure running
       '.': Main thread other task running
    ..........2121122121....................1221121212....................2121121212....................2112212112....................1212122121....................1212121122....................1211212122....................1221212121....................2121212211....................1212112122..........
    

4. Real example using the present "DynamicArrayList.bi":

Code: Select all

#include "DynamicArrayList.bi"

Sub PrintList(Byref dal As DynamicArrayList)
    Print "   list:";
    If dal.ReturnNumberOfPosition() = 0 Then
        Print " empty";
    Else
        For I As Integer = 1 To 5
            Print *Cptr(Long Ptr, dal.ReturnFromNthPosition(I));
        Next I
        Print " .....";
        For I As Integer = dal.ReturnNumberOfPosition() - 4 To dal.ReturnNumberOfPosition()
            Print *Cptr(Long Ptr, dal.ReturnFromNthPosition(I));
        Next I
    End If
    Print
End Sub

Dim As Integer NbrOfElements = 100000
Dim As Integer NbrOfPreAllocatedNodes = 100000
Dim As Double t

Print "Creating a list of " & NbrOfElements & " elements with " & NbrOfPreAllocatedNodes & " pre-allocated nodes:"
Dim As DynamicArrayList dal = DynamicArrayList(NbrOfPreAllocatedNodes)
For I As Integer = 1 To NbrOfElements
    dal.InsertInNthPosition(New Long(I), 0)
Next I
PrintList(dal)
Print "Reversing the order of the list by swapping its elements:"
t = Timer
For I As Integer = 1 To NbrOfElements \ 2
    dal.SwapNthPthPosition(I, NbrOfElements + 1 - I)
Next I
t = Timer - t
Print Using "   runtime:####.#### s"; t
PrintList(dal)
Print "Swapping " & NbrOfElements & " elements 2 by 2 at randomly positions:"
Randomize(0)
t = Timer
For I As Integer = 1 To NbrOfElements \ 2
    Dim As Integer N1 = Int(Rnd() * NbrOfElements + 1)
    Dim As Integer N2 = Int(Rnd() * NbrOfElements + 1)
    dal.SwapNthPthPosition(N1, N2)
Next I
t = Timer - t
Print Using "   runtime:####.#### s"; t
PrintList(dal)
Print "Suppressing all " & NbrOfElements & " elements:"
While dal.ReturnNumberOfPosition() > 0
    Delete Cptr(Long Ptr, dal.SuppressTheNthPosition(1))
Wend
    PrintList(dal)

Sleep
  • Example of output:

    Code: Select all

    Creating a list of 100000 elements with 100000 pre-allocated nodes:
       list: 1 2 3 4 5 ..... 99996 99997 99998 99999 100000
    Reversing the order of the list by swapping its elements:
       runtime:   0.0092 s
       list: 100000 99999 99998 99997 99996 ..... 5 4 3 2 1
    Swapping 100000 elements 2 by 2 at randomly positions:
       runtime:   4.0305 s
       list: 100000 79377 17538 52609 99996 ..... 74103 4 28938 13046 58351
    Suppressing all 100000 elements:
       list: empty
    

5. Real example using the modified "DynamicArrayList.bi" for multi-threading:

Code: Select all

' modified DynamicArrayList.bi for multi-threading

#if __FB_VERSION__ < "1.10"
Type DoublyLinkedNode
    Dim As DoublyLinkedNode Ptr prevNodePtr  '' previous node pointer
    Dim As Any Ptr userPtr                   '' user pointer
    Dim As DoublyLinkedNode Ptr nextNodePtr  '' next node pointer
End Type
#endif

Type DynamicArrayList
    Public:
        Declare Function InsertInNthPosition(ByVal p As Any Ptr, ByVal n As Integer) As Any Ptr
        Declare Function SuppressTheNthPosition(ByVal n As Integer) As Any Ptr
        Declare Function ReturnFromNthPosition(ByVal n As Integer) As Any Ptr
        Declare Function UpdateTheNthPosition(ByVal p As Any Ptr, ByVal n As Integer) As Any Ptr
        Declare Function SwapNthPthPosition(ByVal n1 As Integer, ByVal n2 As Integer) As Integer
        Declare Function ShiftTheNthPosition(ByVal n As Integer, ByVal offset As Integer) As Integer
        Declare Function ReverseOrderOfPosition() As Integer
        Declare Function ReturnArrayFromPosition(array() As Any Ptr) As Integer
        Declare Function LoadArrayIntoPosition(array() As Any Ptr) As Integer
        Declare Function SearchForNthPosition(ByVal compare As Function(ByVal p As Any Ptr) As Boolean, ByVal startPosition As Integer = 1) As Integer
        Declare Sub DestroyAllNthPosition(ByVal destroy As Sub(ByVal p As Any Ptr) = 0)
        Declare Function ReturnNumberOfPosition() As Integer
        Declare Constructor()
        Declare Constructor(ByVal nbrPreAlloc As Integer)
        Declare Property NumberOfPreAllocUsed() As Integer
        Declare Property NumberOfPreAllocAvailable() As Integer
        Declare Destructor()
    Private:
        #if __FB_VERSION__ >= "1.10"
        Type DoublyLinkedNode
            Dim As DoublyLinkedNode Ptr prevNodePtr  '' previous node pointer
            Dim As Any Ptr userPtr                   '' user pointer
            Dim As DoublyLinkedNode Ptr nextNodePtr  '' next node pointer
        End Type
        #endif
        Declare Function SearchNthPositionNode(ByVal posNodeIndex As Integer) As DoublyLinkedNode Ptr
        Declare Function TraverseNodes(ByVal nodePtr As DoublyLinkedNode Ptr, ByVal n As Integer) As DoublyLinkedNode Ptr
        Dim As DoublyLinkedNode dummyNode           '' dummy node
        Dim As Integer nbrUserNode                  '' number of user node
        Dim As Integer recent1NodeIndex             '' recent #1 node index (position)
        Dim As DoublyLinkedNode Ptr recent1NodePtr  '' recent #1 node pointer
        Dim As Integer recent2NodeIndex             '' recent #2 node index (position)
        Dim As DoublyLinkedNode Ptr recent2NodePtr  '' recent #2 node pointer
        Dim As DoublyLinkedNode Ptr preAllocPtr     '' pre-allocation pointer
        Dim As Integer nbrPreAllocDone              '' number of pre-allocation done
        Dim As Integer preAllocNbr                  '' pre-allocation number
        Dim As Integer nbrPreAllocUsed              '' number of pre-allocation used
        Declare Sub _Thread()                       '' looping thread
        Dim As Any Ptr _pt                          '' pointer to looping thread
        Dim As Any Ptr _mutex                       '' mutex for start function in thread
        Dim As Integer _flag                        '' flag for end function in thread
        Dim As Byte _end                            '' end thread looping
        Dim As DoublyLinkedNode Ptr _nodePtrT       '' function parameter 1 in thread
        Dim As Integer _nT                          '' function parameter 2 in thread
        Dim As DoublyLinkedNode Ptr _returnT        '' return from function in thread
End Type

Function DynamicArrayList.InsertInNthPosition(ByVal p As Any Ptr, ByVal n As Integer) As Any Ptr
    ' Returns 0 on error, otherwise the value of the provided user pointer
   
    ' Converts index into positive index
    Dim As Integer posNodeIndex = IIf(n <= 0, This.nbrUserNode + n + 1, n)
    ' Tests index validity
    If (posNodeIndex < 1) Or (posNodeIndex > This.nbrUserNode + 1) Then Return 0
    Dim As DoublyLinkedNode Ptr newNodePtr
    If This.preAllocNbr = This.nbrPreAllocDone Then
        ' Allocates memory for new node
        newNodePtr = Allocate(SizeOf(DoublyLinkedNode))
        If newNodePtr = 0 Then Return 0
    Else
        ' Uses pre-allocated memory
        newNodePtr = @This.preAllocPtr[This.preAllocNbr]
        This.nbrPreAllocUsed += 1
        This.preAllocNbr += 1
    End If
    ' Copies user pointer value in new node
    newNodePtr->userPtr = p
    ' Searches for node below insertion
    Dim As DoublyLinkedNode Ptr searchNodePtr = This.SearchNthPositionNode(posNodeIndex)
    ' Updates pointers of previous, inserted, and next nodes
    newNodePtr->nextNodePtr = searchNodePtr
    newNodePtr->prevNodePtr = searchNodePtr->prevNodePtr
    searchNodePtr->prevNodePtr = newNodePtr
    newNodePtr->prevNodePtr->nextNodePtr = newNodePtr
    ' Increments the number of user nodes
    This.nbrUserNode +=1
    ' Updates the recent visited node data
    If (posNodeIndex > This.recent1NodeIndex) And (This.recent1NodeIndex > This.nbrUserNode Shr 2) Then
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = newNodePtr
    Elseif posNodeIndex < This.recent2NodeIndex Then
        This.recent1NodeIndex = posNodeIndex
        This.recent1NodePtr = newNodePtr
        This.recent2NodeIndex += 1  ' recent #2 node position shifted by the insertion
    Else
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = newNodePtr
    End If
    Return p
End Function

Function DynamicArrayList.SuppressTheNthPosition(ByVal n As Integer) As Any Ptr
    ' Returns 0 on error, otherwise the value of the provided user pointer
   
    ' Converts index into positive index
    Dim As Integer posNodeIndex = IIf(n <= 0, This.nbrUserNode + n + 1, n)
    ' Tests index validity
    If (posNodeIndex < 1) Or (posNodeIndex > This.nbrUserNode) Then Return 0
    ' Searches for node to suppress
    Dim As DoublyLinkedNode Ptr searchNodePtr = This.SearchNthPositionNode(posNodeIndex)
    ' Updates of previous and next nodes
    searchNodePtr->prevNodePtr->nextNodePtr = searchNodePtr->nextNodePtr
    searchNodePtr->nextNodePtr->prevNodePtr = searchNodePtr->prevNodePtr
    ' Updates the recent visited node data
    If (posNodeIndex < This.nbrUserNode) And (posNodeIndex <> This.recent2NodeIndex) Then
        If (posNodeIndex > This.recent1NodeIndex) And (This.recent1NodeIndex > This.nbrUserNode Shr 2) Then
            This.recent2NodeIndex = posNodeIndex
            This.recent2NodePtr = searchNodePtr->nextNodePtr
        Elseif posNodeIndex < This.recent2NodeIndex Then
            This.recent1NodeIndex = posNodeIndex
            This.recent1NodePtr = searchNodePtr->nextNodePtr
            This.recent2NodeIndex -= 1  ' recent #2 node position shifted by the suppression
        Else
            This.recent2NodeIndex = posNodeIndex
            This.recent2NodePtr = searchNodePtr->nextNodePtr
        End If
    Else
        ' Resets the recent visited node data
        This.recent1NodePtr = @This.dummyNode
        This.recent1NodeIndex = 0
        This.recent2NodePtr = @This.dummyNode
        This.recent2NodeIndex = 0
    End If
    ' Saves user pointer of the node
    Dim As Any Ptr searchUserPtr = searchNodePtr->userPtr
    If (This.nbrPreallocDone = 0) Orelse ((searchNodePtr < @This.preAllocPtr[0]) Or (searchNodePtr > @This.preAllocPtr[This.nbrPreAllocDone - 1])) Then
        ' Deallocates memory for the node
        Deallocate(searchNodePtr)
    Else
        ' Frees the node from the preallocated memeory
        This.nbrPreAllocUsed -= 1
        If This.nbrPreAllocUsed = 0 Then
            This.preAllocNbr = 0
        Else
            If searchNodePtr = @This.preAllocPtr[This.preAllocNbr - 1] Then This.preAllocNbr -= 1
        End If
    End If
    ' Decrements the number of user nodes
    This.nbrUserNode -= 1
    Return searchUserPtr
End Function

Function DynamicArrayList.ReturnFromNthPosition(ByVal n As Integer) As Any Ptr
    ' Returns 0 on error, otherwise the value of the provided user pointer
   
    ' Converts index into positive index
    Dim As Integer posNodeIndex = IIf(n <= 0, This.nbrUserNode + n + 1, n)
    ' Tests index validity
    If (posNodeIndex < 1) Or (posNodeIndex > This.nbrUserNode) Then Return 0
    ' Searches for user node
    Dim As DoublyLinkedNode Ptr searchNodePtr = This.SearchNthPositionNode(posNodeIndex)
    ' Updates the recent visited node data
    If (posNodeIndex > This.recent1NodeIndex) And (This.recent1NodeIndex > This.nbrUserNode Shr 2) Then
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = searchNodePtr
    Elseif posNodeIndex < This.recent2NodeIndex Then
        This.recent1NodeIndex = posNodeIndex
        This.recent1NodePtr = searchNodePtr
    Else
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = searchNodePtr
    End If
    Return searchNodePtr->userPtr
End Function

Function DynamicArrayList.UpdateTheNthPosition(ByVal p As Any Ptr, ByVal n As Integer) As Any Ptr
    ' Returns 0 on error, otherwise the value of the provided user pointer
   
    ' Converts index into positive index
    Dim As Integer posNodeIndex = IIf(n <= 0, This.nbrUserNode + n + 1, n)
    ' Tests index validity
    If (posNodeIndex < 1) Or (posNodeIndex > This.nbrUserNode) Then Return 0
    ' Searches for user node
    Dim As DoublyLinkedNode Ptr searchNodePtr = This.SearchNthPositionNode(posNodeIndex)
    ' Updates user pointer of the node
    searchNodePtr->userPtr = p
    ' Updates the recent visited node data
    If (posNodeIndex > This.recent1NodeIndex) And (This.recent1NodeIndex > This.nbrUserNode Shr 2) Then
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = searchNodePtr
    Elseif posNodeIndex < This.recent2NodeIndex Then
        This.recent1NodeIndex = posNodeIndex
        This.recent1NodePtr = searchNodePtr
    Else
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = searchNodePtr
    End If
    Return p
End Function

#macro SearchOffsetRecentPositionNode(posNodeIndex, recentNodePtr, offset)
    ' The node (among these 3) memorized closest to the targeted position
    ' is chosen as starting point of the iteration (forward or backward) through the nodes
    ' (3 * 2 = 6 cases)
    If posNodeIndex < This.recent1NodeIndex Then
        If posNodeIndex <= This.recent1NodeIndex - posNodeIndex Then
            ' dummy node closest to targeted position
            recentNodePtr = @This.dummyNode
            offset = posNodeIndex
        Else
            ' recent #1 visited node closest to targeted position
            recentNodePtr = This.recent1NodePtr
            offset = posNodeIndex - This.recent1NodeIndex
        End If
    ElseIf posNodeIndex < This.recent2NodeIndex Then
        If posNodeIndex - This.recent1NodeIndex <= This.recent2NodeIndex - posNodeIndex Then
            ' recent #1 visited node closest to targeted position
            recentNodePtr = This.recent1NodePtr
            offset = posNodeIndex - This.recent1NodeIndex
        Else
            ' recent #2 visited node closest to targeted position
            recentNodePtr = This.recent2NodePtr
            offset = posNodeIndex - This.recent2NodeIndex
        End If
    Else
        If posNodeIndex - This.recent2NodeIndex <= This.nbrUserNode + 1 - posNodeIndex Then
            ' recent #2 visited node closest to targeted position
            recentNodePtr = This.recent2NodePtr
            offset = posNodeIndex - This.recent2NodeIndex
        Else
            ' dummy node closest to targeted position
            recentNodePtr = @This.dummyNode
            offset = posNodeIndex - This.nbrUserNode - 1
        End If
    End If
#endmacro

Function DynamicArrayList.SwapNthPthPosition(ByVal n1 As Integer, ByVal n2 As Integer) As Integer
    ' Returns 0 on error, otherwise -1
   
    ' Converts indexes into positive indexes
    Dim As Integer posNodeIndex1 = IIf(n1 <= 0, This.nbrUserNode + n1 + 1, n1)
    Dim As Integer posNodeIndex2 = IIf(n2 <= 0, This.nbrUserNode + n2 + 1, n2)
    ' Tests index validity
    If (posNodeIndex1 < 1) Or (posNodeIndex1 > This.nbrUserNode) Or (posNodeIndex2 < 1) Or (posNodeIndex2 > This.nbrUserNode) Or (posNodeIndex1 = posNodeIndex2) Then Return 0
    ' search for the 2 user nodes
    Dim As DoublyLinkedNode Ptr searchNodePtr1
    Dim As Integer offset1
    SearchOffsetRecentPositionNode(posNodeIndex1, searchNodePtr1, offset1)
    Dim As DoublyLinkedNode Ptr searchNodePtr2
    Dim As Integer offset2
    SearchOffsetRecentPositionNode(posNodeIndex2, searchNodePtr2, offset2)
    ' sorts the searches by offset in ascending order (in absolute value)
    If Abs(offset1) > Abs(offset2) Then
        Swap posNodeIndex1, posNodeIndex2
        Swap searchNodePtr1, searchNodePtr2
        Swap offset1, offset2
    End If
    ' lunches the shorter search from the threading loop if its offset is greater than a threshold (in absolute value)
    ' offset threshold corresponding to the thread synchronization latency
    If Abs(offset1) > 500 Then
        This._nodePtrT = searchNodePtr1
        This._nT = offset1
        MutexUnlock(This._mutex)  '' unlock mutex for child thread
        searchNodePtr2 = This.TraverseNodes(searchNodePtr2, offset2)
        While This._flag = 0      '' wait for flag set from child thread
        Wend
        This._flag = 0            '' reset flag
        searchNodePtr1 = This._returnT
    Else
        searchNodePtr1 = This.TraverseNodes(searchNodePtr1, offset1)
        searchNodePtr2 = This.TraverseNodes(searchNodePtr2, offset2)
    End If
    ' swaps the 2 user pointers
    Swap searchNodePtr1->userPtr, searchNodePtr2->userPtr
    ' Updates the recent visited node data
    If posNodeIndex2 > posNodeIndex1 Then
        This.recent1NodeIndex = posNodeIndex1
        This.recent1NodePtr = searchNodePtr1
        This.recent2NodeIndex = posNodeIndex2
        This.recent2NodePtr = searchNodePtr2
    Else
        This.recent1NodeIndex = posNodeIndex2
        This.recent1NodePtr = searchNodePtr2
        This.recent2NodeIndex = posNodeIndex1
        This.recent2NodePtr = searchNodePtr1
    End If
    Return -1
End Function

Function DynamicArrayList.ShiftTheNthPosition(ByVal n As Integer, ByVal offset As Integer) As Integer
    ' Returns 0 on error, otherwise -1
   
    ' Converts index into positive index
    Dim As Integer posNodeIndex = IIf(n <= 0, This.nbrUserNode + n + 1, n)
    ' Tests index and offset validity
    If (posNodeIndex < 1) Or (posNodeIndex > This.nbrUserNode) Or (posNodeIndex + offset < 1) Or (posNodeIndex + offset > This.nbrUserNode) Or (offset = 0) Then Return 0
    ' search for the user node
    Dim As DoublyLinkedNode Ptr nodePtr2 = This.SearchNthPositionNode(posNodeIndex)
    Dim As DoublyLinkedNode Ptr nodePtr1
    ' Updates the recent visited node data
    If offset > 0 Then
        This.recent1NodeIndex = posNodeIndex
        This.recent1NodePtr = nodePtr2
    Else
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = nodePtr2
    End If
    ' Shifts the user pointer by using a repeated swapping process
    If offset > 0 Then
        For I As Integer = 1 To Offset
            nodePtr1 = nodePtr2
            nodePtr2 = nodePtr2->nextNodePtr
            Swap nodePtr1->userPtr, nodePtr2->userPtr
        Next I
    Else
        For I As Integer = -1 To Offset Step -1
            nodePtr1 = nodePtr2
            nodePtr2 = nodePtr2->prevNodePtr
            Swap nodePtr1->userPtr, nodePtr2->userPtr
        Next I
    End If
    ' Updates the recent visited node data
    If offset > 0 Then
        This.recent2NodeIndex = posNodeIndex + offset
        This.recent2NodePtr = nodePtr2
    Else
        This.recent1NodeIndex = posNodeIndex + offset
        This.recent1NodePtr = nodePtr2
    End If
    Return -1
End Function

Function DynamicArrayList.ReverseOrderOfPosition() As Integer
    ' Returns 0 on empty list, otherwise -1
   
    ' Tests empty list
    If This.nbrUserNode = 0 Then Return 0
    ' Swaps user pointers from the ends up to the middle
    Dim As DoublyLinkedNode Ptr leftNodePtr = @This.dummyNode, rightNodePtr = @This.dummyNode
    For I As Integer = 1 To This.nbrUserNode \ 2
        leftNodePtr = leftNodePtr->nextNodePtr
        rightNodePtr = rightNodePtr->prevNodePtr
        Swap rightNodePtr->userPtr, leftNodePtr->userPtr
    Next I
    Return -1
End Function

Function DynamicArrayList.ReturnArrayFromPosition(array() As Any Ptr) As Integer
    ' Returns the number of elements
    
    If This.nbrUserNode = 0 Then Return 0
    Dim As DoublyLinkedNode Ptr nodePtr = @This.dummyNode
    ' sizes the passed array
    Redim array(1 To This.nbrUserNode)
    ' fills in the array with the user pointers
    For I As Integer = 1 To This.nbrUserNode
        nodePtr = nodePtr->nextNodePtr
        array(I) = nodePtr->userPtr
    Next I
    Return This.nbrUserNode
End Function

Function DynamicArrayList.LoadArrayIntoPosition(array() As Any Ptr) As Integer
    ' Return 0 if the list is not empty, otherwise returns the number of loaded elements
    
    If This.nbrUserNode > 0 Then Return 0
    Dim As DoublyLinkedNode Ptr nodePtr = @This.dummyNode
    For I As Integer = Lbound(array) To Ubound(array)
        Dim As DoublyLinkedNode Ptr newNodePtr
        If This.preAllocNbr = This.nbrPreAllocDone Then
            ' Allocates memory for new node
            newNodePtr = Allocate(SizeOf(DoublyLinkedNode))
            If newNodePtr = 0 Then Return 0
        Else
            ' Uses pre-allocated memory
            newNodePtr = @This.preAllocPtr[This.preAllocNbr]
            This.nbrPreAllocUsed += 1
            This.preAllocNbr += 1
        End If
        ' Copies user pointer value in new node
        newNodePtr->userPtr = array(I)
        ' Updates pointers of previous and inserted nodes
        nodePtr->nextNodePtr = newNodePtr
        newNodePtr->prevNodePtr = nodePtr
        ' Inserted node becomes previous node
        nodePtr = newNodePtr
        ' Increments the number of user nodes
        This.nbrUserNode += 1
    Next I
    ' Updates pointer of last node and dummy node
    nodePtr->nextNodePtr = @This.dummyNode
    This.dummyNode.prevNodePtr = nodePtr
    Return This.nbrUserNode
End Function

Function DynamicArrayList.SearchForNthPosition(ByVal compare As Function(ByVal p As Any Ptr) As Boolean, ByVal startPosition As Integer = 1) As Integer
    ' Return 0 if the search failed, otherwise returns the position index of the first occurence found
    ' If startPosition > 0 (set of positive index used), the search begins at the startPosition index then continues in the increasing index order
    ' If startPosition < 0 (set of negative index used), the search begins at the startPosition index then continues in the decreasing index order (reverse order)
    ' The returned index uses the same set (positive or negative) of index than the one used for startPosition
    
    If compare = 0 Then Return 0
    Dim As DoublyLinkedNode Ptr nodePtr
    ' set of positive index used
    If (startPosition >= 1) And (startPosition <= This.nbrUserNode) Then
        ' search start node
        nodePtr = This.SearchNthPositionNode(startPosition)
        For I As Integer = startPosition To This.nbrUserNode
            If compare(nodePtr->userPtr) = True Then Return I
            ' next node
            nodePtr = nodePtr->nextNodePtr
        Next I
    ' set of negative index used
    ElseIf (startPosition <= -1) And (startPosition >= -This.nbrUserNode) Then
        ' search start node
        nodePtr = This.SearchNthPositionNode(This.nbrUserNode + startPosition + 1)
        For I As Integer = startPosition To -This.nbrUserNode Step -1
            If compare(nodePtr->userPtr) = True Then Return I
            ' previous node
            nodePtr = nodePtr->prevNodePtr
        Next I
    End If
    Return 0
End Function

Sub DynamicArrayList.DestroyAllNthPosition(ByVal destroy As Sub(ByVal p As Any Ptr) = 0)
    ' Deallocates memory used by user nodes one by one by transverse access, including user data in the loop if destroy <> 0 is passed
    
    Dim As DoublyLinkedNode Ptr nodePtr = This.dummyNode.nextNodePtr
    If This.nbrPreAllocDone = 0 Then
        If destroy <> 0 Then
            For I As Integer = 1 To This.nbrUserNode
                nodePtr = nodePtr->nextNodePtr
                destroy(nodePtr->prevNodePtr->userPtr)
                ' Deallocates memory for the node
                Deallocate(nodePtr->prevNodePtr)
            Next I
        Else
            For I As Integer = 1 To This.nbrUserNode
                nodePtr = nodePtr->nextNodePtr
                ' Deallocates memory for the node
                Deallocate(nodePtr->prevNodePtr)
            Next I
        End If
    Else
        If destroy <> 0 Then
            For I As Integer = 1 To This.nbrUserNode
                nodePtr = nodePtr->nextNodePtr
                destroy(nodePtr->prevNodePtr->userPtr)
                If (nodePtr->prevNodePtr < @This.preAllocPtr[0]) Or (nodePtr->prevNodePtr > @This.preAllocPtr[This.nbrPreAllocDone - 1]) Then
                    ' Deallocates memory for the node
                    Deallocate(nodePtr->prevNodePtr)
                End If
            Next I
        Else
            For I As Integer = 1 To This.nbrUserNode
                nodePtr = nodePtr->nextNodePtr
                If (nodePtr->prevNodePtr < @This.preAllocPtr[0]) Or (nodePtr->prevNodePtr > @This.preAllocPtr[This.nbrPreAllocDone - 1]) Then
                    ' Deallocates memory for the node
                    Deallocate(nodePtr->prevNodePtr)
                End If
            Next I
        End If
    End If
    ' Clears the number of user nodes
    This.nbrUserNode = 0
    ' Loops the dummy node on itself
    This.dummyNode.nextNodePtr = @This.dummyNode
    This.dummyNode.prevNodePtr = @This.dummyNode
    ' Initializes the two recent visited nodes memory with the dummy node
    This.recent1NodeIndex = 0
    This.recent1NodePtr = @This.dummyNode
    This.recent2NodeIndex = 0
    This.recent2NodePtr = @This.dummyNode
    ' Initializes the preallocated memory use
    This.nbrPreAllocUsed = 0
    This.preAllocNbr = 0
End Sub

Function DynamicArrayList.ReturnNumberOfPosition() As Integer
    Return This.nbrUserNode
End Function

Function DynamicArrayList.SearchNthPositionNode(ByVal posNodeIndex As Integer) As DoublyLinkedNode Ptr
    Dim As DoublyLinkedNode Ptr nodePtr
    Dim As Integer n
    SearchOffsetRecentPositionNode(posNodeIndex, nodePtr, n)
    Return This.TraverseNodes(nodePtr, n)
End Function

Function DynamicArrayList.TraverseNodes(ByVal nodePtr As DoublyLinkedNode Ptr, ByVal n As Integer) As DoublyLinkedNode Ptr
    If n > 0 Then
        ' forward iteration
        #define NP nextNodePtr
        For I As Integer = n To 0 Step -25
            Select Case As Const I
            Case  0   :    Return nodePtr
            Case  1   :    Return nodePtr->NP
            Case  2   :    Return nodePtr->NP->NP
            Case  3   :    Return nodePtr->NP->NP->NP
            Case  4   :    Return nodePtr->NP->NP->NP->NP
            Case  5   :    Return nodePtr->NP->NP->NP->NP->NP
            Case  6   :    Return nodePtr->NP->NP->NP->NP->NP->NP
            Case  7   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP
            Case  8   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP
            Case  9   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 10   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 11   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 12   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 13   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 14   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 15   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 16   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 17   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 18   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 19   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 20   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 21   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 22   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 23   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 24   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case Else : nodePtr = nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            End Select
        Next I
    Elseif n < 0 Then
        ' backward iteration
        #define PP prevNodePtr
        For I As Integer = n To 0 Step +25
            Select Case As Const I
            Case - 0  :    Return nodePtr
            Case - 1  :    Return nodePtr->PP
            Case - 2  :    Return nodePtr->PP->PP
            Case - 3  :    Return nodePtr->PP->PP->PP
            Case - 4  :    Return nodePtr->PP->PP->PP->PP
            Case - 5  :    Return nodePtr->PP->PP->PP->PP->PP
            Case - 6  :    Return nodePtr->PP->PP->PP->PP->PP->PP
            Case - 7  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP
            Case - 8  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP
            Case - 9  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -10  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -11  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -12  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -13  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -14  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -15  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -16  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -17  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -18  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -19  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -20  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -21  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -22  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -23  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -24  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case Else : nodePtr = nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            End Select
        Next I
    Else
        Return nodePtr
    End If
End Function

Constructor DynamicArrayList()
    ' Loops the dummy node on itself
    This.dummyNode.nextNodePtr = @This.dummyNode
    This.dummyNode.prevNodePtr = @This.dummyNode
    ' Initializes the two recent visited nodes memory with the dummy node
    This.recent1NodePtr = @This.dummyNode
    This.recent2NodePtr = @This.dummyNode
    ' Initializes the threading loop
    This._mutex = MutexCreate()                                              '' create mutex
    MutexLock(This._mutex)                                                   '' lock mutex
    This._pt= ThreadCreate(Cptr(Any Ptr, @DynamicArrayList._Thread), @This)  '' launch child thread
End Constructor

Constructor DynamicArrayList(ByVal nbrPreAlloc As Integer)
    Constructor()
    If nbrPreAlloc > 0 Then
        ' Pre-allocates memory for nbrPreAlloc nodes
        This.preAllocPtr = Allocate(nbrPreAlloc * Sizeof(DoublyLinkedNode))
        If This.preAllocPtr > 0 Then This.nbrPreAllocDone = nbrPreAlloc
    End If
End Constructor

Property DynamicArrayList.NumberOfPreAllocUsed() As Integer
    Return This.nbrPreAllocUsed
End Property

Property DynamicArrayList.NumberOfPreAllocAvailable() As Integer
    Return This.nbrPreAllocDone - This.preAllocNbr
End Property

Sub DynamicArrayList._Thread()
    '  Threading loop
    Do
        MutexLock(This._mutex)          '' wait for mutex unlock from main thread
        If This._end = 1 Then Exit Sub  '' exit the threading loop
        This._returnT = This.TraverseNodes(This._nodePtrT, This._nT)
        This._flag = 1                  '' set flag for main thread
    Loop
End Sub

Destructor DynamicArrayList()
    ' Deallocates memory used by user nodes one by one by transverse access
    This.DestroyAllNthPosition()
    If This.nbrPreAllocDone > 0 Then
        ' Deallocates the pre-allocated memory
        Deallocate(This.preAllocPtr)
        This.nbrPreAllocDone = 0
    End If
    ' Ends the threading loop
    This._end = 1              '' set _end for chimld thread
    MutexUnlock(This._mutex)   '' unlock mutex for child thread
    ThreadWait(This._pt)       '' wait for child thread end
    MutexDestroy(This._mutex)  '' destroy mutex
End Destructor



Sub PrintList(Byref dal As DynamicArrayList)
    Print "   list:";
    If dal.ReturnNumberOfPosition() = 0 Then
        Print " empty";
    Else
        For I As Integer = 1 To 5
            Print *Cptr(Long Ptr, dal.ReturnFromNthPosition(I));
        Next I
        Print " .....";
        For I As Integer = dal.ReturnNumberOfPosition() - 4 To dal.ReturnNumberOfPosition()
            Print *Cptr(Long Ptr, dal.ReturnFromNthPosition(I));
        Next I
    End If
    Print
End Sub

Dim As Integer NbrOfElements = 100000
Dim As Integer NbrOfPreAllocatedNodes = 100000
Dim As Double t

Print "Creating a list of " & NbrOfElements & " elements with " & NbrOfPreAllocatedNodes & " pre-allocated nodes:"
Dim As DynamicArrayList dal = DynamicArrayList(NbrOfPreAllocatedNodes)
For I As Integer = 1 To NbrOfElements
    dal.InsertInNthPosition(New Long(I), 0)
Next I
PrintList(dal)
Print "Reversing the order of the list by swapping its elements:"
t = Timer
For I As Integer = 1 To NbrOfElements \ 2
    dal.SwapNthPthPosition(I, NbrOfElements + 1 - I)
Next I
t = Timer - t
Print Using "   runtime:####.#### s"; t
PrintList(dal)
Print "Swapping " & NbrOfElements & " elements 2 by 2 at randomly positions:"
Randomize(0)
t = Timer
For I As Integer = 1 To NbrOfElements \ 2
    Dim As Integer N1 = Int(Rnd() * NbrOfElements + 1)
    Dim As Integer N2 = Int(Rnd() * NbrOfElements + 1)
    dal.SwapNthPthPosition(N1, N2)
Next I
t = Timer - t
Print Using "   runtime:####.#### s"; t
PrintList(dal)
Print "Suppressing all " & NbrOfElements & " elements:"
While dal.ReturnNumberOfPosition() > 0
    Delete Cptr(Long Ptr, dal.SuppressTheNthPosition(1))
Wend
    PrintList(dal)

Sleep
  • Example of output:

    Code: Select all

    Creating a list of 100000 elements with 100000 pre-allocated nodes:
       list: 1 2 3 4 5 ..... 99996 99997 99998 99999 100000
    Reversing the order of the list by swapping its elements:
       runtime:   0.0090 s
       list: 100000 99999 99998 99997 99996 ..... 5 4 3 2 1
    Swapping 100000 elements 2 by 2 at randomly positions:
       runtime:   3.0543 s
       list: 100000 79377 17538 52609 99996 ..... 74103 4 28938 13046 58351
    Suppressing all 100000 elements:
       list: empty
    
    Runtime improvement of about 25 %, only for the 'Swapping 100000 elements 2 by 2 at randomly positions' test (only this one really uses the multi-threading).
Last edited by fxm on Dec 19, 2024 9:38, edited 16 times in total.
Reason: The final threshold set to 500 nodes (instead of 250 previously) after testing (probably to account for execution time fluctuation).
fxm
Moderator
Posts: 12465
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Dynamic ArrayList (with circular doubly linked list under the hood)

Post by fxm »

fxm wrote: Dec 14, 2024 16:13 File to include "DynamicArrayList.bi" : Improvement of the Swap method performance by using multi-threading

From the execution time point of view, the more penalizing item is traversing the nodes from a known position to the targeted position, for large lists.
Unfortunately the traversing task itself can not be parallelized by using several threads because the address of each node is determined from the previous or the next one.
The single case of possible parallelization is for the Swap method because two node traversing must be executed, and those can be executed in parallel by using two threads.

The reference post 1/4 has been updated with this improved version of the 'DynamicArrayList' type:
Improvement of the Swap method performance by using multi-threading.
('DynamicArrayList.bi' - 19 Dec 2024)
fxm
Moderator
Posts: 12465
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Dynamic ArrayList (with circular doubly linked list under the hood)

Post by fxm »

File to include "DynamicArrayList.bi" : Improvement of the Shift method performance by using new algorithm and multi-threading

In the present algorithm, the node is not really shifted but only the user pointer is propagated up to the targeted position by a sequence of successive swaps (so N 'SWAP' instructions for a shift of N positions).
For a large list, that may induce potential large shifts and consequently an important number of 'SWAP' instructions to execute.

The new algorithm un-inserts the concerned node and re-inserts it at the targeted position.
This corresponds to only six pointer assignments and that whatever the shift size.
For a large list and random shifts, this improves the execution time by a factor of about 3.

In addition, similarly to the Swap method (because two positions are now directly accessed), multi-threading may be also applied, inducing an additional improvement of about 25%.
In total, the execution time is improved by a factor of about 4.

- Example using the present "DynamicArrayList.bi":

Code: Select all

#include "DynamicArrayList.bi"

Sub PrintList(Byref dal As DynamicArrayList)
    Print "   list:";
    If dal.ReturnNumberOfPosition() = 0 Then
        Print " empty";
    Elseif dal.ReturnNumberOfPosition() <= 10 Then
        For I As Integer = 1 To dal.ReturnNumberOfPosition()
            Print *Cptr(Long Ptr, dal.ReturnFromNthPosition(I));
        Next I
    Else
        For I As Integer = 1 To 5
            Print *Cptr(Long Ptr, dal.ReturnFromNthPosition(I));
        Next I
        Print " .....";
        For I As Integer = dal.ReturnNumberOfPosition() - 4 To dal.ReturnNumberOfPosition()
            Print *Cptr(Long Ptr, dal.ReturnFromNthPosition(I));
        Next I
    End If
    Print
End Sub

Sub test(Byval NbrOfElements As Integer, Byval NbrOfPreAllocatedNodes As Integer)
    Dim As Double t

    Print "Creating a list of " & NbrOfElements & " elements with " & NbrOfPreAllocatedNodes & " pre-allocated nodes:"
    t = Timer
    Dim As DynamicArrayList dal = DynamicArrayList(NbrOfPreAllocatedNodes)
    For I As Integer = 1 To NbrOfElements
        dal.InsertInNthPosition(New Long(I), 0)
    Next I
    t = Timer - t
    Print Using "   runtime:####.#### s"; t
    PrintList(dal)
    Print "Shifting #+3 by +" & NbrOfElements - 5 & " positions:"
    dal.ShiftTheNthPosition(+3, +(NbrOfElements - 5))
    PrintList(dal)
    Print "Shifting #-3 by +" & -(NbrOfElements - 5) & " positions:"
    dal.ShiftTheNthPosition(-3, -(NbrOfElements - 5))
    PrintList(dal)
    Print "Shifting " & NbrOfElements / 2 & " random elements each to a random position:"
    Randomize(NbrOfElements)
    t = Timer
    For I As Integer = 1 To NbrOfElements \ 2
        Dim As Integer N1 = Int(Rnd() * NbrOfElements + 1)
        Dim As Integer N2 = Int(Rnd() * NbrOfElements + 1)
        dal.ShiftTheNthPosition(N1, N2 - N1)
    Next I
    t = Timer - t
    Print Using "   runtime:####.#### s"; t
    PrintList(dal)
    Print "Suppressing all " & NbrOfElements & " elements:"
    t = Timer
    While dal.ReturnNumberOfPosition() > 0
        Delete Cptr(Long Ptr, dal.SuppressTheNthPosition(1))
    Wend
    t = Timer - t
    Print Using "   runtime:####.#### s"; t
    PrintList(dal)
    Print
End Sub

test(100000, 0)
test(100000, 100000)

Sleep
  • Example of output:

    Code: Select all

    Creating a list of 100000 elements with 0 pre-allocated nodes:
       runtime:   0.0350 s
       list: 1 2 3 4 5 ..... 99996 99997 99998 99999 100000
    Shifting #+3 by +99995 positions:
       list: 1 2 4 5 6 ..... 99997 99998 3 99999 100000
    Shifting #-3 by +-99995 positions:
       list: 1 2 3 4 5 ..... 99996 99997 99998 99999 100000
    Shifting 50000 random elements each to a random position:
       runtime:  18.7013 s
       list: 6 9 11 14 15 ..... 99994 68342 9457 99997 39167
    Suppressing all 100000 elements:
       runtime:   0.0262 s
       list: empty
    
    Creating a list of 100000 elements with 100000 pre-allocated nodes:
       runtime:   0.0203 s
       list: 1 2 3 4 5 ..... 99996 99997 99998 99999 100000
    Shifting #+3 by +99995 positions:
       list: 1 2 4 5 6 ..... 99997 99998 3 99999 100000
    Shifting #-3 by +-99995 positions:
       list: 1 2 3 4 5 ..... 99996 99997 99998 99999 100000
    Shifting 50000 random elements each to a random position:
       runtime:  18.1967 s
       list: 6 9 11 14 15 ..... 99994 68342 9457 99997 39167
    Suppressing all 100000 elements:
       runtime:   0.0244 s
       list: empty
    
- Example using the modified "DynamicArrayList.bi" for new algorithm and multi-threading:

Code: Select all

' DynamicArrayList.bi - 28 Dec 2024

#if __FB_VERSION__ < "1.10"
Type DoublyLinkedNode
    Dim As DoublyLinkedNode Ptr prevNodePtr  '' previous node pointer
    Dim As Any Ptr userPtr                   '' user pointer
    Dim As DoublyLinkedNode Ptr nextNodePtr  '' next node pointer
End Type
#endif

Type DynamicArrayList
    Public:
        Declare Function InsertInNthPosition(ByVal p As Any Ptr, ByVal n As Integer) As Any Ptr
        Declare Function SuppressTheNthPosition(ByVal n As Integer) As Any Ptr
        Declare Function ReturnFromNthPosition(ByVal n As Integer) As Any Ptr
        Declare Function UpdateTheNthPosition(ByVal p As Any Ptr, ByVal n As Integer) As Any Ptr
        Declare Function SwapNthPthPosition(ByVal n1 As Integer, ByVal n2 As Integer) As Integer
        Declare Function ShiftTheNthPosition(ByVal n As Integer, ByVal offset As Integer) As Integer
        Declare Function ReverseOrderOfPosition() As Integer
        Declare Function ReturnArrayFromPosition(array() As Any Ptr) As Integer
        Declare Function LoadArrayIntoPosition(array() As Any Ptr) As Integer
        Declare Function SearchForNthPosition(ByVal compare As Function(ByVal p As Any Ptr) As Boolean, ByVal startPosition As Integer = 1) As Integer
        Declare Sub DestroyAllNthPosition(ByVal destroy As Sub(ByVal p As Any Ptr) = 0)
        Declare Function ReturnNumberOfPosition() As Integer
        Declare Constructor()
        Declare Constructor(ByVal nbrPreAlloc As Integer)
        Declare Property NumberOfPreAllocUsed() As Integer
        Declare Property NumberOfPreAllocAvailable() As Integer
        Declare Destructor()
    Private:
        #if __FB_VERSION__ >= "1.10"
        Type DoublyLinkedNode
            Dim As DoublyLinkedNode Ptr prevNodePtr  '' previous node pointer
            Dim As Any Ptr userPtr                   '' user pointer
            Dim As DoublyLinkedNode Ptr nextNodePtr  '' next node pointer
        End Type
        #endif
        Declare Function SearchNthPositionNode(ByVal posNodeIndex As Integer) As DoublyLinkedNode Ptr
        Declare Sub SearchOffsetRecentPositionNode(ByVal posNodeIndex As Integer, Byref recentNodePtr As DoublyLinkedNode Ptr, Byref n As Integer)
        Declare Function TraverseNodes(ByVal nodePtr As DoublyLinkedNode Ptr, ByVal n As Integer) As DoublyLinkedNode Ptr
        Dim As DoublyLinkedNode dummyNode           '' dummy node
        Dim As Integer nbrUserNode                  '' number of user node
        Dim As Integer recent1NodeIndex             '' recent #1 node index (position)
        Dim As DoublyLinkedNode Ptr recent1NodePtr  '' recent #1 node pointer
        Dim As Integer recent2NodeIndex             '' recent #2 node index (position)
        Dim As DoublyLinkedNode Ptr recent2NodePtr  '' recent #2 node pointer
        Dim As DoublyLinkedNode Ptr preAllocPtr     '' pre-allocation pointer
        Dim As Integer nbrPreAllocDone              '' number of pre-allocation done
        Dim As Integer preAllocNbr                  '' pre-allocation number
        Dim As Integer nbrPreAllocUsed              '' number of pre-allocation used
        Declare Sub _Thread()                       '' looping thread
        Dim As Any Ptr _pt                          '' pointer to looping thread
        Dim As Any Ptr _mutex                       '' mutex for start function in thread
        Dim As Integer _flag                        '' flag for end function in thread
        Dim As Byte _end                            '' end thread looping
        Dim As DoublyLinkedNode Ptr _nodePtrT       '' function parameter 1 in thread
        Dim As Integer _nT                          '' function parameter 2 in thread
        Dim As DoublyLinkedNode Ptr _returnT        '' return from function in thread
End Type

Function DynamicArrayList.InsertInNthPosition(ByVal p As Any Ptr, ByVal n As Integer) As Any Ptr
    ' Returns 0 on error, otherwise the value of the provided user pointer
   
    ' Converts index into positive index
    Dim As Integer posNodeIndex = IIf(n <= 0, This.nbrUserNode + n + 1, n)
    ' Tests index validity
    If (posNodeIndex < 1) Or (posNodeIndex > This.nbrUserNode + 1) Then Return 0
    Dim As DoublyLinkedNode Ptr newNodePtr
    If This.preAllocNbr = This.nbrPreAllocDone Then
        ' Allocates memory for new node
        newNodePtr = Allocate(SizeOf(DoublyLinkedNode))
        If newNodePtr = 0 Then Return 0
    Else
        ' Uses pre-allocated memory
        newNodePtr = @This.preAllocPtr[This.preAllocNbr]
        This.nbrPreAllocUsed += 1
        This.preAllocNbr += 1
    End If
    ' Copies user pointer value in new node
    newNodePtr->userPtr = p
    ' Searches for node below insertion
    Dim As DoublyLinkedNode Ptr searchNodePtr = This.SearchNthPositionNode(posNodeIndex)
    ' Updates pointers of previous, inserted, and next nodes
    newNodePtr->nextNodePtr = searchNodePtr
    newNodePtr->prevNodePtr = searchNodePtr->prevNodePtr
    searchNodePtr->prevNodePtr = newNodePtr
    newNodePtr->prevNodePtr->nextNodePtr = newNodePtr
    ' Increments the number of user nodes
    This.nbrUserNode +=1
    ' Updates the recent visited node data
    If (posNodeIndex > This.recent1NodeIndex) And (This.recent1NodeIndex > This.nbrUserNode Shr 2) Then
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = newNodePtr
    Elseif posNodeIndex < This.recent2NodeIndex Then
        This.recent1NodeIndex = posNodeIndex
        This.recent1NodePtr = newNodePtr
        This.recent2NodeIndex += 1  ' recent #2 node position shifted by the insertion
    Else
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = newNodePtr
    End If
    Return p
End Function

Function DynamicArrayList.SuppressTheNthPosition(ByVal n As Integer) As Any Ptr
    ' Returns 0 on error, otherwise the value of the provided user pointer
   
    ' Converts index into positive index
    Dim As Integer posNodeIndex = IIf(n <= 0, This.nbrUserNode + n + 1, n)
    ' Tests index validity
    If (posNodeIndex < 1) Or (posNodeIndex > This.nbrUserNode) Then Return 0
    ' Searches for node to suppress
    Dim As DoublyLinkedNode Ptr searchNodePtr = This.SearchNthPositionNode(posNodeIndex)
    ' Updates of previous and next nodes
    searchNodePtr->prevNodePtr->nextNodePtr = searchNodePtr->nextNodePtr
    searchNodePtr->nextNodePtr->prevNodePtr = searchNodePtr->prevNodePtr
    ' Updates the recent visited node data
    If (posNodeIndex < This.nbrUserNode) And (posNodeIndex <> This.recent2NodeIndex) Then
        If (posNodeIndex > This.recent1NodeIndex) And (This.recent1NodeIndex > This.nbrUserNode Shr 2) Then
            This.recent2NodeIndex = posNodeIndex
            This.recent2NodePtr = searchNodePtr->nextNodePtr
        Elseif posNodeIndex < This.recent2NodeIndex Then
            This.recent1NodeIndex = posNodeIndex
            This.recent1NodePtr = searchNodePtr->nextNodePtr
            This.recent2NodeIndex -= 1  ' recent #2 node position shifted by the suppression
        Else
            This.recent2NodeIndex = posNodeIndex
            This.recent2NodePtr = searchNodePtr->nextNodePtr
        End If
    Else
        ' Resets the recent visited node data
        This.recent1NodePtr = @This.dummyNode
        This.recent1NodeIndex = 0
        This.recent2NodePtr = @This.dummyNode
        This.recent2NodeIndex = 0
    End If
    ' Saves user pointer of the node
    Dim As Any Ptr searchUserPtr = searchNodePtr->userPtr
    If (This.nbrPreallocDone = 0) Orelse ((searchNodePtr < @This.preAllocPtr[0]) Or (searchNodePtr > @This.preAllocPtr[This.nbrPreAllocDone - 1])) Then
        ' Deallocates memory for the node
        Deallocate(searchNodePtr)
    Else
        ' Frees the node from the preallocated memeory
        This.nbrPreAllocUsed -= 1
        If This.nbrPreAllocUsed = 0 Then
            This.preAllocNbr = 0
        Else
            If searchNodePtr = @This.preAllocPtr[This.preAllocNbr - 1] Then This.preAllocNbr -= 1
        End If
    End If
    ' Decrements the number of user nodes
    This.nbrUserNode -= 1
    Return searchUserPtr
End Function

Function DynamicArrayList.ReturnFromNthPosition(ByVal n As Integer) As Any Ptr
    ' Returns 0 on error, otherwise the value of the provided user pointer
   
    ' Converts index into positive index
    Dim As Integer posNodeIndex = IIf(n <= 0, This.nbrUserNode + n + 1, n)
    ' Tests index validity
    If (posNodeIndex < 1) Or (posNodeIndex > This.nbrUserNode) Then Return 0
    ' Searches for user node
    Dim As DoublyLinkedNode Ptr searchNodePtr = This.SearchNthPositionNode(posNodeIndex)
    ' Updates the recent visited node data
    If (posNodeIndex > This.recent1NodeIndex) And (This.recent1NodeIndex > This.nbrUserNode Shr 2) Then
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = searchNodePtr
    Elseif posNodeIndex < This.recent2NodeIndex Then
        This.recent1NodeIndex = posNodeIndex
        This.recent1NodePtr = searchNodePtr
    Else
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = searchNodePtr
    End If
    Return searchNodePtr->userPtr
End Function

Function DynamicArrayList.UpdateTheNthPosition(ByVal p As Any Ptr, ByVal n As Integer) As Any Ptr
    ' Returns 0 on error, otherwise the value of the provided user pointer
   
    ' Converts index into positive index
    Dim As Integer posNodeIndex = IIf(n <= 0, This.nbrUserNode + n + 1, n)
    ' Tests index validity
    If (posNodeIndex < 1) Or (posNodeIndex > This.nbrUserNode) Then Return 0
    ' Searches for user node
    Dim As DoublyLinkedNode Ptr searchNodePtr = This.SearchNthPositionNode(posNodeIndex)
    ' Updates user pointer of the node
    searchNodePtr->userPtr = p
    ' Updates the recent visited node data
    If (posNodeIndex > This.recent1NodeIndex) And (This.recent1NodeIndex > This.nbrUserNode Shr 2) Then
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = searchNodePtr
    Elseif posNodeIndex < This.recent2NodeIndex Then
        This.recent1NodeIndex = posNodeIndex
        This.recent1NodePtr = searchNodePtr
    Else
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = searchNodePtr
    End If
    Return p
End Function

Function DynamicArrayList.SwapNthPthPosition(ByVal n1 As Integer, ByVal n2 As Integer) As Integer
    ' Returns 0 on error, otherwise -1
   
    ' Converts indexes into positive indexes
    Dim As Integer posNodeIndex1 = IIf(n1 <= 0, This.nbrUserNode + n1 + 1, n1)
    Dim As Integer posNodeIndex2 = IIf(n2 <= 0, This.nbrUserNode + n2 + 1, n2)
    ' Tests index validity
    If (posNodeIndex1 < 1) Or (posNodeIndex1 > This.nbrUserNode) Or (posNodeIndex2 < 1) Or (posNodeIndex2 > This.nbrUserNode) Or (posNodeIndex1 = posNodeIndex2) Then Return 0
    ' search for the 2 user nodes
    Dim As DoublyLinkedNode Ptr searchNodePtr1
    Dim As Integer offset1
    This.SearchOffsetRecentPositionNode(posNodeIndex1, searchNodePtr1, offset1)
    Dim As DoublyLinkedNode Ptr searchNodePtr2
    Dim As Integer offset2
    This.SearchOffsetRecentPositionNode(posNodeIndex2, searchNodePtr2, offset2)
    ' sorts the searches by offset in ascending order (in absolute value)
    If Abs(offset1) > Abs(offset2) Then
        Swap posNodeIndex1, posNodeIndex2
        Swap searchNodePtr1, searchNodePtr2
        Swap offset1, offset2
    End If
    ' lunches the shorter search from the threading loop if its offset is greater than a threshold (in absolute value)
    ' offset threshold corresponding to the thread synchronization latency
    If Abs(offset1) > 500 Then
        This._nodePtrT = searchNodePtr1
        This._nT = offset1
        MutexUnlock(This._mutex)  '' unlock mutex for child thread
        searchNodePtr2 = This.TraverseNodes(searchNodePtr2, offset2)
        While This._flag = 0      '' wait for flag set from child thread
        Wend
        This._flag = 0            '' reset flag
        searchNodePtr1 = This._returnT
    Else
        searchNodePtr1 = This.TraverseNodes(searchNodePtr1, offset1)
        searchNodePtr2 = This.TraverseNodes(searchNodePtr2, offset2)
    End If
    ' swaps the 2 user pointers
    Swap searchNodePtr1->userPtr, searchNodePtr2->userPtr
    ' Updates the recent visited node data
    If posNodeIndex2 > posNodeIndex1 Then
        This.recent1NodeIndex = posNodeIndex1
        This.recent1NodePtr = searchNodePtr1
        This.recent2NodeIndex = posNodeIndex2
        This.recent2NodePtr = searchNodePtr2
    Else
        This.recent1NodeIndex = posNodeIndex2
        This.recent1NodePtr = searchNodePtr2
        This.recent2NodeIndex = posNodeIndex1
        This.recent2NodePtr = searchNodePtr1
    End If
    Return -1
End Function

Function DynamicArrayList.ShiftTheNthPosition(ByVal n As Integer, ByVal offset As Integer) As Integer
    ' Returns 0 on error, otherwise -1
   
    ' Converts index into positive index
    Dim As Integer posNodeIndex = IIf(n <= 0, This.nbrUserNode + n + 1, n)
    ' Tests index and offset validity
    If (posNodeIndex < 1) Or (posNodeIndex > This.nbrUserNode) Or (posNodeIndex + offset < 1) Or (posNodeIndex + offset > This.nbrUserNode) Or (offset = 0) Then Return 0
    ' search for the 2 user nodes
    Dim As DoublyLinkedNode Ptr nodePtr1
    Dim As DoublyLinkedNode Ptr nodePtr2
    Dim As DoublyLinkedNode Ptr searchNodePtr1
    Dim As Integer offset1
    This.SearchOffsetRecentPositionNode(posNodeIndex, searchNodePtr1, offset1)
    Dim As DoublyLinkedNode Ptr searchNodePtr2
    Dim As Integer offset2
    This.SearchOffsetRecentPositionNode(posNodeIndex + offset, searchNodePtr2, offset2)
    ' lunches the shorter search from the threading loop if its offset is greater than a threshold (in absolute value)
    ' offset threshold corresponding to the thread synchronization latency
    If (Abs(offset1) > 500) And (Abs(offset2) > 500) Then
        If Abs(offset2) > Abs(Offset1) Then
            This._nodePtrT = searchNodePtr1
            This._nT = offset1
            MutexUnlock(This._mutex)  '' unlock mutex for child thread
            nodePtr2 = This.TraverseNodes(searchNodePtr2, offset2)
            While This._flag = 0      '' wait for flag set from child thread
            Wend
            This._flag = 0            '' reset flag
            nodePtr1 = This._returnT
        Else
            This._nodePtrT = searchNodePtr2
            This._nT = offset2
            MutexUnlock(This._mutex)  '' unlock mutex for child thread
            nodePtr1 = This.TraverseNodes(searchNodePtr1, offset1)
            While This._flag = 0      '' wait for flag set from child thread
            Wend
            This._flag = 0            '' reset flag
            nodePtr2 = This._returnT
        End If
    Else
        nodePtr1 = This.TraverseNodes(searchNodePtr1, offset1)
        nodePtr2 = This.TraverseNodes(searchNodePtr2, offset2)
    End If
    ' Uninserts the node
    nodePtr1->prevNodePtr->nextNodePtr = nodePtr1->nextNodePtr
    nodePtr1->nextNodePtr->prevNodePtr = nodePtr1->prevNodePtr
    If offset > 0 Then
        ' Updates the recent visited node data
        This.recent1NodeIndex = posNodeIndex
        This.recent1NodePtr = nodePtr1->nextNodePtr
        This.recent2NodeIndex = posNodeIndex + offset
        This.recent2NodePtr = nodePtr1
        ' Inserts the node to the targeted position
        nodePtr1->nextNodePtr = nodePtr2->nextNodePtr
        nodePtr1->prevNodePtr = nodePtr2
        nodePtr2->nextNodePtr->prevNodePtr = nodePtr1
        nodePtr2->nextNodePtr = nodePtr1
    Else
        ' Updates the recent visited node data
        This.recent1NodeIndex = posNodeIndex + offset
        This.recent1NodePtr = nodePtr1
        This.recent2NodeIndex = posNodeIndex
        This.recent2NodePtr = nodePtr1->prevNodePtr
        ' Inserts the node to the targeted position
        nodePtr1->nextNodePtr = nodePtr2
        nodePtr1->prevNodePtr = nodePtr2->prevNodePtr
        nodePtr2->prevNodePtr->nextNodePtr = nodePtr1
        nodePtr2->prevNodePtr = nodePtr1
    End If
    Return -1
End Function

Function DynamicArrayList.ReverseOrderOfPosition() As Integer
    ' Returns 0 on empty list, otherwise -1
   
    ' Tests empty list
    If This.nbrUserNode = 0 Then Return 0
    ' Swaps user pointers from the ends up to the middle
    Dim As DoublyLinkedNode Ptr leftNodePtr = @This.dummyNode, rightNodePtr = @This.dummyNode
    For I As Integer = 1 To This.nbrUserNode \ 2
        leftNodePtr = leftNodePtr->nextNodePtr
        rightNodePtr = rightNodePtr->prevNodePtr
        Swap rightNodePtr->userPtr, leftNodePtr->userPtr
    Next I
    Return -1
End Function

Function DynamicArrayList.ReturnArrayFromPosition(array() As Any Ptr) As Integer
    ' Returns the number of elements
    
    If This.nbrUserNode = 0 Then Return 0
    Dim As DoublyLinkedNode Ptr nodePtr = @This.dummyNode
    ' sizes the passed array
    Redim array(1 To This.nbrUserNode)
    ' fills in the array with the user pointers
    For I As Integer = 1 To This.nbrUserNode
        nodePtr = nodePtr->nextNodePtr
        array(I) = nodePtr->userPtr
    Next I
    Return This.nbrUserNode
End Function

Function DynamicArrayList.LoadArrayIntoPosition(array() As Any Ptr) As Integer
    ' Return 0 if the list is not empty, otherwise returns the number of loaded elements
    
    If This.nbrUserNode > 0 Then Return 0
    Dim As DoublyLinkedNode Ptr nodePtr = @This.dummyNode
    For I As Integer = Lbound(array) To Ubound(array)
        Dim As DoublyLinkedNode Ptr newNodePtr
        If This.preAllocNbr = This.nbrPreAllocDone Then
            ' Allocates memory for new node
            newNodePtr = Allocate(SizeOf(DoublyLinkedNode))
            If newNodePtr = 0 Then Return 0
        Else
            ' Uses pre-allocated memory
            newNodePtr = @This.preAllocPtr[This.preAllocNbr]
            This.nbrPreAllocUsed += 1
            This.preAllocNbr += 1
        End If
        ' Copies user pointer value in new node
        newNodePtr->userPtr = array(I)
        ' Updates pointers of previous and inserted nodes
        nodePtr->nextNodePtr = newNodePtr
        newNodePtr->prevNodePtr = nodePtr
        ' Inserted node becomes previous node
        nodePtr = newNodePtr
        ' Increments the number of user nodes
        This.nbrUserNode += 1
    Next I
    ' Updates pointer of last node and dummy node
    nodePtr->nextNodePtr = @This.dummyNode
    This.dummyNode.prevNodePtr = nodePtr
    Return This.nbrUserNode
End Function

Function DynamicArrayList.SearchForNthPosition(ByVal compare As Function(ByVal p As Any Ptr) As Boolean, ByVal startPosition As Integer = 1) As Integer
    ' Return 0 if the search failed, otherwise returns the position index of the first occurence found
    ' If startPosition > 0 (set of positive index used), the search begins at the startPosition index then continues in the increasing index order
    ' If startPosition < 0 (set of negative index used), the search begins at the startPosition index then continues in the decreasing index order (reverse order)
    ' The returned index uses the same set (positive or negative) of index than the one used for startPosition
    
    If compare = 0 Then Return 0
    Dim As DoublyLinkedNode Ptr nodePtr
    ' set of positive index used
    If (startPosition >= 1) And (startPosition <= This.nbrUserNode) Then
        ' search start node
        nodePtr = This.SearchNthPositionNode(startPosition)
        For I As Integer = startPosition To This.nbrUserNode
            If compare(nodePtr->userPtr) = True Then Return I
            ' next node
            nodePtr = nodePtr->nextNodePtr
        Next I
    ' set of negative index used
    ElseIf (startPosition <= -1) And (startPosition >= -This.nbrUserNode) Then
        ' search start node
        nodePtr = This.SearchNthPositionNode(This.nbrUserNode + startPosition + 1)
        For I As Integer = startPosition To -This.nbrUserNode Step -1
            If compare(nodePtr->userPtr) = True Then Return I
            ' previous node
            nodePtr = nodePtr->prevNodePtr
        Next I
    End If
    Return 0
End Function

Sub DynamicArrayList.DestroyAllNthPosition(ByVal destroy As Sub(ByVal p As Any Ptr) = 0)
    ' Deallocates memory used by user nodes one by one by transverse access, including user data in the loop if destroy <> 0 is passed
    
    Dim As DoublyLinkedNode Ptr nodePtr = This.dummyNode.nextNodePtr
    If This.nbrPreAllocDone = 0 Then
        If destroy <> 0 Then
            For I As Integer = 1 To This.nbrUserNode
                nodePtr = nodePtr->nextNodePtr
                destroy(nodePtr->prevNodePtr->userPtr)
                ' Deallocates memory for the node
                Deallocate(nodePtr->prevNodePtr)
            Next I
        Else
            For I As Integer = 1 To This.nbrUserNode
                nodePtr = nodePtr->nextNodePtr
                ' Deallocates memory for the node
                Deallocate(nodePtr->prevNodePtr)
            Next I
        End If
    Else
        If destroy <> 0 Then
            For I As Integer = 1 To This.nbrUserNode
                nodePtr = nodePtr->nextNodePtr
                destroy(nodePtr->prevNodePtr->userPtr)
                If (nodePtr->prevNodePtr < @This.preAllocPtr[0]) Or (nodePtr->prevNodePtr > @This.preAllocPtr[This.nbrPreAllocDone - 1]) Then
                    ' Deallocates memory for the node
                    Deallocate(nodePtr->prevNodePtr)
                End If
            Next I
        Else
            For I As Integer = 1 To This.nbrUserNode
                nodePtr = nodePtr->nextNodePtr
                If (nodePtr->prevNodePtr < @This.preAllocPtr[0]) Or (nodePtr->prevNodePtr > @This.preAllocPtr[This.nbrPreAllocDone - 1]) Then
                    ' Deallocates memory for the node
                    Deallocate(nodePtr->prevNodePtr)
                End If
            Next I
        End If
    End If
    ' Clears the number of user nodes
    This.nbrUserNode = 0
    ' Loops the dummy node on itself
    This.dummyNode.nextNodePtr = @This.dummyNode
    This.dummyNode.prevNodePtr = @This.dummyNode
    ' Initializes the two recent visited nodes memory with the dummy node
    This.recent1NodeIndex = 0
    This.recent1NodePtr = @This.dummyNode
    This.recent2NodeIndex = 0
    This.recent2NodePtr = @This.dummyNode
    ' Initializes the preallocated memory use
    This.nbrPreAllocUsed = 0
    This.preAllocNbr = 0
End Sub

Function DynamicArrayList.ReturnNumberOfPosition() As Integer
    Return This.nbrUserNode
End Function

Function DynamicArrayList.SearchNthPositionNode(ByVal posNodeIndex As Integer) As DoublyLinkedNode Ptr
    Dim As DoublyLinkedNode Ptr nodePtr
    Dim As Integer n
    This.SearchOffsetRecentPositionNode(posNodeIndex, nodePtr, n)
    Return This.TraverseNodes(nodePtr, n)
End Function

Sub DynamicArrayList.SearchOffsetRecentPositionNode(ByVal posNodeIndex As Integer, Byref recentNodePtr As DoublyLinkedNode Ptr, Byref n As Integer)
    ' The node (among these 3) memorized closest to the targeted position
    ' is chosen as starting point of the iteration (forward or backward) through the nodes
    ' (3 * 2 = 6 cases)
    If posNodeIndex < This.recent1NodeIndex Then
        If posNodeIndex <= This.recent1NodeIndex - posNodeIndex Then
            ' dummy node closest to targeted position
            recentNodePtr = @This.dummyNode
            n = posNodeIndex
        Else
            ' recent #1 visited node closest to targeted position
            recentNodePtr = This.recent1NodePtr
            n = posNodeIndex - This.recent1NodeIndex
        End If
    ElseIf posNodeIndex < This.recent2NodeIndex Then
        If posNodeIndex - This.recent1NodeIndex <= This.recent2NodeIndex - posNodeIndex Then
            ' recent #1 visited node closest to targeted position
            recentNodePtr = This.recent1NodePtr
            n = posNodeIndex - This.recent1NodeIndex
        Else
            ' recent #2 visited node closest to targeted position
            recentNodePtr = This.recent2NodePtr
            n = posNodeIndex - This.recent2NodeIndex
        End If
    Else
        If posNodeIndex - This.recent2NodeIndex <= This.nbrUserNode + 1 - posNodeIndex Then
            ' recent #2 visited node closest to targeted position
            recentNodePtr = This.recent2NodePtr
            n = posNodeIndex - This.recent2NodeIndex
        Else
            ' dummy node closest to targeted position
            recentNodePtr = @This.dummyNode
            n = posNodeIndex - This.nbrUserNode - 1
        End If
    End If
End Sub

Function DynamicArrayList.TraverseNodes(ByVal nodePtr As DoublyLinkedNode Ptr, ByVal n As Integer) As DoublyLinkedNode Ptr
    If n > 0 Then
        ' forward iteration
        #define NP nextNodePtr
        For I As Integer = n To 0 Step -25
            Select Case As Const I
            Case  0   :    Return nodePtr
            Case  1   :    Return nodePtr->NP
            Case  2   :    Return nodePtr->NP->NP
            Case  3   :    Return nodePtr->NP->NP->NP
            Case  4   :    Return nodePtr->NP->NP->NP->NP
            Case  5   :    Return nodePtr->NP->NP->NP->NP->NP
            Case  6   :    Return nodePtr->NP->NP->NP->NP->NP->NP
            Case  7   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP
            Case  8   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP
            Case  9   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 10   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 11   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 12   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 13   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 14   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 15   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 16   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 17   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 18   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 19   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 20   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 21   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 22   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 23   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case 24   :    Return nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            Case Else : nodePtr = nodePtr->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP->NP
            End Select
        Next I
    Elseif n < 0 Then
        ' backward iteration
        #define PP prevNodePtr
        For I As Integer = n To 0 Step +25
            Select Case As Const I
            Case - 0  :    Return nodePtr
            Case - 1  :    Return nodePtr->PP
            Case - 2  :    Return nodePtr->PP->PP
            Case - 3  :    Return nodePtr->PP->PP->PP
            Case - 4  :    Return nodePtr->PP->PP->PP->PP
            Case - 5  :    Return nodePtr->PP->PP->PP->PP->PP
            Case - 6  :    Return nodePtr->PP->PP->PP->PP->PP->PP
            Case - 7  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP
            Case - 8  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP
            Case - 9  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -10  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -11  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -12  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -13  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -14  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -15  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -16  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -17  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -18  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -19  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -20  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -21  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -22  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -23  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case -24  :    Return nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            Case Else : nodePtr = nodePtr->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP->PP
            End Select
        Next I
    Else
        Return nodePtr
    End If
End Function

Constructor DynamicArrayList()
    ' Loops the dummy node on itself
    This.dummyNode.nextNodePtr = @This.dummyNode
    This.dummyNode.prevNodePtr = @This.dummyNode
    ' Initializes the two recent visited nodes memory with the dummy node
    This.recent1NodePtr = @This.dummyNode
    This.recent2NodePtr = @This.dummyNode
    ' Initializes the threading loop
    This._mutex = MutexCreate()                                              '' create mutex
    MutexLock(This._mutex)                                                   '' lock mutex
    This._pt= ThreadCreate(Cptr(Any Ptr, @DynamicArrayList._Thread), @This)  '' launch child thread
End Constructor

Constructor DynamicArrayList(ByVal nbrPreAlloc As Integer)
    Constructor()
    If nbrPreAlloc > 0 Then
        ' Pre-allocates memory for nbrPreAlloc nodes
        This.preAllocPtr = Allocate(nbrPreAlloc * Sizeof(DoublyLinkedNode))
        If This.preAllocPtr > 0 Then This.nbrPreAllocDone = nbrPreAlloc
    End If
End Constructor

Property DynamicArrayList.NumberOfPreAllocUsed() As Integer
    Return This.nbrPreAllocUsed
End Property

Property DynamicArrayList.NumberOfPreAllocAvailable() As Integer
    Return This.nbrPreAllocDone - This.preAllocNbr
End Property

Sub DynamicArrayList._Thread()
    '  Threading loop
    Do
        MutexLock(This._mutex)          '' wait for mutex unlock from main thread
        If This._end = 1 Then Exit Sub  '' exit the threading loop
        This._returnT = This.TraverseNodes(This._nodePtrT, This._nT)
        This._flag = 1                  '' set flag for main thread
    Loop
End Sub

Destructor DynamicArrayList()
    ' Deallocates memory used by user nodes one by one by transverse access
    This.DestroyAllNthPosition()
    If This.nbrPreAllocDone > 0 Then
        ' Deallocates the pre-allocated memory
        Deallocate(This.preAllocPtr)
        This.nbrPreAllocDone = 0
    End If
    ' Ends the threading loop
    This._end = 1              '' set _end for chimld thread
    MutexUnlock(This._mutex)   '' unlock mutex for child thread
    ThreadWait(This._pt)       '' wait for child thread end
    MutexDestroy(This._mutex)  '' destroy mutex
End Destructor



Sub PrintList(Byref dal As DynamicArrayList)
    Print "   list:";
    If dal.ReturnNumberOfPosition() = 0 Then
        Print " empty";
    Elseif dal.ReturnNumberOfPosition() <= 10 Then
        For I As Integer = 1 To dal.ReturnNumberOfPosition()
            Print *Cptr(Long Ptr, dal.ReturnFromNthPosition(I));
        Next I
    Else
        For I As Integer = 1 To 5
            Print *Cptr(Long Ptr, dal.ReturnFromNthPosition(I));
        Next I
        Print " .....";
        For I As Integer = dal.ReturnNumberOfPosition() - 4 To dal.ReturnNumberOfPosition()
            Print *Cptr(Long Ptr, dal.ReturnFromNthPosition(I));
        Next I
    End If
    Print
End Sub

Sub test(Byval NbrOfElements As Integer, Byval NbrOfPreAllocatedNodes As Integer)
    Dim As Double t

    Print "Creating a list of " & NbrOfElements & " elements with " & NbrOfPreAllocatedNodes & " pre-allocated nodes:"
    t = Timer
    Dim As DynamicArrayList dal = DynamicArrayList(NbrOfPreAllocatedNodes)
    For I As Integer = 1 To NbrOfElements
        dal.InsertInNthPosition(New Long(I), 0)
    Next I
    t = Timer - t
    Print Using "   runtime:####.#### s"; t
    PrintList(dal)
    Print "Shifting #+3 by +" & NbrOfElements - 5 & " positions:"
    dal.ShiftTheNthPosition(+3, +(NbrOfElements - 5))
    PrintList(dal)
    Print "Shifting #-3 by +" & -(NbrOfElements - 5) & " positions:"
    dal.ShiftTheNthPosition(-3, -(NbrOfElements - 5))
    PrintList(dal)
    Print "Shifting " & NbrOfElements / 2 & " random elements each to a random position:"
    Randomize(NbrOfElements)
    t = Timer
    For I As Integer = 1 To NbrOfElements \ 2
        Dim As Integer N1 = Int(Rnd() * NbrOfElements + 1)
        Dim As Integer N2 = Int(Rnd() * NbrOfElements + 1)
        dal.ShiftTheNthPosition(N1, N2 - N1)
    Next I
    t = Timer - t
    Print Using "   runtime:####.#### s"; t
    PrintList(dal)
    Print "Suppressing all " & NbrOfElements & " elements:"
    t = Timer
    While dal.ReturnNumberOfPosition() > 0
        Delete Cptr(Long Ptr, dal.SuppressTheNthPosition(1))
    Wend
    t = Timer - t
    Print Using "   runtime:####.#### s"; t
    PrintList(dal)
    Print
End Sub

test(100000, 0)
test(100000, 100000)

Sleep
  • Example of output:

    Code: Select all

    Creating a list of 100000 elements with 0 pre-allocated nodes:
       runtime:   0.0245 s
       list: 1 2 3 4 5 ..... 99996 99997 99998 99999 100000
    Shifting #+3 by +99995 positions:
       list: 1 2 4 5 6 ..... 99997 99998 3 99999 100000
    Shifting #-3 by +-99995 positions:
       list: 1 2 3 4 5 ..... 99996 99997 99998 99999 100000
    Shifting 50000 random elements each to a random position:
       runtime:   5.2047 s
       list: 6 9 11 14 15 ..... 99994 68342 9457 99997 39167
    Suppressing all 100000 elements:
       runtime:   0.0271 s
       list: empty
    
    Creating a list of 100000 elements with 100000 pre-allocated nodes:
       runtime:   0.0198 s
       list: 1 2 3 4 5 ..... 99996 99997 99998 99999 100000
    Shifting #+3 by +99995 positions:
       list: 1 2 4 5 6 ..... 99997 99998 3 99999 100000
    Shifting #-3 by +-99995 positions:
       list: 1 2 3 4 5 ..... 99996 99997 99998 99999 100000
    Shifting 50000 random elements each to a random position:
       runtime:   4.4135 s
       list: 6 9 11 14 15 ..... 99994 68342 9457 99997 39167
    Suppressing all 100000 elements:
       runtime:   0.0232 s
       list: empty
    
Last edited by fxm on Dec 28, 2024 9:26, edited 1 time in total.
Reason: Previous bug fixed.
dafhi
Posts: 1716
Joined: Jun 04, 2005 9:51

Re: Dynamic ArrayList (with circular doubly linked list under the hood)

Post by dafhi »

reported speed improvement looks nice. i made an array-based LL early 2000's and seeing "disconnect and reconnect" brings back memories.

your initial post was updated in August

i may give this a go in one of my particles sims

my particle recycle: swap with array end and decrement stack ptr

i think i swapped entire object .. haven't messed with pointers much other than w/ pixels
fxm
Moderator
Posts: 12465
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Dynamic ArrayList (with circular doubly linked list under the hood)

Post by fxm »

dafhi wrote: Dec 29, 2024 12:27 your initial post was updated in August

But it points to those 4 posts which define my latest official release (the latest improvement above will be made official in about a week after further testing).
fxm wrote: Jul 19, 2024 7:58 .....
- See at these 4 posts the ultimate update of all codes and examples with the final appellation : 'Dynamic ArrayList'
.....
dafhi
Posts: 1716
Joined: Jun 04, 2005 9:51

Re: Dynamic ArrayList (with circular doubly linked list under the hood)

Post by dafhi »

i did a typical 'me' maneuver. went straight for the gravy and missed the potatoes

(i always eat my potatoes but you get my drift)
fxm
Moderator
Posts: 12465
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Dynamic ArrayList (with circular doubly linked list under the hood)

Post by fxm »

fxm wrote: Dec 28, 2024 9:25 File to include "DynamicArrayList.bi" : Improvement of the Shift method performance by using new algorithm and multi-threading

In the present algorithm, the node is not really shifted but only the user pointer is propagated up to the targeted position by a sequence of successive swaps (so N 'SWAP' instructions for a shift of N positions).
For a large list, that may induce potential large shifts and consequently an important number of 'SWAP' instructions to execute.

The new algorithm un-inserts the concerned node and re-inserts it at the targeted position.
This corresponds to only six pointer assignments and that whatever the shift size.
For a large list and random shifts, this improves the execution time by a factor of about 3.

In addition, similarly to the Swap method (because two positions are now directly accessed), multi-threading may be also applied, inducing an additional improvement of about 25%.
In total, the execution time is improved by a factor of about 4.

The reference post 1/4 has been updated with this improved version of the 'DynamicArrayList' type:
Improvement of the Shift method performance by using new algorithm and multi-threading, as well as another small improvement for Swap and Shift methods when multi-threading is not applied.
('DynamicArrayList.bi' - 31 Dec 2024)
fxm
Moderator
Posts: 12465
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Dynamic ArrayList (with circular doubly linked list under the hood)

Post by fxm »

The reference post 1/4 has been updated with this improved version of the 'DynamicArrayList' type:
Changed private member Sub '_Thread()' to static member Sub '_Thread(ByVal As DynamicArrayList Ptr)' for compatibility with fbc versions < 1.10.
('DynamicArrayList.bi' - 13 Jan 2025)
Post Reply