15
\$\begingroup\$

I thought this question made a good excuse for some basic OOP code, so I whipped up a little bit of code to demonstrate it in VBA; the idea is to have tutorial-grade code, to show how interfaces and default instances can be used to implement immutable types and factory methods to simulate constructors in VBA.

Here's the original problem statement:

A hotel chain operating in Goa wishes to offer room reservation services. They have three hotels in Goa: GreenValley, RedRiver and BlueHills. Each hotel has separate weekday and weekend (Saturday and Sunday) rates. There are special rates for rewards customer as a part of loyalty program. Each hotel has a rating assigned to it.

  • GreenValley with a rating of 3 has weekday rates as Rs1100 for regular customer and Rs800 for rewards customer. The weekend rates are 900 for regular customer and 800 for a rewards customer.
  • RedRiver with a rating of 4 has weekday rates as Rs1600 for regular customer and Rs1100 for rewards customer. The weekend rates are 600 for regular customer and 500 for a rewards customer.
  • BlueHills with a rating of 5 has weekday rates as Rs2200 for regular customer and Rs1000 for rewards customer. The weekend rates are 1500 for regular customer and 400 for a rewards customer.

The input to the program will be a range of dates for a regular or rewards customer. The output should be the cheapest available hotel. In case of a tie, the hotel with highest rating should be returned.

I have this code in Module1:

Option Explicit

Public Sub Test(ByVal checkin As Date, ByVal checkout As Date, ByVal custType As CustomerType)
    Dim finder As New HotelFinder
    InitializeHotels finder
    Debug.Print finder.FindCheapestHotel(checkin, checkout, custType)
End Sub

Private Sub InitializeHotels(ByVal finder As HotelFinder)

    With StandardHotel.Create("Green Valley", 3)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Premium), 800)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkEnd, Premium), 800)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Regular), 1100)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkEnd, Regular), 900)
        finder.Hotels.Add .Self
    End With

    With StandardHotel.Create("Red River", 4)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Premium), 1100)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkEnd, Premium), 500)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Regular), 1600)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkEnd, Regular), 600)
        finder.Hotels.Add .Self
    End With

    With StandardHotel.Create("Blue Hills", 5)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Premium), 1000)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkEnd, Premium), 400)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Regular), 2200)
        .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkEnd, Regular), 1500)
        finder.Hotels.Add .Self
    End With

End Sub

I can test it in the immediate pane like this, and get the following output:

Test Now, Now + 3, Premium
Green Valley $3,200.00
Red River $4,400.00
Blue Hills $4,000.00
Green Valley

I needed a type to encapsulate the variables that can influence a hotel's pricing. And because I want these values to be immutable, I exposed getters for them in this IPricingRuleInfo interface:

Option Explicit

Public Enum CustomerType
    Regular
    Premium
End Enum

Public Enum DateType
    WkDay
    WkEnd
End Enum

Public Property Get DateType() As DateType
End Property

Public Property Get CustomerType() As CustomerType
End Property

Public Function ToString() As String
End Function

The class that implements it has a VB_PredeclaredId attribute set to True, which makes a PricingRuleInfo object variable available to use the Create factory method. I added a Self getter that returns Me, so that I could use a neat With New syntax in the Create method:

Option Explicit

Private Type TInfo
    DateType As DateType
    CustomerType As CustomerType
End Type
Private this As TInfo

Implements IPricingRuleInfo

Public Property Get CustomerType() As CustomerType
    CustomerType = this.CustomerType
End Property

Public Property Let CustomerType(ByVal value As CustomerType)
    this.CustomerType = value
End Property

Public Property Get DateType() As DateType
    DateType = this.DateType
End Property

Public Property Let DateType(ByVal value As DateType)
    this.DateType = value
End Property

Public Property Get Self() As IPricingRuleInfo
    Set Self = Me
End Property

