PDA

View Full Version : Ai có thuật toán convert số thập phân thành phân số thật hay không??



attilathehun
07-04-2003, 21:28
lúc trước mình đọc chương trình của ddt_vn thì thấy ddt_vn làm như sau:
- add tử, mẫu và giá trị tử / mẫu vào mảng
- sau đó muốn convert số thập phân thì cứ việc duyệt mảng, trùng với cái nào thì lấy ra
cách này tuy chính xác nhưng mình thấy có vẻ... làm sao ấy. có bạn nào có cách hay không???

White_Rose
08-04-2003, 01:16
Chỉ có cách gần chính xác thôi.
Cho tử di động từ 1 đến n
cho mẫu di động từ 1 đến m
lấy ra số gần nhất :)

traiheogiong
08-04-2003, 09:58
Ne , sao khong dua code len day de moi nguoi tim hieu luon chu . Hoi do tui co tim duoc 1 source code ve van de nay , nhung ma doc khong hieu gi het a

attilathehun
08-04-2003, 14:27
to wr:
bác còn cách nào tối ưu hơn nữa không? duyệt như vậy thì chậm lắm. Có thể kiểm tra những phân số bằng phân số trước và không cần thực hiện phép / nữa. (vd 2/4 kiểm tra thấy nó bằng 1/2 thì bỏ qua luôn)

vtv4
08-04-2003, 19:42
Giải thuật chuyển số thập phân A thành phân số T/M:
* Xét ba trường hợp
- Nếu A là số thập phân hữu hạn thì chỉ việc nhân cả tử và mẫu với 10 mũ "số các chữ số ở phần thập phân", sau đó rút gọn
- Nếu A là số thập phân vô hạn tuần hoàn thì áp dụng công thức tính tổng của cấp số nhân lùi vô hạn, sau đó thì rút gọn
- Nếu A là số thập phân vô hạn không tuần hoàn thì ... pó tay :-(

vtv4
08-04-2003, 19:48
À, nếu A là số thập phân vô hạn không tuần hoàn thì đặt mức chính xác epsilon (lấy bao nhiêu số thập phân sau dấu phẩy) rồi coi đó là một số thập phân hữu hạn rồi làm như giải thuật bên trên ;-)

dtt_vn
08-04-2003, 22:07
hè hè . có code đây. trong chương trìonh của tui định đem đi thi đàng hoàng ấy nhé. hiểu được số thực, phân số ( detect được gần 98% ). và số nguyên. rất tốt :D

' CHú ý : dtt_vn dùng font VK đấy nhé.

Sub Fraction_Analyze(ByVal Decimals As Double, Tu, Mau)
Dim Whole As Double, Partial As Double
Dim Count As Integer, Trigger As Integer
Dim Fraction As String, Numerator As Long
Dim Denominator As Double, Difference As Double
Dim Switched As Integer, Negative As Boolean
Dim DecPos As Double
Dim Temp As Double

On Error GoTo GERR
' ChØ lÊy tíi nh÷ng ký sè cã thÓ thÊy ®­îc
Temp = Val(Str(Decimals))
Decimals = Abs(Decimals)
' DÊu d­¬ng
Negative = False
' T¸ch phÇn nguyªn ra ngoµi
Whole = Int(Decimals)
If Whole < 0 Then
' khi int(-1.5) = -2, ta ph¶i trõ +1 vµo thªm
Whole = Whole + 1
Negative = True
End If
Decimals = Abs(Decimals - Whole)

' nÕu phÇn ph©n =0 => kÕt thóc
If Decimals = 0 Then
Tu = Whole * IIf(Temp < 0, -1, 1)
Mau = 1
Exit Sub
End If
If Decimals > 0.99 Then
Switched = 1
' Trõ hÕt lÊy sè 1 ë chãt phÇn ph©n
' VÝ dô : 1#-0.999 = 0.001
Decimals = 1# - Decimals
End If

' Nh©n thªm 10 vµo øng víi mét sè 0 ë phÇn ph©n ®Ó ph©n sè kh«ng trë nªn lín
DecPos = 1
Do While Decimals < 0.01
Decimals = Decimals * 10
DecPos = DecPos * 10
Loop

' LÊy phÇn nghÞch ®¶o
Partial = 1 / Decimals
' Do chinh xac tim phan so. Thuong thi do chinh xac nam tu < 1e-17 . Tuy nhien, de chinh xac hon, ta co the tang len den 1e-28
Difference = 1E-26 * DecPos
Trigger = 36 - 9 * Log(DecPos) / Log(10)
Denominator = CLng(Partial)
Numerator = 1

Do While Abs(Denominator - Partial) > Difference
Partial = Partial / Numerator
Numerator = Numerator + 1
Partial = Partial * Numerator
Denominator = CLng(Partial)
Count = Count + 1
If Count >= Trigger Then
Difference = Difference * 10
Count = 0
End If
Loop

Denominator = Denominator * DecPos
Tu = (Abs(Whole) * Denominator + Numerator) * IIf(Temp < 0, -1, 1)
Mau = Denominator

If Switched = 1 Then
' NÕu ®· cã lÊy nghÞch ®¶o th× kÕt qu¶ ®­îc tr¶ vÒ b»ng 1-tu/mau
Tu = Denominator - Numerator
Mau = Denominator
End If

If Trim(Str((Tu / Mau))) <> Trim(Str(Temp)) Then
Tu = Temp
Mau = 1
Else
ToiGian Tu, Mau
End If

Exit Sub

GERR:
Err.Clear
Tu = 0
Mau = 1
End Sub

Public Sub ToiGian(Tu, Mau)
Dim s1 As String
Dim S2 As String


If (Tu = 0) Or (Mau = 0) Then
Exit Sub
End If

s1 = Trim(Str(Tu))
S2 = Trim(Str(Mau))
Dim I As Long
' §¬n gi¶n bít nh÷ng sè 00 phÝa sau ®Ó tr¸nh bÞ lçi
Do While False > True
If (Right(Str(s1), 1) = "0") And (Right(Str(S2), 1) = "0") Then
s1 = Left(s1, Len(s1) - 1)
S2 = Left(S2, Len(S2) - 1)
Else
Exit Do
End If
Loop

Tu = Val(s1)
Mau = Val(S2)
Dim K
K = USCLN(Tu, Mau)
Do While K > 1
Tu = Tu \ K
Mau = Mau \ K
K = USCLN(Tu, Mau)
Loop

Exit Sub

ER:
Exit Sub

End Sub

Function USCLN(ByVal a, ByVal b)
If b = 0 Then
USCLN = a
Else
USCLN = USCLN(b, a Mod b)
End If
End Function