Does anyone know of any good code to convert decimals to fractions? I've come up with a way, but it's kind of sloppy...
Any help would be appreciated.
Printable View
Does anyone know of any good code to convert decimals to fractions? I've come up with a way, but it's kind of sloppy...
Any help would be appreciated.
Up to How Many Decimal Places?
-Lou
To VB's limit of accuracy. For example, it could figure out the fraction from the VB's result of 123/234. In other words, if I get the solution from 123/234 in the immediate window, and fed it to the function, it would give me the fraction back (reduced form of course ;) ). Is that clear enough?
I don't know how how sloppy your idea of sloppy is (I can sure guess, being guilty of making slop myself), but this works just to get a fraction. It might even be the a similar thing to what you do. It won't do the LCD on the numerator and denominator though. I thought I had LCD/GCF functions around somewhere, but I can't find em anymore :(.
This will handle something with up to 14 decimal places, and then it goes screwy and puts in the scientific notation. The fraction is still accurate though, but not in a pretty form anymore :)VB Code:
Public Function GetFraction(ByVal dblDecimal As Double) As String Dim lngCount As Long GetFraction = "" lngCount = 0 Do While InStr(CStr(dblDecimal), ".") dblDecimal = dblDecimal * 10 lngCount = lngCount + 1 Loop GetFraction = CStr(dblDecimal) & "/" & CStr(10 ^ lngCount) End Function
That's too sloppy. If I give it .666666666666 it doesn't give me 2/3.
Here's my code:
The decimal 0.00001 can be adjusted.VB Code:
Public Function QuickSort(vData As Variant, Low As Long, Hi As Long) If Not IsArray(vData) Then Exit Function Dim lTmpLow As Long Dim lTmpHi As Long Dim lTmpMid As Long Dim vTempVal As Variant Dim vTmpHold As Variant lTmpLow = Low lTmpHi = Hi If Hi <= Low Then Exit Function lTmpMid = (Low + Hi) \ 2 vTempVal = vData(lTmpMid) Do While (lTmpLow <= lTmpHi) Do While (vData(lTmpLow) < vTempVal And lTmpLow < Hi) lTmpLow = lTmpLow + 1 Loop Do While (vTempVal < vData(lTmpHi) And lTmpHi > Low) lTmpHi = lTmpHi - 1 Loop If (lTmpLow <= lTmpHi) Then vTmpHold = vData(lTmpLow) vData(lTmpLow) = vData(lTmpHi) vData(lTmpHi) = vTmpHold lTmpLow = lTmpLow + 1 lTmpHi = lTmpHi - 1 End If Loop If (Low < lTmpHi) Then QuickSort vData, Low, lTmpHi End If If (lTmpLow < Hi) Then QuickSort vData, lTmpLow, Hi End If End Function Public Function cFrac(Expr As Double) As String Dim i As Long, j As Long Dim v As Variant Dim x As Double Dim curVal As Double Dim minVal As Double Dim intVal As Double Dim idx As Long Dim s As String Dim arr() As String Dim arrIdx As Long ReDim arr(0) x = Expr intVal = Int(x) x = x - intVal For i = 1 To 3000 For j = 1 To i If Abs(x - j / i) < 0.00001 Then arr(arrIdx) = String$(4 - Len(CStr(j)), "0") & j & "/" & i arrIdx = arrIdx + 1 ReDim Preserve arr(arrIdx) End If Next Next arrIdx = arrIdx - 1 ReDim Preserve arr(arrIdx) QuickSort arr, 0, arrIdx minVal = 0.0001 For i = 0 To arrIdx v = Split(arr(i), "/") curVal = Abs(v(0) / v(1) - x) If curVal < minVal Then minVal = curVal idx = i End If Next s = arr(idx) i = 1 Do Until Mid(s, i, 1) > 0 s = Right$(s, Len(s) - 1) Loop v = Split(s, "/") v(0) = v(0) + v(1) * intVal s = v(0) & "/" & v(1) cFrac = s Beep End Function
I messed with it some more, and fixed that SF weirdness. The fix is in bright blue:
VB Code:
Public Function GetFraction(ByVal dblDecimal As Double) As String Dim lngCount As Long [color=blue]Dim strDenominator As String Dim intNumZeroes As Integer[/color] GetFraction = "" lngCount = 0 Do While InStr(CStr(dblDecimal), ".") dblDecimal = dblDecimal * 10 lngCount = lngCount + 1 Loop [color=blue] strDenominator = CStr(10 ^ lngCount) If InStr(1, strDenominator, "E", vbTextCompare) Then intNumZeroes = Val(Right$(strDenominator, Len(strDenominator) - InStr(strDenominator, "+"))) strDenominator = "1" & String$(intNumZeroes, "0") End If[/color] GetFraction = CStr(dblDecimal) & "/" & [color=blue]strDenominator[/color] End Function
That won't give you "2/3" for .666666666666 though...
You do have a point there about the 2/3 thing, but when you do that mentally, you've changed the value. I know mathematically that 0.666666... = 2/3 though. It's very easy to prove with some algebra. The thing I mentioned though does it exactly. I just wish I could remember a fast way to get the LCD of the numbers, then what I mentioned might be usable :). I just did some other checking, and if you're going for the best significance, yours gets a little fudgy past 6 places. 4*atn(1) (3.14159265358979 - as significant as VB will report pi) will come out as 355/113 with your function. But if you do that expression, you get only 3.141593 back.
Did you try the code I posted?
Check this code out (adjust the constant for accuracy/speed):
VB Code:
Public Function CFrac2(ByVal X As Double) As String Dim Q As Double 'Quotient Dim D As Long 'Denominator Dim N As Long 'Numberator D = 1 N = 1 Q = N / D Do While Abs(Q - X) > 0.00000000001 If (Q < X) Then N = N+ 1 Else D = D + 1 End If Q = N / D Loop CFrac2 = CStr(N) & "/" & CStr(D) End Function
Nice Vic ;)
Just added support for negative fractions and zero.
VB Code:
Public Function CFrac2(ByVal Y As Double) As String Dim Q As Double 'Quotient Dim D As Long 'Denominator Dim N As Long 'Numerator Dim X As Double If Y <> 0 Then X = Abs(Y) D = 1 N = 1 Q = D / N Do While Abs(Q - X) > 0.00000000001 If (Q < X) Then D = D + 1 Else N = N + 1 End If Q = D / N Loop If Y < 0 Then CFrac2 = "-" CFrac2 = CFrac2 & CStr(D) & "/" & CStr(N) Else CFrac2 = 0 End If End Function
That's probably the best way to do it. After playing with mine, I managed to get it to give exact fractions, but I ended up having to make up other functions to get around some limits :) I was using Mod in my function to get the GCF in order to reduce the fraction, and needed to make something to handle doubles. After that then, I could get the scientific notation thing to creep up in the numerator with values with enough decimal places, so I figured the effort was starting to outweigh the use. Running along side each other though, and timing with GetTickCount, I kept getting 0 out of mine, and up to .5 s with yours. I would save the GTC, then do the function, and immediately get GTC once more for the timing. This is what I ended up using as mine (without the SF removal part). If anything, at least you may find the GCF function useful later. It uses Euclid's algorithm.
It seems to work for around 10-12 decimal places or so with some variance. Then the SF creeps in.VB Code:
Public Function GetFraction(ByVal dblDecimal As Double) As String Dim lngCount As Long Dim dblDenominator As Double, dblNumerator As Double Dim dblGCF As Double GetFraction = "" lngCount = 0 Do While InStr(CStr(dblDecimal), ".") dblDecimal = dblDecimal * 10 lngCount = lngCount + 1 Loop dblDenominator = 10 ^ lngCount dblGCF = GCF(dblDecimal, dblDenominator) dblDenominator = dblDenominator / dblGCF dblNumerator = dblDecimal / dblGCF GetFraction = CStr(dblNumerator) & "/" & CStr(dblDenominator) End Function Public Function GCF(ByVal dblX As Double, ByVal dblY As Double) As Double Dim dblPass As Double dblX = Abs(dblX) dblY = Abs(dblY) Do While dblX > 0 dblPass = dblX dblX = DBLMod(dblY, dblX) dblY = dblPass Loop GCF = dblPass End Function Public Function DBLMod(ByVal dblNumber As Double, ByVal dblDivisor As Double) As Double DBLMod = dblNumber - (Int(dblNumber / dblDivisor) * dblDivisor) End Function
This code came to me once I looked at the above code I had made. My original code was testing a lot of stuff multiple times (2/3,4/6,6/9, etc.), so I looked for a way to speed it up, and this "zeroing in" method works beautifully. I wonder if putting it in C++ will make it faster...
I found a pretty good fraction for pi using a precision of 1E-16:
I think I can mark this problem resolved. Maybe I could start a trend; it could help when searching for stuff (to know if the problem in the thread was resolved).Code:245850922/78256779
This code is lightning fast, I mean like it doesn't even take a second, I have tried lots of code all that do loop and counts down by one and all this, but this is freaky.
Try it I promise you it works also
.33333 returns 33333/100000
whereas
.333333 return 1/3
same for all your reoccurances like:
.123123123..... returns 41/33
Code:' Converts a decimal value into fractional parts as integers
' (based on the concept of Continued Fractions)
' Examples of usage:
' Call DeclToFrac(0.125, a, b) ' 1 and 8 are returned in a & b
' Call DecToFrac(5/40, a, b) ' 1 and 8 are also returned
' Call DecToFrac(2/3, a, b) ' 2 and 3 are returned
' Since more than one value needs to be returned, they are returned
' to variables which are passed by reference as arguments (Numerator
' and Denom) to the DecToFrac Sub procedure
Sub DecToFrac(DecimalNum As Double, Numerator As Long, Denom As Long)
' The BigNumber constant can be adjusted to handle larger fractional parts
Const BigNumber = 50000
Const SmallNumber = 1E-16
Dim Inverse As Double, FractionalPart As Double
Dim WholePart As Long, SwapTemp As Long
Inverse = 1 / DecimalNum
WholePart = Int(Inverse)
FractionalPart = Frac(Inverse)
If 1 / (FractionalPart + SmallNumber) < BigNumber Then
' Notice that DecToFrac is called recursively.
Call DecToFrac(FractionalPart, Numerator, Denom)
Numerator = Denom * WholePart + Numerator
SwapTemp = Numerator
Numerator = Denom
Denom = SwapTemp
Else ' If 1 / (FractionalPart + SmallNumber) > BigNumber
' Recursion stops when the final value of FractionalPart is 0 or
' close enough. SmallNumber is added to prevent division by 0.
Numerator = 1
Denom = Int(Inverse)
End If
End Sub
' This function is used by DecToFrac and DecToProperFact
Function Frac(x As Double) As Double
Frac = Abs(Abs(x) - Int(Abs(x)))
End Function
' This additional procedure handles "improper" fractions and returns
' them in mixed form (a b/c) when the numerator is larger than the denominator
Sub DecToProperFrac(x As Double, a As Long, b As Long, c As Long)
If x > 1 Then a = Int(x)
If Frac(x) <> 0 Then
Call DecToFrac(Frac(x), b, c)
End If
End Sub
'#####################################################################
'#
'# This item has been brought to you by Daniel Corbier, the author of
'# UCalc Fast Math Parser, a component which allows programs to
'# evaluate expressions that are defined at runtime. You can learn
'# more and download a fully functional copy at www.ucalc.com/mathparser
'#
'#####################################################################
If you are willing to write code that checks for repeating patterns, it is easy to generate the formula which will convert to rational numbers. Patterns like the following are pretty straight forward.
1/3 = .3333 (3/10)/.9 = 3/9
2/3 = .66666 (6/10)/.9 = 6/9
4/33 = .12121212 (12/100)/.99 = 12/99
1/7 = .142857142857 (142857/1000000)/.999999 = 142857/999999
You need a function which can find common factors and divide them out.
If there is no pattern, the best you can do is the following
abc/1000 = .abc
abcd/10000 = .abcd
abcde/100000 = .abcde
That code isn't just for reoccuring decimals... it converts any fraction and does it very well, with the Lowest Common Denominator.