Namespace Generic
Public Class LinkedArray(Of type)
Implements IList(Of type)
Implements IList
' Empirically this seems to be a good compromise and give good results
Const DEFAULT_ARRAY_SIZE As Integer = 2220
' I did not experiment much with this parameter
' I set it to half the Splitting size, it will therefore waste no more than 50% of the memory
' and on average probably less
Const DEFAULT_MERGE_ARRAY_SIZE As Integer = DEFAULT_ARRAY_SIZE \ 2
Private mArraySize As Integer
Private mMergeArraySize As Integer
Friend mLists As List(Of List(Of type))
Friend mCount As Integer
Friend mVersion As Integer
Sub New(Optional ByVal arraySize As Integer = DEFAULT_ARRAY_SIZE, Optional ByVal mergeArraySize As Integer = DEFAULT_MERGE_ARRAY_SIZE)
mArraySize = arraySize
mMergeArraySize = mergeArraySize
mLists = New List(Of List(Of type))
End Sub
Private Function InternalSearch(ByVal value As type, ByRef index1 As Integer, ByRef list As List(Of type), ByRef index2 As Integer) As Integer
Dim base As Integer = 0
For index1 = 0 To mLists.Count - 1
list = mLists(index1)
index2 = list.IndexOf(value)
If index2 >= 0 Then
Return base + index2
End If
base += list.Count
Next
Return -1
End Function
Private Function InternalGetIndex(ByVal index As Integer, ByRef index1 As Integer, ByRef list As List(Of type), ByRef index2 As Integer) As Boolean
If index < 0 OrElse index >= mCount Then Return False
If index < mCount \ 2 Then
Dim base As Integer = 0
Dim newBase As Integer = 0
For index1 = 0 To mLists.Count - 1
list = mLists(index1)
newBase = base + list.Count
If index < newBase Then
index2 = index - base
Return True
End If
base = newBase
Next
Else
' Start by the end
Dim limit As Integer = mCount
Dim newLimit As Integer = 0
For index1 = mLists.Count - 1 To 0 Step -1
list = mLists(index1)
newLimit = limit - list.Count
If index >= newLimit Then
index2 = index - newLimit
Return True
End If
limit = newLimit
Next
End If
Return False
End Function
Public Sub Add(ByVal item As type) Implements System.Collections.Generic.ICollection(Of type).Add
Dim a As List(Of type) = Nothing
If mLists.Count > 0 Then a = mLists(mLists.Count - 1)
If a Is Nothing OrElse a.Count >= mArraySize Then
a = New List(Of type) '(mArraySize \ 2) It doesn't seem to have much benefit to allocate more than nescessary
mLists.Add(a)
End If
mVersion += 1
mCount += 1
a.Add(item)
End Sub
Public Sub Clear() Implements System.Collections.Generic.ICollection(Of type).Clear, System.Collections.IList.Clear
' this is not really needed but I think this might help the garbage collector
For Each a As List(Of type) In mLists
a.Clear()
Next
mLists.Clear()
mVersion += 1
mCount = 0
End Sub
Public Function Contains(ByVal item As type) As Boolean Implements System.Collections.Generic.ICollection(Of type).Contains
Return IndexOf(item) >= 0
End Function
Public Sub CopyTo(ByVal array() As type, ByVal arrayIndex As Integer) Implements System.Collections.Generic.ICollection(Of type).CopyTo
Throw New Exception("Not implemented")
End Sub
Public ReadOnly Property Count() As Integer Implements System.Collections.Generic.ICollection(Of type).Count, System.Collections.ICollection.Count
Get
Return mCount
End Get
End Property
Private Sub InternalMerge(ByVal index1 As Integer)
Dim list As List(Of type) = mLists(index1)
Dim count As Integer = list.Count
If count = 0 Then
mLists.RemoveAt(index1)
Else
If index1 > 0 Then
Dim prevList As List(Of type) = mLists(index1 - 1)
If prevList.Count + count < mMergeArraySize Then
mLists.RemoveAt(index1)
prevList.AddRange(list)
index1 -= 1
list.Clear()
list = prevList
count = list.Count
End If
End If
If index1 < mLists.Count - 1 Then
Dim nextList As List(Of type) = mLists(index1 + 1)
If count + nextList.Count < mMergeArraySize Then
mLists.RemoveAt(index1 + 1)
list.AddRange(nextList)
nextList.Clear()
End If
End If
End If
End Sub
Public Function Remove(ByVal item As type) As Boolean Implements System.Collections.Generic.ICollection(Of type).Remove
Dim index1, index2 As Integer
Dim list As List(Of type) = Nothing
If InternalSearch(item, index1, list, index2) >= 0 Then
list.RemoveAt(index2)
InternalMerge(index1)
mVersion += 1
mCount -= 1
Return True
Else
Return False
End If
End Function
Public Function IndexOf(ByVal item As type) As Integer Implements System.Collections.Generic.IList(Of type).IndexOf
Return InternalSearch(item, Nothing, Nothing, Nothing)
End Function
Public Sub Insert(ByVal index As Integer, ByVal item As type) Implements System.Collections.Generic.IList(Of type).Insert
Dim a As List(Of type) = Nothing
Dim base As Integer = 0
Dim newBase As Integer = 0
For index1 = 0 To mLists.Count - 1
a = mLists(index1)
newBase = base + a.Count
If index = newBase Then
index = newBase
End If
If index < newBase Then
If a.Count >= mArraySize Then
'split in two
Dim newList As New List(Of type)
mLists.Insert(index1 + 1, newList)
' we put the second half in the new list
Dim array(a.Count - mArraySize \ 2 - 1) As type
a.CopyTo(a.Count - array.Length, array, 0, array.Length)
newList.AddRange(array)
' and we remove the end in the old list
a.RemoveRange(mArraySize \ 2, array.Length)
newBase = base + a.Count
If index > newBase Then
base = newBase
a = newList
End If
End If
index -= base
mVersion += 1
mCount += 1
a.Insert(index, item)
Exit Sub
End If
base = newBase
Next
If index > base Then
Throw New ArgumentOutOfRangeException("index", index, "Parameter out of range")
Else
Add(item)
End If
End Sub
Default Public Overloads Property Item(ByVal index As Integer) As type Implements System.Collections.Generic.IList(Of type).Item
Get
Dim index2 As Integer
Dim list As List(Of type) = Nothing
If InternalGetIndex(index, Nothing, list, index2) Then
Return list(index2)
Else
Throw New ArgumentOutOfRangeException("index", index, "Parameter out of range")
End If
End Get
Set(ByVal value As type)
Dim index2 As Integer
Dim list As List(Of type) = Nothing
If InternalGetIndex(index, Nothing, list, index2) Then
mVersion += 1
list(index2) = value
Else
Throw New ArgumentOutOfRangeException("index", index, "Parameter out of range")
End If
End Set
End Property
Public Sub RemoveAt(ByVal index As Integer) Implements System.Collections.Generic.IList(Of type).RemoveAt, System.Collections.IList.RemoveAt
Dim index1, index2 As Integer
Dim list As List(Of type) = Nothing
If InternalGetIndex(index, index1, list, index2) Then
list.RemoveAt(index2)
InternalMerge(index1)
mVersion += 1
mCount -= 1
Else
Throw New ArgumentOutOfRangeException("index", "ArgumentOutOfRange_Index")
End If
End Sub
Public Function GetEnumerator() As System.Collections.Generic.IEnumerator(Of type) Implements System.Collections.Generic.IEnumerable(Of type).GetEnumerator
Return New LinkedArrayEnumerator(Of type)(Me)
End Function
Public Function IEnumerable_GetEnumerator() As System.Collections.IEnumerator Implements System.Collections.IEnumerable.GetEnumerator
Return GetEnumerator()
End Function
Public Sub ICollection_CopyTo(ByVal array As System.Array, ByVal index As Integer) Implements System.Collections.ICollection.CopyTo
CopyTo(CType(array, type()), index)
End Sub
Public ReadOnly Property ICollection_IsSynchronized() As Boolean Implements System.Collections.ICollection.IsSynchronized
Get
Return False
End Get
End Property
Public ReadOnly Property ICollection_SyncRoot() As Object Implements System.Collections.ICollection.SyncRoot
Get
Return mLists
End Get
End Property
Public Function IList_Add(ByVal value As Object) As Integer Implements System.Collections.IList.Add
Add(DirectCast(value, type))
End Function
Public Function IList_Contains(ByVal value As Object) As Boolean Implements System.Collections.IList.Contains
Return Me.Contains(DirectCast(value, type))
End Function
Public Function IList_IndexOf(ByVal value As Object) As Integer Implements System.Collections.IList.IndexOf
Return Me.IndexOf(DirectCast(value, type))
End Function
Public Sub IList_Insert(ByVal index As Integer, ByVal value As Object) Implements System.Collections.IList.Insert
Me.Insert(index, DirectCast(value, type))
End Sub
Public ReadOnly Property IsFixedSize() As Boolean Implements System.Collections.IList.IsFixedSize
Get
Return False
End Get
End Property
Public ReadOnly Property IsReadOnly() As Boolean Implements _
System.Collections.IList.IsReadOnly, _
System.Collections.Generic.ICollection(Of type).IsReadOnly
Get
Return False
End Get
End Property
Public Overloads Property IList_Item(ByVal index As Integer) As Object Implements System.Collections.IList.Item
Get
Return Me.Item(index)
End Get
Set(ByVal value As Object)
Me.Item(index) = DirectCast(value, type)
End Set
End Property
Public Sub IList_Remove(ByVal value As Object) Implements System.Collections.IList.Remove
Me.Remove(DirectCast(value, type))
End Sub
End Class
End Namespace
Submit an article or tip