Home All Groups Group Topic Archive Search About

Convert decimal to fraction string

Author
1 Mar 2007 11:38 PM
MP
This is probably an idiotic way to get there...
but since I love public humiliation so much <g> here goes my stab at it ....

given a decimal value I want to get a string representation of it's
fractional equivalent
99% of the time I'll be working with "architectural" units eg 1/16, 3/32,
7/64, 3 3/16,  etc so my testing below was rather limited

Rick will probably have a one-liner for this or someone will point out a
built in vb function<g>

in any case, observations, corrections appreciated

seems to work in the limited testing shown below....

Function DecimalToFraction(InDecimal As Double, Optional Tolerance As Double
= 0.00390625, Optional RoundError As Double = 0) As String
'default limit to 1/256 tolerance

  If InDecimal > 1 Then'get whole number part
      Dim DecStr As String
      DecStr = CStr(InDecimal)

      Dim lDec As Long
      lDec = InStr(1, DecStr, ".")

      If lDec > 0 Then
          Dim WholeNum As String
          WholeNum = Left$(DecStr, lDec - 1)
        Else
          WholeNum = InDecimal
          GoTo ExitHere
      End If

      Dim dDecimal As Double
      dDecimal = CDbl(Right$(DecStr, Len(DecStr) - (lDec - 1)))

    Else
      dDecimal = InDecimal
  End If

  If dDecimal < Tolerance Then
      RoundError = dDecimal
      dDecimal = 0
    Else
      RoundError = 0
  End If

  If dDecimal = 0 Then
    If Len(WholeNum) = 0 Then
     WholeNum = "0"
    End If
    GoTo ExitHere
  End If

Dim Numerator As Double
  Dim Denominator As Double
  Numerator = 1
CheckNumerator:
  Denominator = Numerator / dDecimal
  Dim Fraction As String

  If Denominator = Numerator Then
        WholeNum = "1"
        GoTo ExitHere
    Else
     If Denominator = Fix(Denominator) Then
        Fraction = CStr(Numerator) & "/" & CStr(Denominator)
      Else
        Numerator = Numerator + 2
        GoTo CheckNumerator
      End If
  End If

ExitHere:
  If Len(WholeNum) > 0 Then
    If Len(Fraction) > 0 Then
        DecimalToFraction = WholeNum & " " & Fraction
      Else
        DecimalToFraction = WholeNum
    End If
  Else
    If Len(Fraction) > 0 Then
      DecimalToFraction = Fraction
    End If
  End If
End Function

Sub testDec()
Dim dFrac As Double
Dim dInc As Double

dInc = 0.015625
While dFrac < 3
  Debug.Print CStr(dFrac) & " = " & DecimalToFraction(dFrac)
  dFrac = dFrac + dInc

Wend
Dim dErr As Double

dFrac = 0.000001
While dFrac < 1
  dErr = 0

  Debug.Print CStr(dFrac) & " = " & DecimalToFraction(dFrac, , dErr)
  If dErr > 0 Then
    Debug.Print "With a rounding error of " & dErr
  End If
  dFrac = dFrac * 10
Wend

End Sub

Author
2 Mar 2007 12:15 AM
Rick Rothstein (MVP - VB)
> This is probably an idiotic way to get there...
> but since I love public humiliation so much <g> here goes my stab at it
> ....
>
> given a decimal value I want to get a string representation of it's
> fractional equivalent
> 99% of the time I'll be working with "architectural" units eg 1/16, 3/32,
> 7/64, 3 3/16,  etc so my testing below was rather limited
>
> Rick will probably have a one-liner for this or someone will point out a
> built in vb function<g>
>
> in any case, observations, corrections appreciated

If it helps you any, here is a response along with a function (actually, two
working in tandem) that I posted a few years back.

Rick

Consider this answer from a previous post of mine (remember, this was an
answer to someone else's question; hence the reference to the number
7.25489)...

Try this function. You can specify the maximum denominator to use in the
optional 2nd parameter. If you leave it out, then a default value of 64 is
used. The function rounds, either up or down, to the *closest* fraction
having the unit of resolution set by the 2nd argument. So, your value of
7.25489 will round to 7-1/4 even though the decimal part is more than 1/4
(it is closer to 1/4 than it is to 17/64, the next fraction past 1/4 using
the 1/64 unit-of-resolution). By the way, the routine does not limit you to
using denominators that are powers of two (although those are probably the
only ones that make sense). That means, if you specify a 2nd parameter of
47, you will receive 7-12/47 as an answer.

