24点游戏的算法参考与源程序.doc

24点游戏的算法与源程序一、 任务说明24点游戏是一个大众化的益智游戏。任意给四张扑克牌（不包括大小王），只能够用加、减、乘、除以及适当的括号连接这四张牌，无论顺序，使计算结果为24，或者宣布根本就是无解的。需要注意的是，每张牌必须运算，并且只能运算一次，J、Q、K可设置为11、12、13。本程序目的就是算出一组牌的所有解（不同形式的式子算不同解），如没有则输出无解。二、 算法说明首先解决图形扑克牌的显示问题。我选择了Qcard.dll。运用其中的DrawCard过程可轻松实现扑克的显示问题，在源程序中会有具体用法。接下来是24点算法的讨论。首先想到的是用穷举表达式的方法，然后求值。然而，由于括号的存在，使穷举表达式并非易事。实际上，括号的作用仅仅是提高运算的优先级而已，如果我们规定符号的优先级，一样可以达到要求。具体来说，设四张牌为a、b、c、d，运算符为、，表达式为a b c 。如果强制规定、的优先顺序，就不必考虑括号问题了。而这3个运算符的运算顺序有3！=6种，分别是：1 2. 3. 4. 5. 6.等价的表达式分别是：1.(ab)c) 2.(ab)(cd) 3.(a(bc)d4.a(bc)d) 5.(ab)(cd) 6. a(b(cd)显然，2和5是相同的，因此只考虑5种情况。这样，括号的问题就解决了。接下来，就是生成a、b、c、d的全排列，注意去掉其中的相同排列。去除的方法很多，比如字典排序等，我用的是另一种方法。用循环的嵌套生成a、b、c、d的24种全排列，记录在数组中。把每一组数当作一个四位的14进制数，把这24个数全部转化为十进制（如（6529）14=6*143+5*142+2*14+9）。这样，如果两个排列完全相同，则得到的十进制数是相等的。这样，通过对这些十进制的比较，就可以比较这些排列的相同情况。一旦遇到相同的排列，就标记上。最后生成一组没有重复的排列。对这组排列进行以上方法的运算，就可以得到所有的结果了。注意在运算过程中除法的特殊性除数不能为零。因为可能会用到除法，所以要考虑精度问题，这里通过结果减去24取绝对值与一个接近0的小数比较，如小于它，即可判定结果是24。附：其他待决的问题：1、 图形扑克牌的遮挡问题。当窗口中的扑克牌被遮挡后，扑克牌不会重新画上，造成扑克牌遮挡后显示不全问题。应寻找Qcard.dll的有关参数。2、 形式不同而实质相同的解的问题。有些解虽然形式不同，但其实质是完全相同的。如3*(11+4)-7)和3*(11+(4-7)，实际上只是一种解。去掉这些相同解的问题情况较多，其较为繁琐，有待解决。3、 多余括号好问题。有些解的括号是多余的，应在输出前去掉。4、 改进程序的可玩性。增加玩家输入表达式的功能，并判断对错，还可以加上时间限制，使玩家参与到游戏中。三、 程序框图Next iNext j设置重复排列的标志result(i,0)=1计数器t=t+1Next i将全排列所对应的十进制数存入temp(1.24)随机产生四张扑克牌3重循环产生24种全排列全排列循环终止排列存入数组result(1.24,1.4)初始化重复排列的标志result(1.24,0)=0For i=1 to 24初始化变量、数组For i=1 to 23For j=i+1 to 24比较temp(i)与temp(j)是否相等YNFor i=1 to t检验result(i,0)标志是否为1NY把result存入finalNext i循环final中的全部排列循环3个运算符结束循环3个运算符计算形如( a b ) c ) d 的表达式如等于24则输出计算形如( a b ) ( c d ) 的表达式如等于24则输出计算形如( a ( b c ) ) d的表达式如等于24则输出计算形如 a ( ( b c ) d ) 的表达式如等于24则输出计算形如 a ( b ( c d ) ) 的表达式如等于24则输出结束循环final中的排列输出解的个数或无解结束四、 VB源程序代码需要声明所有用到的变量Option Explicit声明全局变量、数组Dim cards(1 To 4) As Single, card(1 To 4) As SingleDim result(1 To 24, 0 To 4) As Integer, final(1 To 24, 1 To 4) As Integer, temp(1 To 24) As LongDim nokey As Boolean, total As Integer, n1 As Integer, n2 As Integer, n3 As Integer, n4 As Integer, a As Integer, b As Integer, c As Integer, d As Integer, op1 As Integer, op2 As Integer, op3 As Integer, answer1 As Single, answer2 As Single, answer3 As Single, color As IntegerDim i As Integer, j As Integer, t As Integer声明zero常量，设置0的标准，处理除法的精度问题Const zero = 0.00001初始化QCARD32.DLLPrivate Declare Function InitializeDeck Lib qcard32.dll (ByVal hwin As Long) As IntegerDrawCard 子程序，画出扑克牌图样在FORM窗体及 窗体上的图片框用法： hwnd - 需要画图的对象句柄 nCard - 扑克牌编号 其编号如下 1-13 梅花 14-26 方块 27-39 红心 40-52 黑桃 小王-110 大王-111 x，y 位置Private Declare Sub DrawCard Lib qcard32.dll (ByVal hwnd As Long, ByVal nCard As Integer, ByVal x As Integer, ByVal y As Integer)DrawBack 子程序，画出扑克牌的背面图案，共六种 按 1-6 编号Private Declare Sub DrawBack Lib qcard32.dll (ByVal hwnd As Long, ByVal nCard As Long, ByVal x As Long, ByVal y As Long)GetCardSuit 函数，求 nCard 的点数 1-13Private Declare Function GetCardSuit Lib qcard32.dll (ByVal nCard As Long) As LongGetCardValue 函数，求 nCard 的花色 0鬼牌 1梅花 2方块 3红心 4黑桃Private Declare Function GetCardValue Lib qcard32.dll (ByVal nCard As Long) As LongForm_Load过程，初始化Private Sub Form_Load() Randomize Timer Call InitializeDeck(Me.hwnd) Command3.Enabled = FalseEnd Subanswer函数，返回x与y做operator运算后的值，-100为错误标志Private Function answer(x As Single, y As Single, operator As Integer) As Single Select Case operator Case 1 answer = x + y Exit Function Case 2 answer = x - y Exit Function Case 3 answer = x * y Exit Function Case 4 If y = 0 Then answer = -100 Exit Function Else answer = x / y Exit Function End If End Select answer = -100End Functionoperate函数，返回数值op所对应的四则运算符号Private Function operate(op As Integer) As String Select Case op Case 1 operate = + Case 2 operate = - Case 3 operate = * Case 4 operate = / End SelectEnd Functionsearch过程，去掉数组result中相同的元素，存入数组final中Private Sub search() For i = 1 To 24 result(i, 0) = 0 temp(i) = result(i, 1) * 14 3 + result(i, 2) * 14 2 + result(i, 3) * 14 + result(i, 4) Next i For i = 1 To 23 For j = i + 1 To 24 If temp(i) = temp(j) Then result(i, 0) = 1 Next j Next i For i = 1 To 24 If result(i, 0) = 1 Then GoTo 1 t = t + 1 For j = 1 To 4 final(t, j) = result(i, j) Next j1 Next iEnd SubMain过程，用于计算四个数通过不同运算得到24的所有情况，并输出结果Private Sub Main() For op1 = 1 To 4 For op2 = 1 To 4 For op3 = 1 To 4 1形如( a b ) c ) d 的表达式 answer1 = answer(cards(1), cards(2), op1) answer2 = answer(answer1, cards(3), op2) answer3 = answer(answer2, cards(4), op3) If answer1 -100 And answer2 -100 And answer3 -100 Then If Abs(answer3 - 24) zero Then nokey = False total = total + 1 Text1.Text = Text1.Text + ( + Trim$(Str$(cards(1) + operate(op1) + Trim$(Str$(cards(2) + ) + operate(op2) + Trim$(Str$(cards(3) + ) + operate(op3) + Trim$(Str$(cards(4) + 若本行已有三个式子，就换行 If total Mod 3 = 0 Then Text1.Text = Text1.Text + Chr$(13) + Chr$(10) End If End If End If 2形如( a b ) (c d) 的表达式 answer1 = answer(cards(1), cards(2), op1) answer2 = answer(cards(3), cards(4), op3) answer3 = answer(answer1, answer2, op2) If answer1 -100 And answer2 -100 And answer3 -100 Then If Abs(answer3 - 24) zero Then nokey = False total = total + 1 Text1.Text = Text1.Text + ( + Trim$(Str$(cards(1) + operate(op1) + Trim$(Str$(cards(2) + ) + operate(op2) + ( + Trim$(Str$(cards(3) + operate(op3) + Trim$(Str$(cards(4) + ) + 若本行已有三个式子，就换行 If total Mod 3 = 0 Then Text1.Text = Text1.Text + Chr$(13) + Chr$(10) End If End If End If 3形如( a ( b c ) ) d 的表达式 answer1 = answer(cards(2), cards(3), op2) answer2 = answer(cards(1), answer1, op1) answer3 = answer(answer2, cards(4), op3) If answer1 -100 And answer2 -100 And answer3 -100 Then If Abs(answer3 - 24) zero Then nokey = False total = total + 1 Text1.Text = Text1.Text + ( + Trim$(Str$(cards(1) + operate(op1) + ( + Trim$(Str$(cards(2) + operate(op2) + Trim$(Str$(cards(3) + ) + operate(op3) + Trim$(Str$(cards(4) + 若本行已有三个式子，就换行 If total Mod 3 = 0 Then Text1.Text = Text1.Text + Chr$(13) + Chr$(10) End If End If End If 4形如 a ( ( b c ) d ) 的表达式 answer1 = answer(cards(2), cards(3), op2) answer2 = answer(answer1, cards(4), op3) answer3 = answer(cards(1), answer2, op1) If answer1 -100 And answer2 -100 And answer3 -100 Then If Abs(answer3 - 24) zero Then nokey = False total = total + 1 Text1.Text = Text1.Text + Trim$(Str$(cards(1) + operate(op1) + ( + Trim$(Str$(cards(2) + operate(op2) + Trim$(Str$(cards(3) + ) + operate(op3) + Trim$(Str$(cards(4) + ) + 若本行已有三个式子，就换行 If total Mod 3 = 0 Then Text1.Text = Text1.Text + Chr$(13) + Chr$(10) End If End If End If 5形如 a ( b ( c d ) ) 的表达式 answer1 = answer(cards(3), cards(4), op3) answer2 = answer(cards(2), answer1, op2) answer3 = answer(cards(1), answer2, op1) If answer1 -100 And answer2 -100 And answer3 -100 Then If Abs(answer3 - 24) zero Then nokey = False total = total + 1 Text1.Text = Text1.Text + Trim$(Str$(cards(1) + operate(op1) + ( + Trim$(Str$(cards(2) + operate(op2) + ( + Trim$(Str$(cards(3) + operate(op3) + Trim$(Str$(cards(4) + ) + 若本行已有三个式子，就换行 If total Mod 3 = 0 Then Text1.Text = Text1.Text + Chr$(13) + Chr$(10) End If End If End If Next op3 Next op2 Next op1End SubCard1_MouseDown过程，按左键点击纸牌加1，按右键减1Private Sub Card1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Select Case Button 按左键 Case 1 If card(4) = 13 Then card(4) = 1 Else card(4) = card(4) + 1 End If 按右键 Case 2 If card(4) = 1 Then card(4) = 13 Else card(4) = card(4) - 1 End If End Select 随机产生变化后的花色 color = Int(Rnd() * 4) 重画纸牌 Call DrawCard(Me.hwnd, color * 13 + card(4), 10, 10)End SubCard2_MouseDown过程，按左键点击纸牌加1，按右键减1Private Sub Card2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Select Case Button 按左键 Case 1 If card(3) = 13 Then card(3) = 1 Else card(3) = card(3) + 1 End If 按右键 Case 2 If card(3) = 1 Then card(3) = 13 Else card(3) = card(3) - 1 End If End Select 随机产生变化后的花色 color = Int(Rnd() * 4) 重画纸牌 Call DrawCard(Me.hwnd, color * 13 + card(3), 10 + 85, 10)End SubCard3_MouseDown过程，按左键点击纸牌加1，按右键减1Private Sub Card3_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Select Case Button 按左键 Case 1 If card(2) = 13 Then card(2) = 1 Else card(2) = card(2) + 1 End If 按右键 Case 2 If card(2) = 1 Then card(2) = 13 Else card(2) = card(2) - 1 End If End Select 随机产生变化后的花色 color = Int(Rnd() * 4) 重画纸牌 Call DrawCard(Me.hwnd, color * 13 + card(2), 10 + 2 * 85, 10)End SubCard4_MouseDown过程，按左键点击纸牌加1，按右键减1Private Sub Card4_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Select Case Button 按左键 Case 1 If card(1) = 13 Then card(1) = 1 Else card(1) = card(1) + 1 End If 按右键 Case 2 If card(1) = 1 Then card(1) = 13 Else card(1) = card(1) - 1 End If End Select 随机产生变化后的花色 color = Int(Rnd() * 4) 重画纸牌 Call DrawCard(Me.hwnd, color * 13 + card(1), 10 + 3 * 85, 10)End SubCommand1_Click过程，点击洗牌按钮画出纸牌背面Private Sub Command1_Click() 随机产生纸牌背面的样式 color = Int(Rnd() * 6 + 1) 画出纸牌背面 Call DrawBack(Me.hwnd, color, 10, 10) Call DrawBack(Me.hwnd, color, 95, 10) Call DrawBack(Me.hwnd, color, 180, 10) Call DrawBack(Me.hwnd, color, 265, 10) 禁用答案按钮 Co