foodgood
09-03-2011, 02:07 AM
I am trying to recreate the Collection's Remove procedure, except I am trying to use it on an array instead of on a collection. I am trying to emulate the open source Java ArrayList code.
As you can see from the RemoveAt sub below, I am simply copying all elements located to the right of the removed element, then pasting those elements on top of the removed element,and finally emptying the element at the very end of the array.
This method works extremely fast if you are removing an element from the very end of the array (because in that case,it doesn't have to copy anything), but if you are trying to remove a bunch of elements from the middle of a large (1,000+ elements) array, forget about it! It takes over 10 seconds to remove 3,000 elements in the middle part of a 5,000 element array. Meanwhile, a collection can easily do the same in under .5 seconds.
Does anyone have any ideas for how I can speed up my RemoveAt procedure?
Private elementData() As Variant
Public size As Long
Public Function getArrayEls(ByVal StartingIndex As Long, ByVal EndingIndex As Long) As Variant()
Dim els() As Variant
ReDim els(EndingIndex - StartingIndex)
Dim i As Long
Dim j As Long
j = 0
For i = StartingIndex To EndingIndex
If Not IsObject(elementData(i)) Then
els(j) = elementData(i)
Else: Set els(j) = elementData(i)
End If
j = j + 1
Next i
getArrayEls = els
End Function
Public Function arrayCopy(array1() As Variant, ByVal startingIndex1 As Long, array2() As Variant, _
startingIndex2 As Long, ByVal TotalElements As Long)
'copies from arr1, starting at stindex1, to arr2, starting at stindex2, totalelements.
Dim i As Long
Dim j As Long
j = startingIndex2
For i = startingIndex1 To startingIndex1 + TotalElements
If Not IsObject(array1(i)) Then
array2(j) = array1(i)
Else: Set array2(j) = array1(i)
End If
j = j + 1
Next i
End Function
Public Sub RemoveAt(ByVal Index As Long)
'removes the element at the index and shifts everything (to the right) to the left 1
'validates that the index is within bounds
checkIndex (Index)
If Index = size - 1 Then
elementData(size - 1) = Empty
Else
'get all the elements to the right of the given index
Dim rightOf() As Variant
rightOf = Me.getArrayEls(Index + 1, size - 1)
'copy rightOf into the AL's elements, starting at the removed index
Call Me.arrayCopy(rightOf, 0, elementData, Index, UBound(rightOf))
'get rid of the element at the end
elementData(size - 1) = Empty
End If
size = size - 1
End Sub
As you can see from the RemoveAt sub below, I am simply copying all elements located to the right of the removed element, then pasting those elements on top of the removed element,and finally emptying the element at the very end of the array.
This method works extremely fast if you are removing an element from the very end of the array (because in that case,it doesn't have to copy anything), but if you are trying to remove a bunch of elements from the middle of a large (1,000+ elements) array, forget about it! It takes over 10 seconds to remove 3,000 elements in the middle part of a 5,000 element array. Meanwhile, a collection can easily do the same in under .5 seconds.
Does anyone have any ideas for how I can speed up my RemoveAt procedure?
Private elementData() As Variant
Public size As Long
Public Function getArrayEls(ByVal StartingIndex As Long, ByVal EndingIndex As Long) As Variant()
Dim els() As Variant
ReDim els(EndingIndex - StartingIndex)
Dim i As Long
Dim j As Long
j = 0
For i = StartingIndex To EndingIndex
If Not IsObject(elementData(i)) Then
els(j) = elementData(i)
Else: Set els(j) = elementData(i)
End If
j = j + 1
Next i
getArrayEls = els
End Function
Public Function arrayCopy(array1() As Variant, ByVal startingIndex1 As Long, array2() As Variant, _
startingIndex2 As Long, ByVal TotalElements As Long)
'copies from arr1, starting at stindex1, to arr2, starting at stindex2, totalelements.
Dim i As Long
Dim j As Long
j = startingIndex2
For i = startingIndex1 To startingIndex1 + TotalElements
If Not IsObject(array1(i)) Then
array2(j) = array1(i)
Else: Set array2(j) = array1(i)
End If
j = j + 1
Next i
End Function
Public Sub RemoveAt(ByVal Index As Long)
'removes the element at the index and shifts everything (to the right) to the left 1
'validates that the index is within bounds
checkIndex (Index)
If Index = size - 1 Then
elementData(size - 1) = Empty
Else
'get all the elements to the right of the given index
Dim rightOf() As Variant
rightOf = Me.getArrayEls(Index + 1, size - 1)
'copy rightOf into the AL's elements, starting at the removed index
Call Me.arrayCopy(rightOf, 0, elementData, Index, UBound(rightOf))
'get rid of the element at the end
elementData(size - 1) = Empty
End If
size = size - 1
End Sub