If your version of VB only supports optional arguments that are Variants
(and can't be defaulted), then you will have to modify the function
definition accordingly and set the default value of 64 inside of your
function. If your version of VB doesn't support optional arguments at all,
then simply turn it into a required argument.

Function MakeFraction(ByVal DecimalNumber As Variant, _
                      Optional ByVal LargestDenominator As Long = 64, _
                      Optional bShowDash As Boolean = False) As String
   Dim GCD As Long
   Dim TopNumber As Long
   Dim Remainder As Long
   Dim WholeNumber As Long
   Dim Numerator As Long
   Dim Denominator As Long
   If IsNumber(DecimalNumber) Then
      DecimalNumber = CDbl(DecimalNumber)
      WholeNumber = Fix(DecimalNumber)
      Denominator = LargestDenominator
      Numerator = Format(Denominator * _
                           Abs(DecimalNumber - WholeNumber), "0")
      If Numerator = Denominator Then
        Numerator = 0
        WholeNumber = WholeNumber + 1
      End If
      If Numerator Then
         GCD = LargestDenominator
         TopNumber = Numerator
         Do
            Remainder = (GCD Mod TopNumber)
            GCD = TopNumber
            TopNumber = Remainder
         Loop Until Remainder = 0
         Numerator = Numerator \ GCD
         Denominator = Denominator \ GCD
         MakeFraction = CStr(WholeNumber) & _
                        IIf(bShowDash, "-", "  ") & _
                        CStr(Numerator) & "/" & _
                        CStr(Denominator)
      Else
        MakeFraction = CStr(WholeNumber)
      End If
   Else
     '   Input wasn't a number, handle error here
   End If
End Function

Function IsNumber(ByVal Value As String) As Boolean
   '   Leave the next statement out if you don't
   '   want to provide for plus/minus signs
   If Value Like "[+-]*" Then Value = Mid$(Value, 2)
   IsNumber = Not Value Like "*[!0-9.]*" And _
                  Not Value Like "*.*.*" And _
                  Len(Value) > 0 And Value <> "." And _
                  Value <> vbNullString
End Function
Author
2 Mar 2007 12:52 AM
MP
"Rick Rothstein (MVP - VB)" <rickNOSPAMnews@NOSPAMcomcast.net> wrote in
message news:u09je$FXHHA.4908@TK2MSFTNGP06.phx.gbl...
> If it helps you any, here is a response along with a function (actually,
two
> working in tandem) that I posted a few years back.
>
> Rick
>
> Function MakeFraction(ByVal DecimalNumber As Variant, _
> End Function
>
>

well, I'm really disappointed...that's wayyy more than one line
<gdr>
guess i should have googled before wasting a couple hours on that eh?
also found CFraction by Larry Serflaten

oh well, the doing is half the fun and at least I'm glad that I wasnt'
totally off base...just more wordy and less elegant..
:-)

Thanks again
Mark
Author
2 Mar 2007 7:07 AM
Larry Serflaten
"MP" <NoSpam@Thanks.Com> wrote

> also found CFraction by Larry Serflaten

I found that too and added a few optional parameters.
I did not do much testing before I posted, and later saw
that it did not round up properly.  This one does better:

LFS

Private Function ArcFormat(ByVal Value As Single, _
                        Optional Tolerant As Boolean = False, _
                        Optional Exponent As Byte = 6) As String
'  Returns arcitectural format of decimal Value
'  * Tolerant > True = round out;   False = round in
'  * Exponent > Smallest unit of measurement = 1 / (2 ^ Exponent)
'              (smallest unit limited to 1 / 1073741824)
Dim num As Long, den As Long, whl As Long, unit As Long
Dim neg As String

        If Value < 0 Then
            neg = "-"
            Value = Abs(Value)
        End If
        If Value >= 1 Then
            whl = Int(Value)
            Value = Value - whl
        End If
        If Exponent > 30 Then
            Exponent = 30
        End If
        unit = 2 ^ Exponent
        If Tolerant Then
            num = Int(Value * unit + 0.99999999999999)
        Else
            num = Int(Value * unit)
        End If
        If num >= 1 Then
            den = unit
            Do While (num And 1) = 0
                num = num \ 2
                den = den \ 2
            Loop
        End If
        If den > 1 Then
            ArcFormat = neg & CStr(whl) & " " & CStr(num) & "/" & CStr(den)
        Else
            ArcFormat = neg & CStr(whl + num)
        End If
End Function
Author
2 Mar 2007 1:48 AM
Larry Serflaten
"MP" <NoSpam@Thanks.Com> wrote

> This is probably an idiotic way to get there...
> but since I love public humiliation so much <g> here goes my stab at it ....
>
> given a decimal value I want to get a string representation of it's
> fractional equivalent
> 99% of the time I'll be working with "architectural" units eg 1/16, 3/32,
> 7/64, 3 3/16,  etc so my testing below was rather limited
>

Here is a little less verbose version that works with scales that
are a power of 2 (as arcitectural dimensions are).

LFS

Private Function ArcFormat(ByVal Value As Single, _
                        Optional Tolerant As Boolean = False, _
                        Optional Exponent As Byte = 6) As String
'  Returns arcitectural format of decimal Value
'  * Tolerant > True = round up;   False = round down
'  * Exponent > Smallest unit of measurement = 1 / (2 ^ Exponent)
'              (smallest unit limited to 1 / 1073741824)
Dim num As Long, den As Long, unit As Long

        If Value < 0 Then
            ArcFormat = "-"
            Value = Abs(Value)
        End If
        If Value >= 1 Then
            ArcFormat = ArcFormat & CStr(Int(Value)) & " "
            Value = Value - Int(Value)
        End If
        If Exponent > 30 Then
            Exponent = 30
        End If
        unit = 2 ^ Exponent
        If Tolerant Then
            num = Int(Value * unit + 0.5)
        Else
            num = Int(Value * unit)
        End If
        If num >= 1 Then
            den = unit
            Do While (num And 1) = 0
                num = num \ 2
                den = den \ 2
            Loop
            ArcFormat = ArcFormat & CStr(num) & "/" & CStr(den)
        End If
End Function
Author
2 Mar 2007 7:04 PM
MP
"Larry Serflaten" <serfla***@usinternet.com> wrote in message
news:%23mLKgzGXHHA.896@TK2MSFTNGP05.phx.gbl...
>
> "MP" <NoSpam@Thanks.Com> wrote
>

>
> Here is a little less verbose version that works with scales that
> are a power of 2 (as arcitectural dimensions are).

Yeah, maybe more than a *little* less verbose :-)
....but thanks for being so kind <g>

Thanks
Mark