Sort a group of Classes by default property

问题:

TL;DR:

Is there any way to pass a class collection/list to a library sorting algorithm, and get it to return a sorted list (preferably by a named/default class property)?

I've recently been learning some Python, and was impressed by the Sorted() function, which can sort any iterable. For numbers this is straightforward, for classes however, it is possible to assign a comparison method like this. The method tells comparison operators how to compare 2 instances of the class. Amongst other things it allows you to use builtin sorting algorithms to sort a collection of the class.

In VBA I've been half successful in mimicking this. By setting a class' default member Attribute, you can use comparison operators (<,=,>=, etc.) on classes directly. Take the example class:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "defaultProp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private randVal As Single

Public Property Get DefaultValue() As Single
    Attribute Value.VB_UserMemId = 0
    DefaultValue = randVal
End Property

Private Property Let DefaultValue(ByVal value As Single)
    randVal = value
End Property

Private Sub Class_Initialize()
    DefaultValue = Rnd()
End Sub

Two instances of this class can be compared:

 Dim instance1 As New defaultProp
 Dim instance2 As New defaultProp
 Debug.Print instance1.DefaultValue > instance2.DefaultValue
 Debug.Print instance1 > instance2 'exactly equivalent, as the DefaultValue has the correct Attribute

And if I was implementing a VBA sort algorithm that can sort values, there should be no problem sorting classes by default value*. However I would prefer to use a builtin/library sorting algorithm (for the same reasons anyone would; clarity, efficiency, proper error handling etc.)

_{*One of these algorithms would work for that, although must be modified to switch the entire class round, not the value of it (by adding Sets)}

Since VBA comparison operators have no issue, I assumed the same would be true for whatever the library was using. However when I tried with an ArrayList:

Sub testArrayList()
    Dim arr As Object
    Set arr = CreateObject("System.Collections.ArrayList")

    ' Initialise the ArrayList, for instance by generating random values
    Dim i As Long
    Dim v As defaultProp

    For i = 1 To 5
        Set v = New defaultProp
        arr.Add v 'no problem here
    Next i
    arr.Sort 'raises an error
End Sub

I get an error

Failed to compare two elements in the array

So what's going on? Is it a flaw in my approach - is the default attribute not making it to the ArrayList? Or maybe the comparison operator in whatever language the library is written in is not as floopy-gloopy as the ones VBA and Python use? Any suggestions on more builtin sorting algorithms to try would be useful too!

回答1:

It's not about the VBA comparison operators, ArrayList is a .NET class, so you're in the .NET world when you use it.

arr.Add v 'no problem here

You're adding instances of the defaultProp class; it doesn't matter that you have a default property on the type, .NET doesn't care about default properties. If you want to sort DefaultValue values, then do arr.Add v.DefaultValue or arr.Add (v) - then your ArrayList will contain items of type Single, which it knows how to sort.

In order for ArrayList.Sort to work with instances of your custom class, its items need to implement the IComparable interface, which is the case for System.Int32 (i.e. Long in VBA), System.String and every other primitive .NET types, and I think the VBA primitive types would indeed marshal correctly through .NET interop - but not custom classes.

Try adding a reference to mscorlib.tlb, and then in the defaultProp class module, specify this (you can't implement an interface that's defined in a late-bound library):

Implements IComparable

Then implement the interface - should look something like this (use the codepane dropdowns to make sure to get the correct signature - don't just copy-paste this snippet:

Private Function IComparable_CompareTo(ByVal obj As Variant) As Long
    Dim other As defaultProp
    Set other = obj
    ' return Less than zero (-1) if this object 
    ' is less than the object specified by the CompareTo method.

    ' return Zero (0) if this object is equal to the object 
    ' specified by the CompareTo method.

    ' return Greater than zero (1) if this object is greater than 
    ' the object specified by the CompareTo method.
End Function

Now that your custom class implements the interface ArrayList.Sort uses to determine how your defaultProp items relate to each other, I don't see a reason for it to fail.

回答2:

IMO, you are abusing things by mixing things cross the boundaries. You're using VBA's default properties (something I generally perceive as a bad practice), then you're using .NET's ArrayList and trying to Sort it.

I think it would be much more logical to see if you can implement IComparable on the VBA class and then let the ArrayList use the IComparable interface to compare an object against other by however you want it to compare, without using any default properties hacked.

回答3:

If you add the DefaultValue to the arr it would work:

Sub testArrayList()
    '... code
    For i = 1 To 5
        Set v = New defaultProp
        arr.Add v.DefaultValue 
    Next i
    arr.Sort         
End Sub

Obviously the implementation of .Sort of ArrayList is a bit strange and does not like comparing objects and their default values (could not find the implementation of the Sort() method). Although, this would work flawlessly:

For i = 1 To 5
    Set v = New defaultProp
    arr.Add v
Next i    
Debug.Print arr(1) > arr(2)

This is a possible implementation of sorting, that would work for the arr object as expected. However, it is not part of the ArrayList library:

Public Function varBubbleSort(varTempArray As Object) As Object

    Dim varTemp                 As Object
    Dim lngCounter              As Long
    Dim blnNoExchanges          As Boolean

    Do
        blnNoExchanges = True
        For lngCounter = 0 To varTempArray.Count - 2
            If varTempArray(lngCounter) > varTempArray(lngCounter + 1) Then
                blnNoExchanges = False
                Set varTemp = varTempArray(lngCounter)
                varTempArray(lngCounter) = varTempArray(lngCounter + 1)
                varTempArray(lngCounter + 1) = varTemp
            End If
        Next lngCounter

    Loop While Not (blnNoExchanges)
    Set varBubbleSort = varTempArray

   On Error GoTo 0
   Exit Function

End Function

But the sorting is ok: