Yet Another Fraction

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(

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.

StackExchange Code Review Q#62709, answer score: 3