module2.bas

vb 24点计算.是一个智力小游戏

Attribute VB_Name = "OperatorModule"
Public iRndCardsNumber(4) As Single  '四张扑克的数值 即：四个1~13的数值
Public OperateorString As String   '此变量用于装表达式
'
'      给出四个数算出其结果为24的表达式

'                                      以下为24点算法
'    24点算法直觉上应该穷举表达式，然后求值。然而，由于括号的存在，使得穷表达式并非易
'事。实际上，括号的作用仅仅是提高+，-运算的优先级而已，如果我们显式地规定符号的优先级，
'一样可以完成任务。具体地说，假设给定的点数为a、b、c、d，运算符号为①、②、③，表达式
'如下：a① b ②c ③d
'     如果强制规定①、②、③的优先顺序，就不必考虑括号的添加和四则运算的优先级问题了。
'而3个运算符的运算顺序有3!=6种，分别写出来就是：
'  1.①②③   2.①③②    3.②①③   4.②③①    5.③①②   6.③②①
'而每种运算顺序的等价的表达式分别为：
'  1.((x①y)②z)③w   2.(x①y)②(z③w)  3.(x①(y②z))③w
'  4.x①((y②z)③w)   5.(x①y)②(z③w)  6.x①(y②(z③w))
'   显然2式和5式是等价的，因此只需考虑5种情况。这样括号的问题就解决了。
'   接着就很简单了，只要做出abcd的一组排列，按照运算符的优先级算出结果，最后和24比较
'就可以了。
'
'  由于上的算法问题，使得输出的每种表达式的格式都为：1.((x①y)②z)③w  2.(x①y)②(z③w)
'3.(x①(y②z))③w  4.x①((y②z)③w)  6.x①(y②(z③w)) 五种之一，这样就出现了多余的括号
'问题，我们必须解决这个问题 才能使得输出结果更加规范
'去除多余的括号 其思想为：先将四个括号都清空，看情况再给它添加上去

Function Operator() As Integer

Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim op1 As Integer
Dim op2 As Integer
Dim op3 As Integer

Dim answer1 As Single
Dim answer2 As Single
Dim answer3 As Single

Dim t1l As String, t1r As String, t2l As String, t2r As String '四个变量分别表示为：第一个左括号，第一个右括号，第二个左括号，第二个右括号

