Sorting a collection

Question

Related to, but not exactly a follow up of this question. After fixing some issues discovered in the last review, I added a little more functionality to the Enumerable class. The problem is, I've never sorted before. I tried (and failed)to implement a few of the standard algorithms before coming up with this. It's not very efficient. It has to check to see if the collection IsSorted and just keeps looping until it is.

• Is there a way to make this more efficient without using a more advanced algorithm?
• What would be a simple to understand algorithm that is more efficient than this?

I realize that I could simplify some logic if I created some interfaces, but I would like to work with "built in" collections without wrapping everything in a class that implements an interface.

Bonus points to anyone who can tell me what algorithm I ended up using. I just kept testing until it worked.

Public Function Sort(collectionObject As Collection) As Collection
 Dim item As Variant
 Dim innerItem As Variant
 Dim i As Long
 Dim j As Long
 Dim index As Long
 Do Until IsSorted(collectionObject)
 For i = 1 To collectionObject.Count
 index = i
 If IsObject(collectionObject(i)) Then
 Set item = collectionObject(i)
 Else
 item = collectionObject(i)
 End If
 For j = i To collectionObject.Count
 If IsObject(collectionObject(j)) Then
 Set innerItem = collectionObject(j)
 Else
 innerItem = collectionObject(j)
 End If
 If item > innerItem Then
 collectionObject.Add item, After:=j
 collectionObject.Remove index
 index = j
 End If
 Next j
 Next i
 Loop
End Function
Private Function IsSorted(collectionObject As Collection) As Boolean
 Dim item As Variant
 Dim previous As Variant
 For Each item In collectionObject
 If item < previous Then
 IsSorted = False
 Exit Function
 End If
 If IsObject(item) Then
 Set previous = item
 Else
 previous = item
 End If
 Next item
 IsSorted = True
End Function

• cheezsteak: You can't define the > or < operators operators for any custom class in VBA, nor can I think of any objects where those operators are already defined. If that is true then whenever IsObject is true you will get a error when comparing the objects.
• RubberDuck: Not exactly true @ptwales. It will throw runtime error 438 "Object does not support method" only if the object does not have a Default Property.
• RubberDuck: @ptwales maybe you could mention in an answer that I should handle that error and raise a better one nudge nudge.
• cheezsteak: patience, young grasshopper
• user28366: Seems like I am late for the party but hey - why not implement an imitation of IComparer along with sorting?

Answer 1

FEAR

This is a red flag.

Do Until IsSorted(collectionObject)
 ' Sorting algorithm 
Loop

Your algorithm should return a sorted sequence and should not need to be checked. If it fails the check you should rewrite your sorting algorithm and not simply try to do it again.

Abstracting Methods

This bit of code is used often enough to merit it's own sub routine

Sub AssignUnknown(ByRef dest As Variant, ByRef src As Variant)
 If IsObject(src) Then
 Set dest = src
 Else
 dest = src
 End If
End Sub

Now your code looks so much better! It looks like a bubble sort but

For i = 1 To collectionObject.count
 index = i
 AssignUnknown item, collectionObject(i)
 For j = i To collectionObject.count
 AssignUnknown innerItem, collectionObject(j)
 If item > innerItem Then
 collectionObject.Add item, After:=j
 collectionObject.Remove index
 index = j
 End If
 Next j
Next i

Algorithm

it doesn't work, hence you needing to loop until it is sorted. You are only a few steps away from true bubble sort though, which is IMO simpler.

 For i = collectionObject.count To 2 Step -1
 ' hasSwapped = False
 For j = 1 To i - 1
 If collectionObject(j) > collectionObject(j + 1) Then
 collectionObject.Add collectionObject(j), After:=j + 1
 collectionObject.Remove j
 ' hasSwapped = true
 End If
 Next j
 ' If Not hasSwapped Then goto sorted ' Exit For
 Next i
sorted:

In short, instead of bubbling up the same object each time, the BubbleSort drops the current item for the next one when it finds a larger item. This means after each inner loop the item at position i is in the correct place, which is why the outer loop is counting down not up.

hasSwapped uncommented allows for early exit if the sequence is already sorted. For more information on the bubble sort, wikipedia has a great article. I also found this site with some cool animations while trying to figure out your sorting algo.

Also note that AssignUnknown is no longer needed.

Error Handling

As we discussed in the comments, the comparison operators will not be defined for objects that do not have a default property. It can't be fixed, but we can raise a more descriptive error

 On Error Goto no_default_property
 ' bubble sort
sorted:
Exit Function
no_default_property:
 If Err.Number = 438 Then ' preferably use the vb constant that I don't know
 Err.Clear
 Err.Raise 438, "Sort", "An item in the collection does not have a default property"
 End If
End Function

After Thoughts

Consider writing CollectionToArray and ArrayToCollection functions so you don't need to duplicate sorting methods for Collections and Arrays. Also consider a Sorted function that returns a sorted copy.

Sub Sorted(collec As Collection) As Collection
 Set Sorted = collec 
 Sort Sorted
End Sub

I was tempted to insist you use a Swap function like this.

Sub Swap(ByRef a As Variant, ByRef b As Variant)
 Dim t as Variant
 t = a
 a = b
 b = t
End Sub

However, you are supporting objects in your collection, you will need to make that routine SwapUnknown that uses AssignUnknown. You could avoid calling IsObject(a) twice but I prefer the simpler solution.

Sub SwapUnkown(ByRef a As Variant, ByRef b As Variant)
 Dim t as Variant
 AssignUnknown t, a
 AssignUnknown a, b
 AssignUnknown b, t
End Sub

I didn't include this because:

• Your current swap method could be faster depending on how Collection is implemented
• Abstracting your current method seems pointless.
• It doesn't require AssignUnkown, which cuts out some ugly code.

Answer 2

• You should use a Sub instead of a Function as you don't return anything.

• Your inner loop

  For j = i To collectionObject.Count 
  

  should start at j = i + 1

• As the Count property of the collectionObject is accessed often, you should introduce a new variable to store the value once.

• A null check for the passed parameter should be added.

Logic

Looking only at the Sort method the collection is not sorted when item > innerItem evaluates to true. So let us introduce a Boolean which will save this state and let us change the Loop from a Do Until()..Loop to a Do .. Loop Until().

Refactoring

Public Sub Sort(collectionObject As Collection)
 If IsNull(collectionObject) Then
 Exit Sub
 End If
 Dim item As Variant
 Dim innerItem As Variant
 Dim i As Long
 Dim j As Long
 Dim index As Long
 Dim hasSwapped As Boolean
 Dim collectionCount As Long
 collectionCount = collectionObject.Count
 Do
 hasSwapped = False
 For i = 1 To collectionCount
 index = i
 If IsObject(collectionObject(i)) Then
 Set item = collectionObject(i)
 Else
 item = collectionObject(i)
 End If
 For j = i + 1 To collectionCount
 If IsObject(collectionObject(j)) Then
 Set innerItem = collectionObject(j)
 Else
 innerItem = collectionObject(j)
 End If
 If item > innerItem Then
 collectionObject.Add item, After:=j
 collectionObject.Remove index
 index = j
 hasSwapped = True
 End If
 Next j
 Next i
 Loop Until Not hasSwapped
End Sub