Public Function Create(ByVal dtType As DateType, ByVal custType As CustomerType) As IPricingRuleInfo
    With New PricingRuleInfo
        .DateType = dtType
        .CustomerType = custType
        Set Create = .Self
    End With
End Function

Private Property Get IPricingRuleInfo_CustomerType() As CustomerType
    IPricingRuleInfo_CustomerType = this.CustomerType
End Property

Private Property Get IPricingRuleInfo_DateType() As DateType
    IPricingRuleInfo_DateType = this.DateType
End Property

Private Function IPricingRuleInfo_ToString() As String
    IPricingRuleInfo_ToString = CStr(this.CustomerType) & ";" & CStr(this.DateType)
End Function

The IPricingRule interface exposes an Evaluate method that takes an IPricingRuleInfo object, so an IPricingRule implementation could evaluate a price based on parameters, or whatever is applicable, really:

Option Explicit

Public Property Get RuleInfo() As IPricingRuleInfo
End Property

Public Function Evaluate(Optional ByVal info As IPricingRuleInfo = Nothing) As Currency
End Function

To solve the original problem all I needed was a FixedAmountPricingRule, which returns a predetermined amount regardless of what parameter is passed to Evaluate - again this class has a VB_PredeclaredId attribute value set to True, and exposes a factory method:

Option Explicit

Private Type TRule
    RuleInfo As IPricingRuleInfo
    Amount As Currency
End Type
Private this As TRule

Implements IPricingRule

Private Property Get IPricingRule_RuleInfo() As IPricingRuleInfo
    Set IPricingRule_RuleInfo = this.RuleInfo
End Property

Private Function IPricingRule_Evaluate(Optional ByVal info As IPricingRuleInfo = Nothing) As Currency
    IPricingRule_Evaluate = this.Amount
End Function

Public Property Get RuleInfo() As IPricingRuleInfo
    Set RuleInfo = this.RuleInfo
End Property

Public Property Set RuleInfo(ByVal value As IPricingRuleInfo)
    Set this.RuleInfo = value
End Property

Public Property Get Amount() As Currency
    Amount = this.Amount
End Property

Public Property Let Amount(ByVal value As Currency)
    this.Amount = value
End Property

Public Property Get Self() As IPricingRule
    Set Self = Me
End Property

Public Function Create(ByVal info As IPricingRuleInfo, ByVal value As Currency) As IPricingRule
    With New FixedAmountPricingRule
        Set .RuleInfo = info
        .Amount = value
        Set Create = .Self
    End With
End Function

Next, the IHotel interface, which can map a Date to a DateType value, and calculate a price given an IPricingRuleInfo parameter; of course the interface also exposes the establishment's Name and Rating:

Option Explicit

Public Property Get Name() As String
End Property

Public Property Get Rating() As Byte
End Property

Public Function CalculatePricing(ByVal info As IPricingRuleInfo) As Currency
End Function

Public Function GetDateType(ByVal value As Date) As DateType
End Function

The StandardHotel class that implements this interface has a VB_PredeclaredId attribute set to True, and exposes a Create factory method and an AddPricingRule method to set up the hotel's pricing rules; because I wanted a way to ensure no two IPricingRuleInfo would collide and make the pricing potentially ambiguous, I decided to use a Scripting.Dictionary and used IPricingRuleInfo.ToString as a key. The GetDateType for a StandardHotel merely determines if a date is a WkDay or a WkEnd date - in time other implementations could return a Holiday value given date X or Y, but I didn't need to go there for now:

Option Explicit

Private Type THotel
    PricingRules As New Scripting.Dictionary
    Name As String
    Rating As Byte
End Type
Private this As THotel
Implements IHotel

Public Property Get Name() As String
    Name = this.Name
End Property

Public Property Let Name(ByVal value As String)
    this.Name = value
End Property

Public Property Get Rating() As Byte
    Rating = this.Rating
End Property

Public Property Let Rating(ByVal value As Byte)
    this.Rating = value
End Property

Public Property Get Self() As IHotel
    Set Self = Me
