1
\$\begingroup\$

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 :)

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.