最接近π值的5位分数的算法

题目:

求一个分数，分子5位数（第1位不是0），分母也是5位数（第1位不是0），分子和分母这10个数正好由0到9这10个数字组成（不缺也不重复）。求最接近π值的那个分数

解法1(穷举法)

Sub getit()
Const num As Long = 3628800 ' 10!
Dim tt As Single, i As Long, j As Long, k As Long, temp1 As Long, temp2 As Long, pi As Single, diff As Single, out As String, temp As String
pi = 4 * Atn(1)
diff = 1
tt = Timer '开始计时
For i = 0 To num - 1
temp = 0
temp1 = i
For j = 2 To 10
temp2 = temp1 Mod j + 1
temp1 = temp1 \ j
temp = Left(temp, temp2 - 1) & j - 1 & Mid(temp, temp2)
Next
If temp Like "[3-9]####[1-3]####" Then
temp1 = Val(Left(temp, 5))
temp2 = Val(Right(temp, 5))
If Abs(temp1 / temp2 - pi) < diff Then diff = Abs(temp1 / temp2 - pi): out = temp1 & "/" & temp2
End If
Next
MsgBox out & "用时 " & Timer - tt & " 秒！"
End Sub

最后结果:=85910/27346

上述代码效率太低.

解法2(穷举法)

Sub Getit()
Dim pi As Single, diff As Single, i As Long, j As Long, temp As Long, s() As Byte, n As Byte, result As String, tt As Single
tt = Timer
pi = 4 * Atn(1)
diff = 1
For i = 31425 To 98765
ReDim s(9)
For j = 1 To 5
s(Mid(i, j, 1)) = 1
Next
If WorksheetFunction.Sum(s) = 5 Then
temp = Fix(i / pi)
For j = 1 To 5
s(Mid(temp, j, 1)) = 1
Next
If WorksheetFunction.Sum(s) = 10 Then
If Abs(i / temp - pi) < diff Then
diff = Abs(i / temp - pi)
result = i & "/" & temp
End If
End If
End If
Next
MsgBox result, vbInformation, "总计用时" & Timer - tt & "秒!"
End Sub