For a = 1 To 4                                                '得
  For b = 1 To 4                                              '到
    If b <> a Then                                            'abcd
      For c = 1 To 4                                          '的
         If (c <> a) And (c <> b) Then                        '组
          For d = 1 To 4                                      '合
           If (d <> a) And (d <> b) And (d <> c) Then         '共有4!=24种组合
           
             For op1 = 1 To 4           '
               For op2 = 1 To 4         '
                 For op3 = 1 To 4       '得到运算符的排序 共有4*4*4=64种
                   
                   '到处可以得到24*64=1536种表达式的排序顺序 而由于运算符的优先级问题，使得每种表达式又有
                   '5种的运算顺序 而最终就可以得到 1536*5=7680的输出情况，但我们就只需一种结果等于24的。
                 
                  '((x@y)@z)@w
                   '计算顺序为：
                   '1.answer1=x@y
                   '2.answer2=answer1@z
                   '3.answer3=anweer2@w
                   If caculate(iRndCardsNumber(a), iRndCardsNumber(b), op1, answer1) And caculate(answer1, iRndCardsNumber(c), op2, answer2) And caculate(answer2, iRndCardsNumber(d), op3, answer3) Then
                     If answer3 = 24 Then
                      '先将四个括号都清空，看情况再给它添加上去
                        t1l = ""
                        t1r = ""
                        t2l = ""
                        t2r = ""
                       '如果第一个运算符为+或- 且第二个运算为 *或/ 那么第二个括号必须不能少
                         If (operate(op1) = "+" Or operate(op1) = "-") And (operate(op2) = "*" Or operate(op2) = "/") Then
                            t2l = "("
                            t2r = ")"
                         End If
                       '如果第二个运算符为+或- 且第三个运算为 *或/ 那么第一个括号必须不能少
                         If (operate(op2) = "+" Or operate(op2) = "-") And (operate(op3) = "*" Or operate(op3) = "/") Then
                            t1l = "("
                            t1r = ")"
                         End If
                      
                        OperateorString = t1l + t2l + Trim(Str$(iRndCardsNumber(a))) + Trim(operate(op1)) + Trim(Str$(iRndCardsNumber(b))) + t2r + Trim(operate(op2)) + Trim(Str$(iRndCardsNumber(c))) + t1r + Trim(operate(op3)) + Trim(Str$(iRndCardsNumber(d))) '返回((x@y)@z)@w 格式的表达式，但此时这两个括号未必都还在
                        Operator = answer3
                        Exit Function '得到一种结果等于24的表达式，可以退出此函数了
                     End If
                   End If
                 
                 '(x@y)@(z@w)
                   '计算顺序为：
                   '1.answer1=x@y
                   '2.answer2=z@w
                   '3.answer3=answer1@answer2

                   If caculate(iRndCardsNumber(a), iRndCardsNumber(b), op1, answer1) And caculate(iRndCardsNumber(c), iRndCardsNumber(d), op3, answer2) And caculate(answer1, answer2, op2, answer3) Then
                     If answer3 = 24 Then
                        t1l = ""
                        t1r = ""
                        t2l = ""
                        t2r = ""
                       '如果第一个运算符为+或- 且第二个运算为 *或/ 那么第一个括号必须不能少
                        If (operate(op1) = "+" Or operate(op1) = "-") And (operate(op2) = "*" Or operate(op2) = "/") Then
                            t1l = "("
                            t1r = ")"
                         End If
                       '如果第三个运算符为+或- 且第二个运算为 *或/ 那么第二个括号必须不能少
                         If (operate(op3) = "+" Or operate(op3) = "-") And (operate(op2) = "*" Or operate(op2) = "/") Then
                            t2l = "("
                            t2r = ")"
                         End If
                      '如果第二个运算符为 - 且第三个运算为 *或/ 那么第二个括号必须不能少
                         If (operate(op2) = "-") And (operate(op3) = "+" Or operate(op3) = "-") Then
                            t2l = "("
                            t2r = ")"
                         End If
                      
                     OperateorString = t1l + Trim(Str$(iRndCardsNumber(a))) + Trim(operate(op1)) + Trim(Str$(iRndCardsNumber(b))) + t1r + Trim(operate(op2)) + t2l + Trim(Str$(iRndCardsNumber(c))) + Trim(operate(op3)) + Trim(Str$(iRndCardsNumber(d))) + t2r '返回表达式
                     Operator = answer3
                     Exit Function
                     End If
                   End If
                   
                   '(x@(y@z))@w
                   '计算顺序为：
                   '1.answer1=y@z
                   '2.answer2=x@answer1
                   '3.answer3=answer2@w

                    If caculate(iRndCardsNumber(b), iRndCardsNumber(c), op2, answer1) And caculate(iRndCardsNumber(a), answer1, op1, answer2) And caculate(answer2, iRndCardsNumber(d), op3, answer3) Then
                     If answer3 = 24 Then
                        t1l = ""
                        t1r = ""
                        t2l = ""
                        t2r = ""
                      '如果第一个运算符为/ 或者 第一个运算符为 * 且 第二个运算为+ 或 - 那么第二个括号都要留着
                        If (operate(op1) = "/") Or (operate(op1) = "*" And (operate(op2) = "+" Or operate(op2) = "-")) Then
                            t2l = "("
                            t2r = ")"
                        End If
                        
                        '如果第一个运算符为- 且第二个运算符为 + 或 - 那么第二个括号要留着
                         If (operate(op1) = "-") And (operate(op2) = "+" Or operate(op2) = "-") Then
                            t2l = "("
                            t2r = ")"
                         End If
                         
                       '如果第一个运算符为+或- 且 第三个运算符为 * 或 / 那么第一个括号要留着
                        If (operate(op1) = "+" Or operate(op1) = "-") And (operate(op3) = "*" Or operate(op3) = "/") Then
                            t1l = "("
                            t1r = ")"
                        End If
                        
                     OperateorString = t1l + Trim(Str$(iRndCardsNumber(a))) + Trim(operate(op1)) + t2l + Trim(Str$(iRndCardsNumber(b))) + Trim(operate(op2)) + Trim(Str$(iRndCardsNumber(c))) + t2r + t1r + Trim(operate(op3)) + Trim(Str$(iRndCardsNumber(d)))
                     Operator = answer3
                     Exit Function
                     End If
                   End If
                   
                   'x@((y@z)@w)
                   '计算顺序为：
                   '1.answer1=y@z
                   '2.answer2=answer1@w
                   '3.answer3=x@answer2

                    If caculate(iRndCardsNumber(b), iRndCardsNumber(c), op2, answer1) And caculate(answer1, iRndCardsNumber(d), op3, answer2) And caculate(iRndCardsNumber(a), answer2, op1, answer3) Then
                     If answer3 = 24 Then
                        t1l = ""
                        t1r = ""
                        t2l = ""
                        t2r = ""
                        '如果第二个运算符为+或- 且第三个运算为 *或/ 那么第二个括号必须不能少
                          If (operate(op2) = "+" Or operate(op2) = "-") And (operate(op3) = "*" Or operate(op3) = "/") Then
                            t2l = "("
                            t2r = ")"
                          End If
                         '如果第一个运算符为/ 或者 第一个运算符为 * 且第三个运算为 +或- 那么第一个括号必须不能少
                          If (operate(op1) = "/") Or (operate(op1) = "*" And (operate(op3) = "+" Or operate(op3) = "-")) Then
                            t1l = "("
                            t1r = ")"
                          End If
                         '如果第一个运算符为 - 且 第三个运算符为 + 或 - 那么第二个括号不能少
                         If (operate(op1) = "-") And (operate(op3) = "+" Or operate(op3) = "-") Then
                            t2l = "("
                            t2r = ")"
                         End If
                     
                     
                     OperateorString = Trim(Str$(iRndCardsNumber(a))) + Trim(operate(op1)) + t1l + t2l + Trim(Str$(iRndCardsNumber(b))) + Trim(operate(op2)) + Trim(Str$(iRndCardsNumber(c))) + t2r + Trim(operate(op3)) + Trim(Str$(iRndCardsNumber(d))) + t1r
                     Operator = answer3
                     Exit Function
                     End If
                    End If
                    
                   'x@(y@(z@w))
                   '计算顺序为：
                   '1.answer1=z@w
                   '2.answer2=y@answer1
                   '3.answer3=x@answer2

                     If caculate(iRndCardsNumber(c), iRndCardsNumber(d), op3, answer1) And caculate(iRndCardsNumber(b), answer1, op2, answer2) And caculate(iRndCardsNumber(a), answer2, op1, answer3) Then
                       If answer3 = 24 Then
                        t1l = ""
                        t1r = ""
                        t2l = ""
                        t2r = ""
                         '如果第一个运算符为 / 或者 第一个运算符为 * 且第二个运算符为+或- 那么都不能少第一个括号
                           If (operate(op1) = "/") Or (operate(op1) = "*" And (operate(op2) = "+" Or operate(op2) = "-")) Then
                            t1l = "("
                            t1r = ")"
                          End If
                          
                        '如果第一个运算符为 - 且 第二个运算符不为 * 或 / 那么第一个括号不能少
                         If (operate(op1) = "-") And (operate(op2) <> "*" Or operate(op2) <> "/") Then
                            t1l = "("
                            t1r = ")"
                         End If
                         '如果第二个运算符为 / 或者 第二个运算符为 * 且第三个运算符为+或- 那么都不能少第二个括号
                          If (operate(op2) = "/") Or (operate(op2) = "*" And (operate(op3) = "+" Or operate(op3) = "-")) Then
                            t2l = "("
                            t2r = ")"
                          End If
                       
                         '如果第二个运算符为 - 且 第三个运算符为 + 或 - 那么第二个括号不能少
                         If (operate(op2) = "-") And (operate(op3) = "+" Or operate(op3) = "-") Then
                            t2l = "("
                            t2r = ")"
                         End If
                       OperateorString = Trim(Str$(iRndCardsNumber(a))) + Trim(operate(op1)) + t1l + Trim(Str$(iRndCardsNumber(b))) + Trim(operate(op2)) + t2l + Trim(Str$(iRndCardsNumber(c))) + Trim(operate(op3)) + Trim(Str$(iRndCardsNumber(d))) + t2r + t1r
                       Operator = answer3
                       Exit Function
                       End If
                     End If
                     
                   Next op3
                Next op2
               Next op1
             End If
           Next d
          End If
        Next c
      End If
    Next b
  Next a
Operator = answer3  '如果程序执行到此处 那么所给的点数将是一种无解的状态
End Function

'answer= X Operator Y
Function caculate(X As Single, Y As Single, Operator As Integer, answer As Single) As Boolean
Select Case Operator
 Case 1
  On Error GoTo DOERROR
  answer = X + Y
 Case 2
  On Error GoTo DOERROR
  answer = X - Y
 Case 3
  On Error GoTo DOERROR
  answer = X * Y
 Case 4
  On Error GoTo DOERROR
  If Y = 0 Then  '被除数不能为0
   caculate = False
   Exit Function
   Else
   answer = X / Y
   End If
End Select
DOERROR:
  If Err.Number = 6 Then
   caculate = False
  End If
   caculate = True
End Function
'返回一个运算符
Function operate(op As Integer) As String
Select Case op
 Case 1
   operate = "+"
 Case 2
   operate = "-"
 Case 3
    operate = "*"
 Case 4
    operate = "/"
End Select
End Function