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

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

《24点游戏的算法参考与源程序.docx》由会员分享，可在线阅读，更多相关《24点游戏的算法参考与源程序.docx（15页珍藏版）》请在冰豆网上搜索。

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

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.（（a①b②）c③）2.（a①b）②（c③d）3.（a①（b②c））③d

4.a①（（b②c）③d）5.（a①b）②（c③d）6.a①（b②（c③d））

显然，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、改进程序的可玩性。

增加玩家输入表达式的功能，并判断对错，还可以加上时间限制，使玩家参与到游戏中。

三、程序框图

四、VB源程序代码

'需要声明所有用到的变量

OptionExplicit

'声明全局变量、数组

Dimcards（1To4）AsSingle,card（1To4）AsSingle

Dimresult（1To24,0To4）AsInteger,final（1To24,1To4）AsInteger,temp（1To24）AsLong

DimnokeyAsBoolean,totalAsInteger,n1AsInteger,n2AsInteger,n3AsInteger,n4AsInteger,aAsInteger,bAsInteger,cAsInteger,dAsInteger,op1AsInteger,op2AsInteger,op3AsInteger,answer1AsSingle,answer2AsSingle,answer3AsSingle,colorAsInteger

DimiAsInteger,jAsInteger,tAsInteger

'声明zero常量，设置0的标准，处理除法的精度问题

Constzero=0.00001

'初始化QCARD32.DLL

PrivateDeclareFunctionInitializeDeckLib"qcard32.dll"（ByValhwinAsLong）AsInteger

'DrawCard子程序，画出扑克牌图样在FORM窗体及窗体上的图片框

'用法：

'hwnd----需要画图的对象句柄

'nCard---扑克牌编号其编号如下

'1-13梅花14-26方块27-39红心40-52黑桃小王-110大王-111

'x，y位置

PrivateDeclareSubDrawCardLib"qcard32.dll"（ByValhwndAsLong,ByValnCardAsInteger,ByValxAsInteger,ByValyAsInteger）

'DrawBack子程序，画出扑克牌的背面图案，共六种按1--6编号

PrivateDeclareSubDrawBackLib"qcard32.dll"（ByValhwndAsLong,ByValnCardAsLong,ByValxAsLong,ByValyAsLong）

'GetCardSuit函数，求nCard的点数1-13

'PrivateDeclareFunctionGetCardSuitLib"qcard32.dll"（ByValnCardAsLong）AsLong

'GetCardValue函数，求nCard的花色0∶鬼牌1∶梅花2∶方块3∶红心4∶黑桃

'PrivateDeclareFunctionGetCardValueLib"qcard32.dll"（ByValnCardAsLong）AsLong

'Form_Load过程，初始化

PrivateSubForm_Load（）

RandomizeTimer

CallInitializeDeck（Me.hwnd）

Command3.Enabled=False

EndSub

'answer函数，返回x与y做operator运算后的值，-100为错误标志

PrivateFunctionanswer（xAsSingle,yAsSingle,operatorAsInteger）AsSingle

SelectCaseoperator

Case1

answer=x+y

ExitFunction

Case2

answer=x-y

ExitFunction

Case3

answer=x*y

ExitFunction

Case4

Ify=0Then

answer=-100

ExitFunction

Else

answer=x/y

ExitFunction

EndIf

EndSelect

answer=-100

EndFunction

'operate函数，返回数值op所对应的四则运算符号

PrivateFunctionoperate（opAsInteger）AsString

SelectCaseop

Case1

operate="+"

Case2

operate="-"

Case3

operate="*"

Case4

operate="/"

EndSelect

EndFunction

'search过程，去掉数组result中相同的元素，存入数组final中

PrivateSubsearch（）

Fori=1To24

result（i,0）=0

temp（i）=result（i,1）*14^3+result（i,2）*14^2+result（i,3）*14+result（i,4）

Nexti

Fori=1To23

Forj=i+1To24

Iftemp（i）=temp（j）Thenresult（i,0）=1

Nextj

Nexti

Fori=1To24

Ifresult（i,0）=1ThenGoTo1

t=t+1

Forj=1To4

final（t,j）=result（i,j）

Nextj

1Nexti

EndSub

'Main过程，用于计算四个数通过不同运算得到24的所有情况，并输出结果

PrivateSubMain（）

Forop1=1To4

Forop2=1To4

Forop3=1To4

'1·形如（a@b）@c）@d的表达式

answer1=answer（cards

（1）,cards

（2）,op1）

answer2=answer（answer1,cards（3）,op2）

answer3=answer（answer2,cards（4）,op3）

Ifanswer1<>-100Andanswer2<>-100Andanswer3<>-100Then

IfAbs（answer3-24）

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）））+""

'若本行已有三个式子，就换行

IftotalMod3=0Then

Text1.Text=Text1.Text+Chr$（13）+Chr$（10）

EndIf

EndIf

EndIf

'2·形如（a@b）@（c@d）的表达式

answer1=answer（cards

（1）,cards

（2）,op1）

answer2=answer（cards（3）,cards（4）,op3）

answer3=answer（answer1,answer2,op2）

Ifanswer1<>-100Andanswer2<>-100Andanswer3<>-100Then

IfAbs（answer3-24）

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）））+"）"+""

'若本行已有三个式子，就换行

IftotalMod3=0Then

Text1.Text=Text1.Text+Chr$（13）+Chr$（10）

EndIf

EndIf

EndIf

'3·形如（a@（b@c））@d的表达式

answer1=answer（cards

（2）,cards（3）,op2）

