Skip to content

Instantly share code, notes, and snippets.

@Lokutus
Created June 29, 2012 16:24
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save Lokutus/3018946 to your computer and use it in GitHub Desktop.
SortableCollection
%REM
Class SortableCollectionItem
Enumerable object to be used in sortable collections
Sort comparison is provided by extending of the method CompareTo
CompareTo method expects object of the same type as the current
@author Jiri Krakora
@date 26.06.2012
@extends CollectionItem
@revision 1.0 Release
%END REM
Public Class SortableCollectionItem As CollectionItem
%REM
Campare current collection item with another one of the same type to do the sorting
@param SortableCollectionItem and extended objects
@return true/false
%END REM
Public Function CompareTo(collectionItem As Variant) As Boolean
' in inherited classes implement a comparison
' param collectionItem should be the same type as current item
End Function
End Class
%REM
Class SortableCollection
Generic objects SortableCollection class
Can be used any user-defined objects,
but must extend SortableCollectionItem class
@author Jiri Krakora
@date 26.06.2012
@uses Stack, SortableCollectionItem
@extends Collection
@revision 1.0 Release
Example
----------------------------------------------------------------------------
Public Class TestItemInt As SortableCollectionItem
Private oI As Integer
Public Property Set I As Integer
Let Me.oI = I
End Property
Public Property Get I As Integer
Let I = Me.oI
End Property
Public Function CompareTo(collectionItem As Variant) As Boolean
If collectionItem.I > Me.I Then
Let CompareTo = True
End If
End Function
Public Function ToString As String
Let ToString = CStr(Me.oI)
End Function
End Class
Dim item As TestItemInt
Dim col As New SortableCollection
Dim i As Integer
For i = 1 To 10
Set item = New TestItemInt
Let item.I = Rnd() * 100
Call col.Add(item)
Next
Call col.Sort
While col.MoveNext
Print col.Current.ToString
Wend
%END REM
Public Class SortableCollection As Collection
Private oStack As Stack
%REM
Only add item into collection
@param item
@return true/false
%END REM
Private Function AddItemIntoCollection(item As Variant) As Boolean
On Error 182 GoTo eh182 ' when asking for property ID
On Error GoTo eh
If DataType(item) = 34 Then ' is it user defined object?
If Not item Is Nothing Then ' is it instantiated?
If DataType(item.ID) = 8 Then ' is property ID string?
If item.ID = "" Then ' if ID is empty, create unique one
Let item.ID = Me.GetUniqueItemID
End If
If Not IsElement(Me.oCollection(item.ID)) Then
Set Me.oCollection(item.ID) = item
Let AddItemIntoCollection = True
End If
End If
End If
End If
es:
Exit Function
eh182:
Resume es
eh:
Resume es
End Function
%REM
description
@param
%END REM
Public Sub Sort
Dim l As Long
Dim r As Long
Set Me.oStack = New Stack(0)
Let l = 0
Let r = Me.oUpperBound
Call Me.Quicksort(l, r)
End Sub
%REM
description
@param
%END REM
Private Sub Quicksort(ByVal l As Long, ByVal r As Long)
Dim pivot As Long
Call Me.oStack.Push(l)
Call Me.oStack.Push(r)
While Not Me.oStack.IsEmpty
Let r = Me.oStack.Pop()
Let l = Me.oStack.Pop()
If r > l Then
Let pivot = Me.SetPivot(l, r)
' sort left side from pivot
Call Me.oStack.Push(l)
Call Me.oStack.Push(pivot)
' sort right side from pivot
Call Me.oStack.Push(pivot + 1)
Call Me.oStack.Push(r)
End If
Wend
End Sub
%REM
Set pivot position between smaller items on the left and larger on the right
@param left bound of the items array
@return right bound of the items array
%END REM
Private Function SetPivot(l As Long, r As Long) As Long
Dim i As Long
Dim boundary As Long
Dim itemI As Variant
Dim itemL As Variant
Let boundary = l
' get boundary position for pivot
For i = l + 1 To r
Set itemI = Me.oCollection(Me.oIndex(i))
Set itemL = Me.oCollection(Me.oIndex(l))
If itemI.CompareTo(itemL) Then
Let boundary = boundary + 1
Call Swap(i, boundary)
End If
Next
' set pivot as a boundary
Call Me.Swap(l, boundary)
Let SetPivot = boundary
End Function
%REM
Swap two values in the collection
@param array to be sorted
@param left position
@param right position
%END REM
Private Sub Swap(l As Long, r As Long)
Dim tmp As String
Let tmp = Me.oIndex(r)
Let Me.oIndex(r) = Me.oIndex(l)
Let Me.oIndex(l) = tmp
End Sub
End Class
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment