LinkedList - a class module to store list of values

'-------------------------------------------------
' LINKED LIST class module
'
' This class implements a linked list structure, where you can store
' values (appending them after the last element or inserting them at
' given indexes), remove them, and visit them using recordset-like
' methods such as MoveFirst, MoveNext, and Move(n)
'
' NOTE: make Item the default member for this class
'       you can do so from inside the Tools | Procedure Attributes dialog box
'
' Usage:
'   Dim ll As New LinkedList
'   ' optionally size the inner array
'   ll.SetSize 10000
'   ' add new elements (can optionally take Before or After element)
'   ' returns the index where the element has been stored
'   newIndex = ll.Add newValue
'
'   ' loop over all elements
'   ll.MoveFirst
'   Do Until ll.EOL
'       ' display or process the current element
'       Print ll.Item
'       ' move to next element
'   Loop
'
'   See remarks for the FIND method for details about performing searches
'   on the elements in the linked list
'
'-------------------------------------------------

Option Explicit

' these are used by the Find method
Public Enum FindConditionConstants
    fccEqual
    fccNotEqual
    fccLess
    fccLessEqual
    fccGreater
    fccGreaterEqual
    fccInStr
End Enum

' initial size of the list
Const DEFAULT_INITIALSIZE = 100
' how many items are allocated each time
Const DEFAULT_CHUNKSIZE = 100

Private Type ListType
    Value As Variant
    prevNdx As Long    ' -1 if the element is free
    nextNdx As Long
End Type

' the actual list
Dim List() As ListType
' number of items in the list
Dim m_Count As Long

' index of first/last item in the list
Private FirstNdx As Long
Private LastNdx As Long
' index of first free item in the list
Private FreeNdx As Long

' chucnk size
Private m_ChunkSize As Long

' index to the current element
Private m_CurrIndex As Long
' current EOL status of the list
' (is valid only when m_CurrIndex = 0)
Private m_EOL As Boolean     ' if False, then BOL is true

' the index of the current element

Property Get CurrIndex() As Long
    CurrIndex = m_CurrIndex
End Property

Property Let CurrIndex(ByVal newValue As Long)
    m_CurrIndex = newValue
End Property

' move to the first element

Sub MoveFirst()
    m_CurrIndex = FirstNdx
End Sub

' move to the last element

Sub MoveLast()
    m_CurrIndex = LastNdx
End Sub

' move the the previous element

Sub MovePrevious()
    ' this code works also when m_CurrIndex = 0
    m_CurrIndex = List(m_CurrIndex).prevNdx
    ' in case we move too much
    m_EOL = False
End Sub

' move to the next element

Sub MoveNext()
    ' this code works also when m_CurrIndex = 0
    m_CurrIndex = List(m_CurrIndex).nextNdx
    ' in case we move too much
    m_EOL = True
End Sub

' move to the Nth element

Sub Move(ByVal Index As Long)
    CheckIndex Index
    ' if there were no error, then update the current Index
    m_CurrIndex = Index
End Sub

' Return true if we are at the beginning of list

Property Get BOL() As Boolean
    BOL = (m_Count = 0) Or (m_CurrIndex = 0 And m_EOL = False)
End Property

' Return true if we are at the end of list

Property Get EOL() As Boolean
    EOL = (m_Count = 0) Or (m_CurrIndex = 0 And m_EOL = True)
End Property

' An item of the list (read-write)
' if the argument is omitted it retrieves the current item

Property Get Item(Optional ByVal Index As Long) As Variant
Attribute Item.VB_UserMemId = 0
    If Index = 0 Then Index = m_CurrIndex
    ' check that the index point to a valid, non-free element
    CheckIndex Index
    ' two cases: the value is/isn't an object
    If IsObject(List(Index).Value) Then
        Set Item = List(Index).Value
    Else
        Item = List(Index).Value
    End If
End Property

Property Let Item(Optional ByVal Index As Long, newValue As Variant)
    If Index = 0 Then Index = m_CurrIndex
    ' check that this is a valid, non-free item
    CheckIndex Index
    ' modify the value in the list
    List(Index).Value = newValue
End Property

Property Set Item(Optional ByVal Index As Long, newValue As Object)
    If Index = 0 Then Index = m_CurrIndex
    ' check that this is a valid, non-free item
    CheckIndex Index
    ' modify the value in the list
    Set List(Index).Value = newValue
End Property

' return True if the list is empty

Property Get IsEmpty() As Boolean
    IsEmpty = (m_Count = 0)
End Property

' the number of elements in the list

