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.

asked Jul 4, 2016 at 22:29
\$\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!

answered Jul 6, 2016 at 16:50
\$\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\$ 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\$ 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.

answered Feb 20, 2018 at 4:09
\$\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

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.