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.