Property Get Count() As Long
    Count = m_Count
End Property


' insert a new item before/after a given element
' if both arguments are omitted it is appended to the end of the list
' a zero or negative value for Before means "at the beginning of the list"
' and works also when the list is empty
'
' returns the index of the new value

Function Add(Value As Variant, Optional ByVal Before As Long, _
    Optional ByVal After As Long) As Long
    Dim ndx As Long
    Dim nextFreeNdx As Long
    
    ' enlarge the list if necessary
    If FreeNdx = 0 Then ExpandList m_ChunkSize
    ' use the first free slot
    ndx = FreeNdx
    nextFreeNdx = List(ndx).nextNdx
    
    ' a special value for Before that means "at the beginning of the list"
    If Before < 0 Then Before = FirstNdx
    
    If Before > 0 Then
        ' check that this is a valid, non-free item
        CheckIndex Before
        ' "Before" item becomes this item's next element
        List(ndx).nextNdx = Before
        ' "Before"'s previous element becomes this item's previous element
        List(ndx).prevNdx = List(Before).prevNdx
        ' "Before's" previous element should point to this item
        List(Before).prevNdx = ndx
        
        If Before = FirstNdx Then
            ' "Before" was the first item in the list
            FirstNdx = ndx
        Else
            ' else, another item's next element points to this item
            List(List(ndx).prevNdx).nextNdx = ndx
        End If
    
    ElseIf After > 0 Then
        ' check that this is a valid, non-free item
        CheckIndex After
        ' "After" item becomes this item's previous element
        List(ndx).prevNdx = After
        ' "After" item's next element becomes this item's next element
        List(ndx).nextNdx = List(After).nextNdx
        ' "After"'s next element should point to this item
        List(After).nextNdx = ndx
        
        If After = LastNdx Then
            ' "After" was the last item in the list
            LastNdx = ndx
        Else
            ' else, another item's previous element points to this item
            List(List(ndx).nextNdx).prevNdx = ndx
        End If
        
    Else
        ' append at the end of the list
        If LastNdx Then
            ' this item becomes the "next" item of the
            ' item that was at the end of the list
            List(LastNdx).nextNdx = ndx
            List(ndx).prevNdx = LastNdx
        Else
            ' this is the first and only item in the list
            FirstNdx = ndx
            ' signal that this item isn't free any longer
            List(ndx).prevNdx = 0
        End If
        ' in all cases this becomes the last item in the list
        LastNdx = ndx
        List(ndx).nextNdx = 0
    End If
    
    ' actually store the new value
    If IsObject(Value) Then
        Set List(ndx).Value = Value
    Else
        List(ndx).Value = Value
    End If
    ' remember we have a new item
    m_Count = m_Count + 1
    ' FreeNdx must point to the first free slot
    FreeNdx = nextFreeNdx
    
    ' return the index of the element just added
    Add = ndx
    
End Function

' remove an item given its index
' if the index is omitted it removes the current item
'
' if the item is also the current item, then its subsequent
' element becomes the current item (if it was the last element
' then the EOL condition becomes True)

Sub Remove(Optional ByVal Index As Long)
    If Index = 0 Then Index = m_CurrIndex
    ' check that this is a valid, non-free item
    CheckIndex Index
    
    If Index = FirstNdx Then
        ' the item being removed is the first of the list
        FirstNdx = List(Index).nextNdx
        List(FirstNdx).prevNdx = 0
    ElseIf Index = LastNdx Then
        ' the item being removed is the last of the list
        ' but the list contains at least another item
        LastNdx = List(Index).prevNdx
        List(LastNdx).nextNdx = 0
    Else
        ' the item is in the middle of the list
        List(List(Index).prevNdx).nextNdx = List(Index).nextNdx
        List(List(Index).nextNdx).prevNdx = List(Index).prevNdx
    End If

    ' clear this item's value
    List(Index).Value = Empty
    ' remember we have one element less
    m_Count = m_Count - 1
    
    ' if this was the current item, update m_CurrIndex
    If Index = m_CurrIndex Then
        m_CurrIndex = List(Index).nextNdx
        ' if it was the last element of the list
        If m_CurrIndex = 0 Then m_EOL = True
    End If
    ' put it at the beginning of the free list
    List(Index).nextNdx = FreeNdx
    ' mark it as free
    List(Index).prevNdx = -1
    FreeNdx = Index
End Sub

' remove all items
' this method also resets any SetSize setting

Sub RemoveAll()
    ' it simply restarts from the very beginning
    Class_Initialize
End Sub