解法3(递归法)(yier_fang提供,http://club.excelhome.net/dispbbs.asp?boardid=2&replyid=978209&id=262029&page=1&skin=0&Star=1)

Dim lngFM As Long
Dim lngFZ As Long
Const PI = 3.1415926535
Dim dbl As Double
Dim kkk As Long
Dim intCK As Integer
Dim showW As Boolean
Dim Unums As String
Dim Lnums As String


Sub cnft()
Dim tm
tm = Timer
Application.ScreenUpdating = False
kkk = 0: lngFM = 0: lngFZ = 0
Unums = Cells(3, "H")
Lnums = Cells(3, "I")
dbl = 3.1415926535
intCK = Cells(3, "F").Value
showW = Cells(3, "E").Value
If showW Then UserForm1.Show
Call fs("", "")
Cells(1, 2).Value = lngFZ
Cells(2, 2).Value = lngFM
If lngFM = 0 Then
Cells(3, 2).Value = "无解"
Else
Cells(3, 2).Value = (lngFZ / lngFM)
End If
Cells(4, 2).Value = kkk
UserForm1.Hide
Application.ScreenUpdating = True
Cells(5, 2) = Format((Timer - tm), "0.0000") & "秒"
End Sub
Sub fs(ByRef FM As String, ByRef FZ As String)
kkk = kkk + 1
If showW Then
UserForm1.TextBox1.Text = "递归第..." & kkk & "...次"
DoEvents
End If
Dim i, j As Long
If Len(FM) = 0 Then
For i = 1 To 9
For j = 1 To 9
If i <> j Then
Call fs(CStr(i), CStr(j))
End If
Next j
Next i
ElseIf Len(FM) < 5 Then
If intCK = 1 Then
If ((FZ - 1) / (FM + 1)) > PI Then Exit Sub
If FM = 1 Then
If ((FZ + 1) / (FM)) < PI Then Exit Sub
Else
If ((FZ + 1) / (FM - 1)) < PI Then Exit Sub
End If
ElseIf intCK = 2 Then
'=======下面是手工的出口设置=========
If FZ / FM < Lnums Then Exit Sub
If FZ / FM > Unums Then Exit Sub
End If
For i = 0 To 9
If InStr(FM & FZ, i) = 0 Then
For j = 0 To 9
If InStr(FM & FZ & i, j) = 0 Then
Call fs(FM & i, FZ & j)
End If
Next j
End If
Next i

Else

If Abs((FZ / FM) - PI) < dbl Then
lngFM = FM
lngFZ = FZ
dbl = Abs((FZ / FM) - PI)

End If
End If
End Sub

解法4(递归法)(彭希仁提供:http://club.excelhome.net/dispbbs.asp?boardid=2&replyid=977506&id=262029&page=1&skin=0&Star=2)

Public pi
Public x
Public y
Public z
Public k As Long
Public st
Sub peng()
t = Timer
pi = 4 * Atn(1)
x = 10
st = 0
Call caii("", 0)
MsgBox (y & "/" & z & "=" & y / z & "递归" & st & "次,耗时" & Timer - t & "秒")
End Sub
Sub caii(a, i)
st = st + 1
m = 0
If i = 1 Then m = 3
For j = m To 9
If Not (a Like "*" & j & "*") Then
If i + 1 = 5 Then
k = a & j
If k > 31415 Then
kp = Round(k / pi)
If Abs(k / kp - pi) < x Then
h = k & kp
For n = 0 To 9
If Not (h Like "*" & n & "*") Then Exit For
Next n
If n = 10 Then
x = Abs(k / kp - pi)
y = k
z = kp
End If
End If
End If
Else
Call caii(a & j, i + 1)
End If
End If
Next j
End Sub

解法5(回溯法)

Sub getit(ByVal target As Single) 'target is a single number between 1～98765\10234
Dim n As Byte, m As Byte
Dim i As Integer, j As Integer, t As Integer, a(), fenmu As Long, fenzi As Long, max As Long, temp As String, result As Long
m = 4: n = 9
diff = 1
tt = Timer
max = int(98765/target)
ReDim a(m)
For i = 1 To m
a(i) = -1
Next
Do
a(t) = a(t) + 1
If a(t) > n Then
t = t - 1
Else
For i = 0 To t - 1
If a(t) = a(i) Then Exit For
Next
If i = t Then
If t = m Then
fenmu = Join(a, "")
fenzi = Round(fenmu * target)
temp = fenzi & "/" & fenmu
If Abs(fenzi / fenmu - target) < diff Then
For j = 0 To 9
If InStr(temp, j) = 0 Then Exit For
Next
If j = 10 Then diff = Abs(fenzi / fenmu - target): result = fenmu
End If
End If
If t < m Then t = t + 1: a(t) = -1
End If
End If
If fenmu > max Then Exit Do
Loop Until t = -1
Debug.Print "Target: " & target & vbCrLf & "Result: " & Round(result * target) & "/" & result & vbCrLf & "Error: " & diff & vbCrLf & "Lapsetime: " & Format(Timer - tt, "0.00000") & " seconds" & vbCrLf
End Sub

Sub macro1()
getit Sqr(2)
getit Sqr(3)
getit Exp(1)
getit 4 * Atn(1)
getit 5.6789
End Sub

返回:

Target: 1.414214
Result: 95103/67248
Error: 4.76071359769127E-07
Lapsetime: 0.20313 seconds

Target: 1.732051
Result: 93820/54167
Error: 1.03205265816492E-07
Lapsetime: 0.13867 seconds

Target: 2.718282
Result: 87159/32064
Error: 4.39718097983719E-07
Lapsetime: 0.06445 seconds

Target: 3.141593
Result: 85910/27346
Error: 1.79341409058684E-07
Lapsetime: 0.04492 seconds

Target: 5.6789
Result: 95082/16743
Error: 1.08244854411521E-05
Lapsetime: 0.01563 seconds