Preface
This is a follow up to my previous post from not long time ago about containers and filtering. This post can be found here. Now, I will attempt to expand what I have learnt from the answer given by Mathieu.
Context
Using implementation of IPredicate interface I was able to reduce number of line inside my class containers. That's great! But, I would like also to have:
- simple OR and AND logic for filters. Examples:
- OR (a = x OR a = y)
- AND (a = x AND b = y)
- mix of both, OR and AND logic inside a single object
- OR + AND (a = x OR (a = y AND b = z)
Model
Again, we will work on my simple model of a car which has only two properties.
Car
Option Explicit
Private pModel As String
Private pManufacturer As String
Public Property Get Model() As String
Model = pModel
End Property
Public Property Let Model(ByVal Value As String)
If Value = vbNullString Then
Error.ArgumentException vbNullString, vbNullString
End If
pModel = Value
End Property
Public Property Get Manufacturer() As String
Manufacturer = pManufacturer
End Property
Public Property Let Manufacturer(ByVal Value As String)
If Value = vbNullString Then
Error.ArgumentException vbNullString, vbNullString
End If
pManufacturer = Value
End Property
Error class which is static one. Contains list of custom errors with a like to use in my applications.
Error
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Error"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Sub ArgumentNullException(ByVal ParamName As String, ByVal Message As String)
Err.Raise 513, , "Value cannot be null." & vbNewLine & vbNewLine & _
"Additional information: " & Message & vbNewLine & vbNewLine & _
"Parameter: " & ParamName
End Sub
Public Sub ArgumentException(ByVal ParamName As String, ByVal Message As String)
Err.Raise 518, , "An exception of type ArgumentException was thrown." & vbNewLine & vbNewLine & _
"Additional information: " & Message & vbNewLine & vbNewLine & _
"Parameter: " & ParamName
End Sub
Implementation
First, let me introduce you to interfaces which I will use.
IPredicate
Option Explicit
' Method that defines a test and determines whether the Object meets this test.
Public Function IsTrue(ByVal Obj As Object, ByVal Value As Variant) As Boolean
End Function
IPredicateClause
Option Explicit
' This interface will help us to group predicates into a logic group, OR and AND.
Public Function IsTrue(ByRef Item As Object) As Boolean
End Function
Public Sub Add(ByRef Predicate As IPredicate, ByVal Value As Variant)
End Sub
IPredicatesCollection
Option Explicit
' Defines list of methods which each collection of predicates must have
' in order to handle multiple predicates.
Public Function IsTrue(ByRef Item As Object) As Boolean
End Function
Public Sub Add(ByRef Item As IPredicate, ByVal Value As Variant)
End Sub
Public Sub AddClause(ByRef Item As IPredicateClause)
End Sub
Two, simple predicates which I will use for the purpose of this code review. Both implements IPredicate interface.
ManufacturerPredicate
Option Explicit
Implements IPredicate
Private Function IPredicate_IsTrue(ByVal Obj As Object, ByVal Value As Variant) As Boolean
IPredicate_IsTrue = (Obj.Manufacturer = Value)
End Function
ModelPredicate
Option Explicit
Implements IPredicate
Private Function IPredicate_IsTrue(ByVal Obj As Object, ByVal Value As Variant) As Boolean
IPredicate_IsTrue = (Obj.Model = Value)
End Function
I do not check if Obj is Car here because, without that assertion, I can reuse this predicate for all objects which have property called Model.
And there are two classes which implements IPredicateClause interface:
AndPredicate
Option Explicit
Implements IPredicateClause
Private pDic As New Dictionary
Public Function IsTrue(ByRef Item As Object) As Boolean
IPredicateClause_IsTrue Item
End Function
' Evaluates whole term.
' If atleast one predicate returns false, the whole term is false.
Private Function IPredicateClause_IsTrue(ByRef Item As Object) As Boolean
Dim Pred As Variant
For Each Pred In pDic.Keys
If Not Pred.IsTrue(Item, pDic(Pred)) Then
IPredicateClause_IsTrue = False
Exit Function
End If
Next Pred
IPredicateClause_IsTrue = True
End Function
' Adds a predicate into the term.
Public Sub Add(ByRef Predicate As IPredicate, ByVal Value As Variant)
IPredicateClause_Add Predicate, Value
End Sub
Private Sub IPredicateClause_Add(ByRef Predicate As IPredicate, ByVal Value As Variant)
pDic(Predicate) = Value
End Sub
OrPredicate
Option Explicit
Implements IPredicateClause
Private pDic As New Dictionary
Public Function IsTrue(ByRef Item As Object) As Boolean
IPredicateClause_IsTrue Item
End Function
' Evaluates whole term.
' If, atleast one predicate returns true, then whole term is true.
Private Function IPredicateClause_IsTrue(ByRef Item As Object) As Boolean
Dim Pred As Variant
For Each Pred In pDic.Keys
If Pred.IsTrue(Item, pDic(Pred)) Then
IPredicateClause_IsTrue = True
Exit Function
End If
Next Pred
IPredicateClause_IsTrue = False
End Function
' Adds a predicate into the term.
Public Sub Add(ByRef Predicate As IPredicate, ByVal Value As Variant)
IPredicateClause_Add Predicate, Value
End Sub
Private Sub IPredicateClause_Add(ByRef Predicate As IPredicate, ByVal Value As Variant)
pDic(Predicate) = Value
End Sub
This class stores all predicates and terms inside a single collection.
Predicates
Option Explicit
Implements IPredicatesCollection
Private pContent As New Collection
Public Sub Add(ByRef Item As IPredicate, ByVal Value As Variant)
IPredicatesCollection_Add Item, Value
End Sub
Private Sub IPredicatesCollection_Add(ByRef Item As IPredicate, ByVal Value As Variant)
Dim Prd As New OrPredicates
Prd.Add Item, Value
pContent.Add Prd
Set Prd = Nothing
End Sub
Public Sub AddClause(ByRef Item As IPredicateClause)
IPredicatesCollection_AddClause Item
End Sub
Private Sub IPredicatesCollection_AddClause(ByRef Item As IPredicateClause)
pContent.Add Item
End Sub
Public Function IsTrue(ByRef Item As Object) As Boolean
IPredicatesCollection_IsTrue Item
End Function
Private Function IPredicatesCollection_IsTrue(ByRef Item As Object) As Boolean
Dim Term As IPredicateClause
For Each Term In pContent
If Term.IsTrue(Item) Then
IPredicatesCollection_IsTrue = True
GoTo ExitFunction
End If
Next Term
IPredicatesCollection_IsTrue = False
ExitFunction:
Set Term = Nothing
End Function
And finally, implementation of the custom car collection.
Cars
Option Explicit
Private pContent As New Collection
Public Sub Add(ByRef Item As Car)
pContent.Add Item
End Sub
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
Set NewEnum = pContent.[_NewEnum]
End Property
Public Function FilterBy(ByRef Predicates As IPredicatesCollection) As Cars
Dim Item As Car
Dim Output As New Cars
For Each Item In pContent
If Predicates.IsTrue(Item) Then
Output.Add Item
End If
Next Item
Set FilterBy = Output
Set Output = Nothing
Set Item = Nothing
End Function
Factory helper module
Factory
Public Function CreateCar(ByVal Manufacturer As String, ByVal Model As String) As Car
Set CreateCar = New Car
With CreateCar
CreateCar.Manufacturer = Manufacturer
CreateCar.Model = Model
End With
End Function
Test cases
Option Explicit
' x = "Nissan"
' Where Manufacturer = x
' Expected output:
' Manufacturer: Nissan, Model: Z350
Public Sub FilterBySinglePredicate()
Dim Filter As New Predicates
Filter.Add New ManufacturerPredicate, "Nissan"
PrintCars GetCars.FilterBy(Filter)
Set Filter = Nothing
End Sub
' x = "Nissan"
' y = "Toyota"
' Where Manufacturer = x or Manufacturer = y
' Expected output:
' Manufacturer: Toyota, Model: Supra
' Manufacturer: Toyota , Model: Yaris
' Manufacturer: Nissan , Model: Z350
Public Sub FilterByTwoPredicatesUsingOrPredicate()
Dim Filter As New Predicates
Dim OrFilter As New OrPredicates
OrFilter.Add New ManufacturerPredicate, "Nissan"
OrFilter.Add New ManufacturerPredicate, "Toyota"
Filter.AddClause OrFilter
PrintCars GetCars.FilterBy(Filter)
Set Filter = Nothing
Set OrFilter = Nothing
End Sub
' x = "Yaris"
' y = "Toyota"
' Where model = x and manufacturer = y
' Exptected output:
' Manufacturer: Toyota, Model: Yaris
Public Sub FilterByTwoPredicatesUsingAndPredicate()
Dim AndFilter As New AndPredicates
AndFilter.Add New ManufacturerPredicate, "Toyota"
AndFilter.Add New ModelPredicate, "Yaris"
Dim Filter As New Predicates
Filter.AddClause AndFilter
PrintCars GetCars.FilterBy(Filter)
Set Filter = Nothing
Set AndFilter = Nothing
End Sub
' x = "Z350"
' y = "Yaris"
' z = "Toyota"
' Where model = x or (model = y and manufacturer = z)
' Expected outupt:
' Manufacturer: Toyota, Model: Yaris
' Manufacturer: Nissan , Model: Z350
Public Sub FilterByThreePredicatesUsingOrAndPredicate()
Dim AndFilter As New AndPredicates
AndFilter.Add New ManufacturerPredicate, "Toyota"
AndFilter.Add New ModelPredicate, "Yaris"
Dim Filter As New Predicates
Filter.AddClause AndFilter
Filter.Add New ModelPredicate, "Z350"
PrintCars GetCars.FilterBy(Filter)
Set Filter = Nothing
Set AndFilter = Nothing
End Sub
Private Function GetCars() As Cars
Dim Output As New Cars
With Output
.Add Factory.CreateCar("Toyota", "Supra")
.Add Factory.CreateCar("Toyota", "Yaris")
.Add Factory.CreateCar("Nissan", "Z350")
.Add Factory.CreateCar("Subaru", "Impreza")
.Add Factory.CreateCar("Opel", "Astra")
End With
Set GetCars = Output
Set Output = Nothing
End Function
' Passing parameter ByRef to this function causes whole excel appliaction to crash ;(.
Private Sub PrintCars(ByVal Crs As Cars)
Dim Cr As Car
For Each Cr In Crs
Debug.Print "Manufacturer: " & Cr.Manufacturer & ", Model: " & Cr.Model
Next Cr
Set Cr = Nothing
End Sub
Conclusion
How would you handle situation were property Model does not exists in an object ModelPredicate.IPredicate_IsTrue(ByVal Obj As Object, ByVal Value As Variant) As Boolean? I would love to hear your toughs on this topic :)