' search a value in the list
'
' STARTINDEX is the index of the element from where to
' start the search - use ZERO or omitted to start from
' the current element, use -1 to start from first/last element
' if DESCENDING is True then it does a reverse search
'
' returns the index of the found element, or zero if not found
' the element also becomes the current element

Function Find(Value As Variant, Optional Condition As FindConditionConstants = _
    fccEqual, Optional ByVal StartIndex As Long, Optional ByVal Descending As _
    Boolean) As Long
    Dim isObj As Boolean
    
    ' provide reasonable defaults
    If StartIndex = 0 Then
        StartIndex = m_CurrIndex
    ElseIf StartIndex < 0 Then
        If Not Descending Then
            StartIndex = FirstNdx
        Else
            StartIndex = LastNdx
        End If
    Else
        ' check that this index is valid
        CheckIndex StartIndex
        ' start from the next or previous element
        If Not Descending Then
            StartIndex = List(StartIndex).nextNdx
        Else
            StartIndex = List(StartIndex).prevNdx
        End If
    End If
    
    ' evaluate this once and for all
    isObj = IsObject(Value)
    
    ' two loops, depending on value being an object or not
    Do While StartIndex
        If isObj Then
            ' do the comparison only if the element is also an object
            If IsObject(List(StartIndex).Value) Then
                If Value Is List(StartIndex).Value Then
                    ' exit if we're looking for equality
                    If Condition <> fccNotEqual Then Exit Do
                Else
                    ' exit if we're looking for inequality
                    If Condition = fccNotEqual Then Exit Do
                End If
            End If
        Else
            ' do the comparison only if the element isn't an object
            If Not IsObject(List(StartIndex).Value) Then
                Select Case Condition
                    Case fccNotEqual
                        If List(StartIndex).Value <> Value Then Exit Do
                    Case fccLess
                        If List(StartIndex).Value < Value Then Exit Do
                    Case fccLessEqual
                        If List(StartIndex).Value <= Value Then Exit Do
                    Case fccGreater
                        If List(StartIndex).Value > Value Then Exit Do
                    Case fccGreaterEqual
                        If List(StartIndex).Value >= Value Then Exit Do
                    Case fccInStr
                        If InStr(List(StartIndex).Value, Value) Then Exit Do
                    Case Else
                        ' equality is the default test
                        If List(StartIndex).Value = Value Then Exit Do
                End Select
            End If
        End If
        ' skip to the next or previous item
        If Not Descending Then
            StartIndex = List(StartIndex).nextNdx
        Else
            StartIndex = List(StartIndex).prevNdx
        End If
    Loop
        
    ' make the item the current item and return its index
    m_CurrIndex = StartIndex
    Find = StartIndex
        
End Function

' modify the list size and growth factor
' you can expand but not shrink a linked list

Sub SetSize(ByVal numEls As Long, Optional ByVal ChunkSize As Long)
    ' raise an error if invalid arguments
    If numEls <= 0 Or ChunkSize < 0 Then Err.Raise 5
    
    If numEls > UBound(List) Then
        ' expand the list
        ExpandList numEls - UBound(List)
    End If
    ' remember new ChunkSize
    m_ChunkSize = ChunkSize
End Sub

'--------------------------------------------
' Private procedures
'--------------------------------------------

Private Sub Class_Initialize()
    ' initialize the linked list of free slots
    ReDim List(0) As ListType
    ExpandList DEFAULT_INITIALSIZE
    m_ChunkSize = DEFAULT_CHUNKSIZE
End Sub

' check that there is at least one free slot

Private Sub ExpandList(ByVal numEls As Long)
    Dim ndx As Long, newFreeNdx As Long
    
    ' this will be the first free slot
    newFreeNdx = UBound(List) + 1
    ' expand the list
    ReDim Preserve List(UBound(List) + numEls) As ListType
    ' initialize the links for free items
    ' (note that the nextNdx value for the last element isn't correct
    For ndx = newFreeNdx To UBound(List)
        List(ndx).nextNdx = ndx + 1
        List(ndx).prevNdx = -1
    Next
    ' append the existing chain of free slots
    ' (fixes the invalid value stored previously)
    List(UBound(List)).nextNdx = FreeNdx
    ' this is the new start of the free list
    FreeNdx = newFreeNdx
End Sub

' check whether an index is valid

Sub CheckIndex(ByVal Index As Long)
    If Index <= 0 Or Index > UBound(List) Then Err.Raise 5
    If List(Index).prevNdx < 0 Then Err.Raise 5
End Sub