24點(diǎn)的算法

    首先，我們先看看這個(gè)游戲的規(guī)則，給出4個(gè)1-9之間的自然數(shù)，例如：1，5，5，5（這是很經(jīng)典的一個(gè)例子哦 ^_^）。在1，5，5，5中間用+、-、*、/來(lái)運(yùn)算后得到24這個(gè)數(shù)。每個(gè)數(shù)只能使用一次。如果沒有計(jì)算過(guò)的基本都會(huì)被難住吧。哈哈，答案是 5*（5-1/5）。是不是很經(jīng)典呢？和它類似的還有3，3，8，8。

    下面我們來(lái)看具體算法。一般我們考慮這樣的問(wèn)題的時(shí)候，都是直接寫一個(gè)超大的select來(lái)判斷。但重復(fù)性的工作是最無(wú)聊的��！我們來(lái)分析一下這個(gè)簡(jiǎn)單的游戲規(guī)則就可以找到一個(gè)簡(jiǎn)單的方法。

    例如：4個(gè)數(shù)A、B、C、D，我們可以用F(A,B,C,D)=24來(lái)表示。那么。我們就可以把函數(shù)F拆解成F1(B,C,D)=P1(24,A)。（意思是：B，C，D之間的四則運(yùn)算可以得到A和24之間的四則運(yùn)算結(jié)果）。那么F1又可以繼續(xù)拆解為C和D之間的四則運(yùn)算關(guān)系得到結(jié)果后再和B來(lái)一次四則運(yùn)算結(jié)果。這樣，就可以得到很簡(jiǎn)單的一個(gè)數(shù)組6*6*6=216種結(jié)果而已。當(dāng)然，這是A，B，C，D順序固定的組合，那么把A，B，C，D換個(gè)位置，又一種組合。所以，所有的結(jié)果有6*6*6*12種。但，我們還是忽略了一種情況：A和B的值與C和D的值再進(jìn)行四則運(yùn)算，那么我們還需要再加一組6*6*6就可以了。

    好了，不多說(shuō)了，大家自己看下面的代碼吧。

'--------------------------------計(jì)算24的算法---------------------------
'        算法作者：CSDN(penguinMII)--企鵝
'        開發(fā)時(shí)間：2005-3-23
'        如有引用此算法請(qǐng)保留此信息
'-----------------------------------------------------------------------

'關(guān)于F1(F2(F3(a1,a2),a3),a4)的變量定義
Dim f_f(0 To 5) As Double               '2個(gè)數(shù)之間運(yùn)算后的6種結(jié)果
Dim s_s(0 To 5) As String               '2個(gè)數(shù)之間運(yùn)算后的表達(dá)式
Dim f_f_f(0 To 5) As Double             '第3個(gè)數(shù)和上面2數(shù)運(yùn)算后的結(jié)果
Dim s_s_s(0 To 5) As String             '第3個(gè)數(shù)和上面2數(shù)運(yùn)算后的表達(dá)式
Dim f_f_f_f(0 To 5) As Double           '第4個(gè)數(shù)和上面3數(shù)運(yùn)算后的結(jié)果
Dim s_s_s_s(0 To 5) As String           '第4個(gè)數(shù)和上面3數(shù)運(yùn)算后的結(jié)果
'關(guān)于F1(F2(a1,a2),F3(a3,a4))的變量定義
Dim f_f1(0 To 5) As Double              '第3個(gè)數(shù)第4個(gè)數(shù)運(yùn)算結(jié)果
Dim s_s1(0 To 5) As String              '第3個(gè)數(shù)第4個(gè)數(shù)運(yùn)算后的表達(dá)式
Dim f_f2(0 To 5) As Double              '第1、2數(shù)和第3、4個(gè)數(shù)運(yùn)算后的結(jié)果
Dim s_s2(0 To 5) As String              '第1、2數(shù)和第3、4個(gè)數(shù)運(yùn)算后的表達(dá)式

Sub ff2(x As Double, y As Double, sx As String, sy As String)
On Error Resume Next
f_f2(0) = x + y
s_s2(0) = "(" + sx + "+" + sy + ")"
f_f2(1) = x - y
s_s2(1) = "(" + sx + "-" + sy + ")"
f_f2(2) = y - x
s_s2(2) = "(" + sy + "-" + sx + ")"
f_f2(3) = x * y
s_s2(3) = "(" + sx + "*" + sy + ")"
f_f2(4) = x / y
s_s2(4) = "(" + sx + "/" + sy + ")"
f_f2(5) = y / x
s_s2(5) = "(" + sy + "/" + sx + ")"

End Sub

Sub ff1(x As Integer, y As Integer)
On Error Resume Next
f_f1(0) = x + y
s_s1(0) = "(" + CStr(x) + "+" + CStr(y) + ")"
f_f1(1) = x - y
s_s1(1) = "(" + CStr(x) + "-" + CStr(y) + ")"
f_f1(2) = y - x
s_s1(2) = "(" + CStr(y) + "-" + CStr(x) + ")"
f_f1(3) = x * y
s_s1(3) = "(" + CStr(x) + "*" + CStr(y) + ")"
f_f1(4) = x / y
s_s1(4) = "(" + CStr(x) + "/" + CStr(y) + ")"
f_f1(5) = y / x
s_s1(5) = "(" + CStr(y) + "/" + CStr(x) + ")"

