# Yet Another Fraction

A recent question inspired me to implement a Fraction class. I decided to write this one in , 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
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?

• Are you using VBPredeclaredId = True on both classes, or just the Type class? Commented Sep 12, 2014 at 12:48
• @RubberDuck just on the FractionType class :) Commented Sep 12, 2014 at 13:08

First, let's talk about what I consider to be a bug in the fraction class. Running this code results in an Overflow error.

Public Sub bug()
Dim item As Fraction
Set item = FractionType.Create(0, 0)
Debug.Print item.ToDouble
End Sub


So let's look at what's going on in the ToDouble() function.

Public Function ToDouble() As Double
ToDouble = CDbl(this.Numerator / this.Denominator)
End Function


Okay, so we're diving zero by zero. It's no wonder why we're getting a runtime error. Also note that ToSingle suffers from this same issue. The least we can do is raise an error that sufficiently describes what actually went wrong, but I would carefully consider how you really want to handle this issue. It might make for a better API to just return zero, but raising this error is semantically correct. It's really a judgement call, but don't make the dev using your class dig into the code to figure out why their getting an overflow error.

Public Function ToDouble() As Double
If IsUndefined Then
RaiseUndefinedError
Else
ToDouble = CDbl(this.Numerator / this.Denominator)
End If
End Function

Private Sub RaiseUndefinedError()
' Raises Division by Zero Error instead of letting an overflow error happen.
Const DivByZeroError As Integer = 11
Err.Raise DivByZeroError, TypeName(Me), "Division by Zero is Undefined"
End Sub


While your Fraction.CompareTo function does not break my Single Screen Principle, I do see an opportunity to clarify it by breaking it down into a few distinct functions. Keep in mind that VB6's And operator does not short-circuit. This means that when checking to see if Me is not a number, the code will evaluate both calls every time. So, first, a quick refactor to resolve the slight inefficiency.

Public Function CompareTo(ByVal other As Fraction) As Integer

If Me.IsUndefined Or other.IsUndefined Then
CompareTo = 0

If Me.IsNaN Then
If other.IsPositiveInfinity Then
CompareTo = 1
ElseIf other.IsNegativeInfinity Then
CompareTo = -1
End If
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


But now we're verging on arrow code. There are two main parts to the CompareTo implementation, comparing undefined fractions and comparing defined fractions. Those sound like pretty good private function names to me.

Public Function CompareTo(ByVal other As Fraction) As Integer

If Me.IsUndefined Or other.IsUndefined Then
CompareTo = CompareUndefined(other)
Else
CompareTo = CompareDefined(other)
End If

End Function

Private Function CompareUndefined(ByVal other As Fraction) As Integer
CompareUndefined = 0

If Me.IsNaN Then
If other.IsPositiveInfinity Then
CompareUndefined = 1
ElseIf other.IsNegativeInfinity Then
CompareUndefined = -1
End If
ElseIf other.IsNaN Then
If Me.IsPositiveInfinity Then
CompareUndefined = -1
ElseIf Me.IsNegativeInfinity Then
CompareUndefined = 1
End If
End If

End Function

Private Function CompareDefined(ByVal other As Fraction) As Integer
Dim otherValue As Double
otherValue = other.ToDouble

Dim myValue As Double
myValue = Me.ToDouble

If otherValue > myValue Then
CompareDefined = 1

ElseIf otherValue < myValue Then
CompareDefined = -1

Else
CompareDefined = 0

End If
End Function


Now, you could repeat this process for CompareDefined, but it's not nested so badly now, and the function is pretty short and concise as is. You know what though, I'm not quite happy with it... I think this is a case for Iff(). It's shorter and undoes the nesting, but does sacrifice a little bit of "understandability" (as any ternary operator would).

Private Function CompareUndefined(ByVal other As Fraction) As Integer
CompareUndefined = 0

If Me.IsNaN Then
CompareUndefined = IIf(other.IsPositiveInfinity, 1, -1)
ElseIf other.IsNaN Then
CompareUndefined = Iff(Me.IsPositiveInfinity, -1, 1)
End If

End Function


There's not much else to say. You generally write very readable code, so I won't bother with any nitpicks about style.

• Consider using WorksheetFunction.Gcd(). Why re-invent the wheel? See stackoverflow.com/a/25745028/380384 Commented Sep 12, 2014 at 16:47
• @ja72 that would create a dependency on the Excel library, as it stands, I could import these classes into any VBA/VB6 program. Commented Sep 12, 2014 at 17:03
• Point taken.... Commented Sep 12, 2014 at 17:14