A recent question inspired me to implement a Fraction
class. I decided to write this one in vba, because I like writing tools for the poor souls that still have to deal with that language myself.
I really wanted to be able to create a Fraction
instance with a static-like syntax, so I created a FractionType
class with a VB_PredeclaredId
attribute value of True
- so I can write code like this:
Public Sub Test() Dim result As Fraction If FractionType.TryParse("34/178", result) Then Debug.Print result.ToString & " = " & result.ToDouble End If Set result = FractionType.Create(0, 0) Debug.Print result.ToString & " = default? " & result.Equals(FractionType.Default) End Sub
...well, if I wanted to output this:
17/39 = 0.435897435897436 0/0 = default? True
Because I have a List
class that can work with objects that implement IEquatable
and IComparable
interfaces in my toolkit, I can also use it like this:
Dim fractions As New List fractions.Add FractionType.Create(1,2), _ FractionType.Create(2,3), _ FractionType.Create(0,0), _ FractionType.Create(9,8), _ FractionType.Create(123,345), _ FractionType.Create(48,0), _ FractionType.Create(12,182) fractions.Sort Dim item As Fraction For Each item in fractions Debug.Print item.ToString, item.ToSingle Next
As it turns out, I'm especially interested in the CompareTo
implementation. I decided to split the functionality in two types:
FractionType class module
Private Const MinimumInt As Integer = -32768
Private Const MaximumInt As Integer = 32767
Option Explicit
Public Property Get Default() As Fraction
Static result As New Fraction
Set Default = result
End Property
Public Property Get Zero() As Fraction
Static result As New Fraction
result.Numerator = 0
result.Denominator = 1
Set Zero = result
End Property
Public Property Get One() As Fraction
Static result As New Fraction
result.Numerator = 1
result.Denominator = 1
Set One = result
End Property
Public Property Get MinValue() As Fraction
Static result As New Fraction
result.Numerator = MinimumInt
result.Denominator = 1
Set MinValue = result
End Property
Public Property Get MaxValue() As Fraction
Static result As New Fraction
result.Numerator = MaximumInt
result.Denominator = 1
Set MaxValue = result
End Property
Public Function Create(ByVal numeratorValue As Integer, ByVal denominatorValue As Integer) As Fraction
Dim result As New Fraction
result.Numerator = numeratorValue
result.Denominator = denominatorValue
Set Create = result.Simplify
End Function
Public Function Parse(ByVal value As String) As Fraction
Dim operatorIndex As Integer
operatorIndex = InStr(1, value, "/")
If operatorIndex <= 1 _
Or operatorIndex = Len(value) _
Then
RaiseInvalidFormatError value, "Parse"
End If
Dim numeratorPart As String
numeratorPart = Left(value, operatorIndex - 1)
Dim denominatorPart As String
denominatorPart = Right(value, operatorIndex - 1)
Set Parse = Create(CInt(numeratorPart), CInt(denominatorPart))
End Function
Public Function TryParse(ByVal value As String, ByRef outResult As Fraction) As Boolean
On Error GoTo CleanFail
Dim result As Boolean
Set outResult = Parse(value)
result = True
CleanExit:
TryParse = result
Exit Function
CleanFail:
result = False
Resume CleanExit
End Function
Private Sub RaiseInvalidFormatError(ByVal errorValue As String, ByVal errorSource As String)
Err.Raise vbObjectError + 44, errorSource, "Error: Invalid format. Value '" & errorValue & "' could not be parsed to a valid fraction."
End Sub
Public Function Simplify(ByVal value As Fraction) As Fraction
If value.IsUndefined Then
Set Simplify = value
Exit Function
End If
Dim gcd As Integer
gcd = GetGreatestCommonDivisor(value.Numerator, value.Denominator)
Dim result As New Fraction
result.Numerator = value.Numerator / gcd
result.Denominator = value.Denominator / gcd
Set Simplify = result
End Function
Private Function GetGreatestCommonDivisor(ByVal value1 As Integer, ByVal value2 As Integer) As Integer
Dim result As Integer
If value2 = 0 Then
result = value1
Else
result = GetGreatestCommonDivisor(value2, value1 Mod value2)
End If
GetGreatestCommonDivisor = result
End Function
Fraction class module
Option Explicit
Private Type TFraction
Numerator As Integer
Denominator As Integer
End Type
Private this As TFraction
Implements IEquatable
Implements IComparable
Public Property Get Numerator() As Integer
Numerator = this.Numerator
End Property
Public Property Let Numerator(ByVal value As Integer)
this.Numerator = value
End Property
Public Property Get Denominator() As Integer
Denominator = this.Denominator
End Property
Public Property Let Denominator(ByVal value As Integer)
this.Denominator = value
End Property
Public Property Get IsUndefined() As Boolean
IsUndefined = this.Denominator = 0
End Property
Public Property Get IsNaN() As Boolean
IsNaN = this.Denominator = 0 And this.Numerator = 0
End Property
Public Property Get IsPositiveInfinity() As Boolean
IsPositiveInfinity = IsUndefined And this.Numerator > 0
End Property
Public Property Get IsNegativeInfinity() As Boolean
IsNegativeInfinity = IsUndefined And this.Numerator < 0
End Property
Public Function Simplify() As Fraction
Set Simplify = FractionType.Simplify(Me)
End Function
Public Function ToString() As String
ToString = this.Numerator & "/" & this.Denominator
End Function
Public Function ToSingle() As Single
ToSingle = CSng(this.Numerator / this.Denominator)
End Function
Public Function ToDouble() As Double
ToDouble = CDbl(this.Numerator / this.Denominator)
End Function
Public Function Equals(ByVal other As Fraction) As Boolean
Dim simplifiedOther As Fraction
Set simplifiedOther = other.Simplify
Dim simplifiedMe As Fraction
Set simplifiedMe = Me.Simplify
Equals = simplifiedOther.Numerator = simplifiedMe.Numerator _
And simplifiedOther.Denominator = simplifiedMe.Denominator
End Function
Private Function IEquatable_Equals(ByVal other As Variant) As Boolean
IEquatable_Equals = Equals(other)
End Function
Public Function CompareTo(ByVal other As Fraction) As Integer
If Me.IsUndefined Or other.IsUndefined Then
CompareTo = 0
If Me.IsNaN And other.IsPositiveInfinity Then
CompareTo = 1
ElseIf Me.IsNaN And other.IsNegativeInfinity Then
CompareTo = -1
ElseIf other.IsNaN Then
If Me.IsPositiveInfinity Then
CompareTo = -1
ElseIf Me.IsNegativeInfinity Then
CompareTo = 1
End If
End If
Else
Dim otherValue As Double
otherValue = other.ToDouble
Dim myValue As Double
myValue = Me.ToDouble
If otherValue > myValue Then
CompareTo = 1
ElseIf otherValue < myValue Then
CompareTo = -1
Else
CompareTo = 0
End If
End If
End Function
Private Function IComparable_CompareTo(ByVal other As Variant) As Integer
IComparable_CompareTo = CompareTo(other)
End Function
I find the CompareTo
method sticks out like a sore thumb. Is it just me? How would I write this more elegantly?
Any issues I'm not seeing?
VBPredeclaredId = True
on both classes, or just the Type class? \$\endgroup\$FractionType
class :) \$\endgroup\$