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

12244点点游游戏戏的的算算法法与与源源程程序序一、任务说明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))③d4.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、改进程序的可玩性。增加玩家输入表达式的功能，并判断对错，还可以加上时间限制，使玩家参与到游戏中。三、程序框图2NextiNextj设置重复排列的标志result(i,0)=1计数器t=t+1Nexti将全排列所对应的十进制数存入temp(1..24)随机产生四张扑克牌3重循环产生24种全排列全排列循环终止排列存入数组result(1..24,1..4)初始化重复排列的标志result(1..24,0)=0Fori=1to24初始化变量、数组Fori=1to23Forj=i+1to24比较temp(i)与temp(j)是否相等YN3Fori=1tot检验result(i,0)标志是否为1NY把result存入finalNexti循环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中的排列输出解的个数或无解结束4四、VB源程序代码'需要声明所有用到的变量OptionExplicit'声明全局变量、数组Dimcards(1To4)AsSingle,card(1To4)AsSingleDimresult(1To24,0To4)AsInteger,final(1To24,1To4)AsInteger,temp(1To24)AsLongDimnokeyAsBoolean,totalAsInteger,n1AsInteger,n2AsInteger,n3AsInteger,n4AsInteger,aAsInteger,bAsInteger,cAsInteger,dAsInteger,op1AsInteger,op2AsInteger,op3AsInteger,answer1AsSingle,answer2AsSingle,answer3AsSingle,colorAsIntegerDimiAsInteger,jAsInteger,tAsInteger'声明zero常量，设置0的标准，处理除法的精度问题Constzero=0.00001'初始化QCARD32.DLLPrivateDeclareFunctionInitializeDeckLibqcard32.dll(ByValhwinAsLong)AsInteger'DrawCard子程序，画出扑克牌图样在FORM窗体及窗体上的图片框'用法：'hwnd----需要画图的对象句柄'nCard---扑克牌编号其编号如下'1-13梅花14-26方块27-39红心40-52黑桃小王-110大王-111'x，y位置PrivateDeclareSubDrawCardLibqcard32.dll(ByValhwndAsLong,ByValnCardAsInteger,ByValxAsInteger,ByValyAsInteger)'DrawBack子程序，画出扑克牌的背面图案，共六种按1--6编号PrivateDeclareSubDrawBackLibqcard32.dll(ByValhwndAsLong,ByValnCardAsLong,ByValxAsLong,ByValyAsLong)'GetCardSuit函数，求nCard的点数1-13'PrivateDeclareFunctionGetCardSuitLibqcard32.dll(ByValnCardAsLong)AsLong'GetCardValue函数，求nCard的花色0∶鬼牌1∶梅花2∶方块3∶红心4∶黑桃'PrivateDeclareFunctionGetCardValueLibqcard32.dll(ByValnCardAsLong)AsLong'Form_Load过程，初始化PrivateSubForm_Load()RandomizeTimerCallInitializeDeck(Me.hwnd)Command3.Enabled=FalseEndSub5'answer函数，返回x与y做operator运算后的值，-100为错误标志PrivateFunctionanswer(xAsSingle,yAsSingle,operatorAsInteger)AsSingleSelectCaseoperatorCase1answer=x+yExitFunctionCase2answer=x-yExitFunctionCase3answer=x*yExitFunctionCase4Ify=0Thenanswer=-100ExitFunctionElseanswer=x/yExitFunctionEndIfEndSelectanswer=-100EndFunction'operate函数，返回数值op所对应的四则运算符号PrivateFunctionoperate(opAsInteger)AsStringSelectCaseopCase1operate=+Case2operate=-Case3operate=*Case4operate=/EndSelectEndFunction'search过程，去掉数组result中相同的元素，存入数组final中PrivateSubsearch()Fori=1To24result(i,0)=0temp(i)=result(i,1)*14^3+result(i,2)*14^2+result(i,3)*14+result(i,4)6NextiFori=1To23Forj=i+1To24Iftemp(i)=temp(j)Thenresult(i,0)=1NextjNextiFori=1To24Ifresult(i,0)=1ThenGoTo1t=t+1Forj=1To4final(t,j)=result(i,j)Nextj1NextiEndSub'Main过程，用于计算四个数通过不同运算得到24的所有情况，并输出结果PrivateSubMain()Forop1=1To4Forop2=1To4Forop3=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-100ThenIfAbs(answer3-24)zeroThennokey=Falsetotal=total+1Text1.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=0ThenText1.Text=Text1.Text+Chr$(13)+Chr$(10)EndIfEndIfEndIf'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-100Then7IfAbs(answer3-24)zeroThennokey=Falsetotal=total+1Text1.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=0ThenText1.Text=Text1.Text+Chr$(13)+Chr$(10)EndIfEndIfEndIf'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-100ThenIfAbs(answer3-24)zeroThennokey=Falsetotal=total+1Text1.Text=Text1.Text+(+Trim$(Str$(cards(1)))+operate