11
\$\begingroup\$

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
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?

\$\endgroup\$
2
  • \$\begingroup\$ Are you using VBPredeclaredId = True on both classes, or just the Type class? \$\endgroup\$
    – RubberDuck
    Sep 12, 2014 at 12:48
  • 1
    \$\begingroup\$ @RubberDuck just on the FractionType class :) \$\endgroup\$ Sep 12, 2014 at 13:08

1 Answer 1

3
\$\begingroup\$

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.

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

Your Answer

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

Not the answer you're looking for? Browse other questions tagged or ask your own question.