End Property

Public Function Create(ByVal hotelName As String, ByVal stars As Byte, Optional ByVal rules As Collection = Nothing) As StandardHotel

    Dim rule As IPricingRule
    With New StandardHotel

        .Name = hotelName
        .Rating = stars

        If Not rules Is Nothing Then
            For Each rule In rules
                .AddPricingRule rule
            Next
        End If

        Set Create = .Self

    End With

End Function

Public Sub AddPricingRule(ByVal rule As IPricingRule)
    this.PricingRules.Add rule.RuleInfo.ToString, rule
End Sub

Private Function IHotel_CalculatePricing(ByVal info As IPricingRuleInfo) As Currency
    Dim rule As IPricingRule
    Set rule = this.PricingRules(info.ToString)
    IHotel_CalculatePricing = rule.Evaluate(info)
End Function

Private Function IHotel_GetDateType(ByVal value As Date) As DateType
    IHotel_GetDateType = IIf(Weekday(value, vbMonday) <= 5, WkDay, WkEnd)
End Function

Private Property Get IHotel_Name() As String
    IHotel_Name = this.Name
End Property

Private Property Get IHotel_Rating() As Byte
    IHotel_Rating = this.Rating
End Property

Finally, the HotelFinder class implements the logic that iterates all hotels and finds the cheapest one:

Option Explicit

Private Type TFinder
    Hotels As Collection
End Type
Private this As TFinder

Public Property Get Hotels() As Collection
    Set Hotels = this.Hotels
End Property

Public Function FindCheapestHotel(ByVal fromDate As Date, ByVal toDate As Date, ByVal custType As CustomerType) As String

    Dim place As IHotel
    Dim checkedDate As Date

    Dim cheapestAmount As Currency
    Dim cheapestHotel As IHotel

    Dim hotelTotal As Currency
    For Each place In this.Hotels

        hotelTotal = 0
        For checkedDate = fromDate To toDate
            Dim info As IPricingRuleInfo
            Set info = PricingRuleInfo.Create(place.GetDateType(checkedDate), custType)
            hotelTotal = hotelTotal + place.CalculatePricing(info)
        Next

        If cheapestAmount = 0 Or hotelTotal < cheapestAmount Then
            cheapestAmount = hotelTotal
            Set cheapestHotel = place
        ElseIf hotelTotal = cheapestAmount And cheapestHotel.Rating > place.Rating Then
            'same price, but higher rating; higher rating gets precedence
            Set cheapestHotel = place
        End If

        Debug.Print place.Name, Format(hotelTotal, "$#,##0.00")
    Next

    FindCheapestHotel = cheapestHotel.Name

End Function

Private Sub Class_Initialize()
    Set this.Hotels = New Collection
End Sub

Private Sub Class_Terminate()
    Set this.Hotels = Nothing
End Sub

The Hotels collection is initialized in the InitializeHotels private procedure in Module1, so the code at the top of the call stack has a pretty high level of abstraction.

\$\endgroup\$
0

2 Answers 2

4
\$\begingroup\$

I was not aware of the VB_PredeclaredId attribute and it's impact on VBA classes, so I've definitely learned something from your example. But I had to research it a bit in order to understand it. So, a few comments:

Your example is very good in terms of its ability to demonstrate the application of interfaces and default instances, especially in terms of VBA. What's less apparent here is the "teaching" aspects of your code -- this can easily be explained away here because this forum focuses only on code aspects and not (in your case) the supporting tutorial or explanations surrounding it. As an example, I think many (most?) VBA developers haven't run into the VB_PredeclaredId attribute and how to use it and even why it would be important in this context. (You have to understand the limitations of VBA classes and objects first, to know why it's applicable.)

My point is that while this is a very good example of reasonably standard OOP implementations in many languages, it seems specifically targeted at either a) experienced OOP devs proficient in other languages that have more direct language support for interfaces, implementations, and instancing; or b) advanced VBA devs that can learn how to implement factories using VBA. To use this code as a tutorial, you'll have to be mindful of the audience.