End Sub

Sub ff(x As Integer, y As Integer)
On Error Resume Next
f_f(0) = x + y
s_s(0) = "(" + CStr(x) + "+" + CStr(y) + ")"
f_f(1) = x - y
s_s(1) = "(" + CStr(x) + "-" + CStr(y) + ")"
f_f(2) = y - x
s_s(2) = "(" + CStr(y) + "-" + CStr(x) + ")"
f_f(3) = x * y
s_s(3) = "(" + CStr(x) + "*" + CStr(y) + ")"
f_f(4) = x / y
s_s(4) = "(" + CStr(x) + "/" + CStr(y) + ")"
f_f(5) = y / x
s_s(5) = "(" + CStr(y) + "/" + CStr(x) + ")"

End Sub

Sub fff(x As Integer, y As Double, s As String)
On Error Resume Next
f_f_f(0) = x + y
s_s_s(0) = "(" + CStr(x) + "+" + s + ")"
f_f_f(1) = x - y
s_s_s(1) = "(" + CStr(x) + "-" + s + ")"
f_f_f(2) = y - x
s_s_s(2) = "(" + s + "-" + CStr(x) + ")"
f_f_f(3) = x * y
s_s_s(3) = "(" + CStr(x) + "*" + s + ")"
f_f_f(4) = x / y
s_s_s(4) = "(" + CStr(x) + "/" + s + ")"
f_f_f(5) = y / x
s_s_s(5) = "(" + s + "/" + CStr(x) + ")"

End Sub

Sub ffff(x As Integer, y As Double, s As String)
On Error Resume Next
f_f_f_f(0) = x + y
s_s_s_s(0) = "(" + CStr(x) + "+" + s + ")"
f_f_f_f(1) = x - y
s_s_s_s(1) = "(" + CStr(x) + "-" + s + ")"
f_f_f_f(2) = y - x
s_s_s_s(2) = "(" + s + "-" + CStr(x) + ")"
f_f_f_f(3) = x * y
s_s_s_s(3) = "(" + CStr(x) + "*" + s + ")"
f_f_f_f(4) = x / y
s_s_s_s(4) = "(" + CStr(x) + "/" + s + ")"
f_f_f_f(5) = y / x
s_s_s_s(5) = "(" + s + "/" + CStr(x) + ")"

End Sub

Sub ppp(a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer)
Dim tempp As Integer

tempp = 0

Call ff(a1, a2)
For i = 0 To 5
Call fff(a3, f_f(i), s_s(i))
For j = 0 To 5
Call ffff(a4, f_f_f(j), s_s_s(j))
For k = 0 To 5
If f_f_f_f(k) > 23.99999 And f_f_f_f(k) < 24.00001 Then

tempp = 0
For xyz = 0 To Me.List1.ListCount - 1
If Me.List1.List(xyz) = s_s_s_s(k) Then
tempp = tempp + 1
End If
Next xyz

If tempp = 0 Then
Me.List1.AddItem s_s_s_s(k)
End If

End If
Next k
Next j
Next i

End Sub

Sub qqq(a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer)
Dim tempp As Integer
tempp = 0

Call ff(a1, a2)
Call ff1(a3, a4)
For i = 0 To 5
For j = 0 To 5
Call ff2(f_f(i), f_f1(j), s_s(i), s_s1(j))
For k = 0 To 5
If f_f2(k) > 23.9999 And f_f2(k) < 24.00001 Then

tempp = 0
For xyz = 0 To Me.List1.ListCount - 1
If Me.List1.List(xyz) = s_s2(k) Then
tempp = tempp + 1
End If
Next xyz

If tempp = 0 Then
Me.List1.AddItem s_s2(k)
End If

End If
Next k
Next j
Next i
End Sub

Private Sub Command1_Click()
Me.List1.Clear

Call ppp(Me.Text1(0).Text, Me.Text1(1).Text, Me.Text1(2).Text, Me.Text1(3).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(1).Text, Me.Text1(3).Text, Me.Text1(2).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(2).Text, Me.Text1(1).Text, Me.Text1(3).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(2).Text, Me.Text1(3).Text, Me.Text1(1).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(3).Text, Me.Text1(1).Text, Me.Text1(2).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(3).Text, Me.Text1(2).Text, Me.Text1(1).Text)
Call ppp(Me.Text1(1).Text, Me.Text1(2).Text, Me.Text1(3).Text, Me.Text1(0).Text)
Call ppp(Me.Text1(1).Text, Me.Text1(2).Text, Me.Text1(0).Text, Me.Text1(3).Text)
Call ppp(Me.Text1(1).Text, Me.Text1(3).Text, Me.Text1(0).Text, Me.Text1(2).Text)
Call ppp(Me.Text1(1).Text, Me.Text1(3).Text, Me.Text1(2).Text, Me.Text1(0).Text)
Call ppp(Me.Text1(2).Text, Me.Text1(3).Text, Me.Text1(1).Text, Me.Text1(0).Text)
Call ppp(Me.Text1(2).Text, Me.Text1(3).Text, Me.Text1(0).Text, Me.Text1(1).Text)

Call qqq(Me.Text1(0).Text, Me.Text1(1).Text, Me.Text1(2).Text, Me.Text1(3).Text)

End Sub