answer2=answer（cards

（1）,answer1,op1）

answer3=answer（answer2,cards（4）,op3）

Ifanswer1<>-100Andanswer2<>-100Andanswer3<>-100Then

IfAbs（answer3-24）

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）））+""

'若本行已有三个式子，就换行

IftotalMod3=0Then

Text1.Text=Text1.Text+Chr$（13）+Chr$（10）

EndIf

EndIf

EndIf

'4·形如a@（（b@c）@d）的表达式

answer1=answer（cards

（2）,cards（3）,op2）

answer2=answer（answer1,cards（4）,op3）

answer3=answer（cards

（1）,answer2,op1）

Ifanswer1<>-100Andanswer2<>-100Andanswer3<>-100Then

IfAbs（answer3-24）

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）））+"）"+""

'若本行已有三个式子，就换行

IftotalMod3=0Then

Text1.Text=Text1.Text+Chr$（13）+Chr$（10）

EndIf

EndIf

EndIf

'5·形如a@（b@（c@d））的表达式

answer1=answer（cards（3）,cards（4）,op3）

answer2=answer（cards

（2）,answer1,op2）

answer3=answer（cards

（1）,answer2,op1）

Ifanswer1<>-100Andanswer2<>-100Andanswer3<>-100Then

IfAbs（answer3-24）

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）））+"））"+""

'若本行已有三个式子，就换行

IftotalMod3=0Then

Text1.Text=Text1.Text+Chr$（13）+Chr$（10）

EndIf

EndIf

EndIf

Nextop3

Nextop2

Nextop1

EndSub

'Card1_MouseDown过程，按左键点击纸牌加1，按右键减1

PrivateSubCard1_MouseDown（ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle）

SelectCaseButton

'按左键

Case1

Ifcard（4）=13Then

card（4）=1

Else

card（4）=card（4）+1

EndIf

'按右键

Case2

Ifcard（4）=1Then

card（4）=13

Else

card（4）=card（4）-1

EndIf

EndSelect

'随机产生变化后的花色

color=Int（Rnd（）*4）

'重画纸牌

CallDrawCard（Me.hwnd,color*13+card（4）,10,10）

EndSub

'Card2_MouseDown过程，按左键点击纸牌加1，按右键减1

PrivateSubCard2_MouseDown（ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle）

SelectCaseButton

'按左键

Case1

Ifcard（3）=13Then

card（3）=1

Else

card（3）=card（3）+1

EndIf

'按右键

Case2

Ifcard（3）=1Then

card（3）=13

Else

card（3）=card（3）-1

EndIf

EndSelect

'随机产生变化后的花色

color=Int（Rnd（）*4）

'重画纸牌

CallDrawCard（Me.hwnd,color*13+card（3）,10+85,10）

EndSub

'Card3_MouseDown过程，按左键点击纸牌加1，按右键减1

PrivateSubCard3_MouseDown（ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle）

SelectCaseButton

'按左键

Case1

Ifcard

（2）=13Then

card

（2）=1

Else

card

（2）=card

（2）+1

EndIf

'按右键

Case2

Ifcard

（2）=1Then

card

（2）=13

Else

card

（2）=card

（2）-1

EndIf

EndSelect

'随机产生变化后的花色

color=Int（Rnd（）*4）

'重画纸牌

CallDrawCard（Me.hwnd,color*13+card

（2）,10+2*85,10）

EndSub

'Card4_MouseDown过程，按左键点击纸牌加1，按右键减1

PrivateSubCard4_MouseDown（ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle）

SelectCaseButton

'按左键

Case1

Ifcard

（1）=13Then

card

（1）=1

Else

card

（1）=card

（1）+1

EndIf

'按右键

Case2

Ifcard

（1）=1Then

card

（1）=13

Else

card

（1）=card

（1）-1

EndIf

EndSelect

'随机产生变化后的花色

color=Int（Rnd（）*4）

'重画纸牌

CallDrawCard（Me.hwnd,color*13+card

（1）,10+3*85,10）

EndSub

'Command1_Click过程，点击洗牌按钮画出纸牌背面

PrivateSubCommand1_Click（）

'随机产生纸牌背面的样式

color=Int（Rnd（）*6+1）

'画出纸牌背面

CallDrawBack（Me.hwnd,color,10,10）

CallDrawBack（Me.hwnd,color,95,10）

CallDrawBack（Me.hwnd,color,180,10）

CallDrawBack（Me.hwnd,color,265,10）

'禁用答案按钮

Command3.Enabled=False

EndSub

'Command2_Click过程，点击发牌按钮画出随机产生的纸牌

PrivateSubCommand2_Click（）

'清空答案

Text1.Text=""

'随机产生的纸牌，并画出

Fori=1To4

card（i）=Int（Rnd（）*13+1）

color=Int（Rnd（）*4）

CallDrawCard（Me.hwnd,color*13+card（i）,10+（4-i）*85,10）

Nexti

'开启答案按钮

Command3.Enabled=True

EndSub

'Command3_Click过程，点击答案按钮计算结果

PrivateSubCommand3_Click（）

'清空解的数量

Label1.Caption=""

'默认设置为无解

nokey=True

'解的计数器清零

total=0

'临时变量清零

i=0

j=0

t=0

'产生24种全排列

Forn1=1To4

Forn2=1To4

Ifn2=n1ThenGoTo2

Forn3=1To4

Ifn3=n1Orn3=n2ThenGoTo3

n4=10-n1-n2-n3

i=i+1

result（i,1）=card（n1）

result（i,2）