I started out in OOP with C++ and Ada (old skool!), so the concepts you're bringing out are very familiar. I like implementing a this type that mimics object accessors and using patterns like factories (particularly the hack to use with New syntax.

My comments are based on your opening line in the OP for "basic OOP code", which is largely true for other languages but I believe it's more of an advanced usage in VBA. Thanks for good things to learn!

\$\endgroup\$
5
  • \$\begingroup\$ Thanks for your feedback, you're right about the audience aspect, that's making me second-guess the article I published on Rubberduck News... other than that, is anything out of place, hard to read, or otherwise sub-optimal? \$\endgroup\$ Commented Jul 6, 2016 at 18:04
  • \$\begingroup\$ As I said, I think it's a good (semi-)advanced example. The memories it brings back remind me that most of the OOP examples/tutorials I've encountered always seem to go through so very many steps with layers of abstraction in order to make the "main" program intuitive and object-y. Sometimes lengthy examples can lose the main point of the exercise. But again, consider the target audience. I learned several things from your code so from my perspective it worked. Though I liked the this implementation, I think it's a level of indirection that's not needed here though. \$\endgroup\$
    – PeterT
    Commented Jul 6, 2016 at 18:14
  • 1
    \$\begingroup\$ The this private field (and the Private Type TSomething) is helpful for naming: naming is hard, but naming in a case-sensitive language is even harder. If there's a Private Foo As String private field, then there can't be a Public Property Get Foo() As String member - the this field avoids having to introduce funky prefixes to field identifiers, and, if that's ever needed, makes binary serialization of an instance's state easy as pie. But I mostly use it for the naming consistency it enables. \$\endgroup\$ Commented Jul 6, 2016 at 18:24
  • \$\begingroup\$ You make a good point about the naming. I've encountered exactly that issue when trying to come up with class-internal names with public accessors (can you say Public Property Get GetFoo() as String?). Your workaround with this is one I'll seriously <s>try to remember</s> consider. Thanks! \$\endgroup\$
    – PeterT
    Commented Jul 6, 2016 at 18:34
  • \$\begingroup\$ You could do Property Get GetFoo() As String, but then you'd need a Property Let GetFoo(ByVal value As String) for VBA to consider the mutator as an accessor to the same property as the getter. Or you have Property Let LetFoo(ByVal value As String) and that leaves you with a read-only GetFoo and a write-only LetFoo (and bleh, "LetFoo" just doesn't look right!) \$\endgroup\$ Commented Jul 6, 2016 at 18:35
2
\$\begingroup\$

First, I love this example - I've gone over it (and many others) several times. In the context of this goal:

the idea is to have tutorial-grade code

I don't have any formal programming qualification and other than VBA have no programming experience, so I guess that makes me somewhat qualified to comment here ;-)

From a (slow) learners perspective:

1 - Something that tripped me up in Module1:


Edit:

I was completely mistaken with this comment. MatsMug set me straight in the comments. There is a technical reason for using:

With StandardHotel.Create("Green Valley", 3)

This syntax sets the scope of the With block to the object reference returned by StandardHotel.Create("Green Valley", 3).

The following is plain wrong, leaving it as an (unwitting) MCVE


With StandardHotel.Create("Green Valley", 3)
    .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Premium), 800)
    ' ...
End With

Things became much easier for me to understand when I realized that I could write it like this instead:

With StandardHotel
    .Create "Green Valley", 3
    .AddPricingRule FixedAmountPricingRule.Create(PricingRuleInfo.Create(WkDay, Premium), 800)
    ' ...
End With

2 - It would be helpful to include a comment in each block of code with the name of the module / class, e.g. this:

Next, the IHotel interface, which can map a Date to a DateType value, and calculate a price given an IPricingRuleInfo parameter; of course the interface also exposes the establishment's Name and Rating:

Option Explicit

Public Property Get Name() As String
End Property

Public Property Get Rating() As Byte
End Property

Could be easier to follow put into a project with a comment like this:

Option Explicit
' Name of this class: IHotel
Public Property Get Name() As String
End Property

Public Property Get Rating() As Byte
End Property

In some areas there is wording like:

The class that implements it has a VB_PredeclaredId attribute set to True, which

which I am sure would be generally easier to understand if written using PricingRuleInfo instead of it.

3 - There is something that I still can't figure out... in the class StandardHotel, this code never runs.

    If Not rules Is Nothing Then
        For Each rule In rules
            .AddPricingRule rule
        Next
    End If

I tried to pass the rules as a parameter, but failed. Create is expecting the rules as a collection, but I can't find any way to add these rules to a collection with the available code. I might be wrong, as far as I can tell, there is no collection available for this.

The closest thing I could find was a Scripting Dictionary:

Private Type THotel
    PricingRules As New Scripting.Dictionary
    Name As String
    Rating As Byte
End Type

It'd be really nice to see how a collection could be passed as a parameter, or perhaps see that block of code removed as it seems to be a remnant of a past approach.


Edit:

This code can be used to demonstrate passing some pricing rules as a parameter:

Dim pricingRules As Project.FixedAmountPricingRule
Set pricingRules = New Project.FixedAmountPricingRule
Dim oC As Collection
Set oC = New Collection
oC.Add pricingRules.Create(PricingRuleInfo.Create(WkDay, Premium), 1100)
oC.Add pricingRules.Create(PricingRuleInfo.Create(WkEnd, Premium), 500)
oC.Add pricingRules.Create(PricingRuleInfo.Create(WkDay, Regular), 1600)
oC.Add pricingRules.Create(PricingRuleInfo.Create(WkEnd, Regular), 600)

With StandardHotel.Create("Red River", 4, oC)
    finder.Hotels.Add .Self
End With

That said, thanks again - this is a great tutorial.

\$\endgroup\$
10
  • \$\begingroup\$ RE point1: that's discarding the Create function's return value (i.e. the call is redundant/useless), and adds the pricing rules to the default instance, storing state in global scope - which is the exact opposite of what I'm trying to achieve here... and that's why #3 happens: the instance state you're looking for, you've stored in the default instance instead. The Create method is a function that returns an instance of the class it's a member of, i.e. StandardHotel.Create returns a StandardHotel instance. You've made a MCVE of what goes wrong with global state & default instances =) \$\endgroup\$ Commented Feb 20, 2018 at 4:18
  • \$\begingroup\$ AddPricingRule is responsible for adding the pricing rules. \$\endgroup\$ Commented Feb 20, 2018 at 4:21
  • \$\begingroup\$ Yikes! Thanks for your comments, I'll have another look at it. Re #1 I was finding it difficult to understand the flow of the code, I thought because it was all in a With block it would look after itself... So if I now understand correctly, the notation With StandardHotel.Create(something) creates a Hotel AND the pricing rule is added to THAT hotel... I'm almost ashamed to admit that I was looking for something like: StandardHotel.Create.AddPricingRule among all the interfaces and implementations... \$\endgroup\$ Commented Feb 20, 2018 at 4:33
  • \$\begingroup\$ With SomeFunction(args) captures the function's returned object reference, so the With block is scoped to that object. That Create function is meant to be invoked off the default instance as a convenience - it could just as well be a public/global function in some standard module, whose role is to create a StandardHotel. Such a function is a factory method, and the reason you would use this creational pattern is when you want to initialize/*construct* an object, using whatever parameters you want. \$\endgroup\$ Commented Feb 20, 2018 at 4:40
  • \$\begingroup\$ @Mat'sMug actually, that block of code in #3 still does not get executed. I have since added some code that does demonstrate passing rules by parameter so that it does run; will edit my post with that (and in light of your comments). \$\endgroup\$ Commented Feb 20, 2018 at 4:41

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.