| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1959 人关注过本帖
标题:24 点问题
只看楼主 加入收藏
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
结帖率:100%
收藏
已结贴  问题点数:1 回复次数:29 
24 点问题
在想,如何列出 24 点的所有答案,或者说 给 4个数,然后给出是否组合成 24 点。想啊想,就想到先把表达式列出来,然后再测试。代码如下:
程序代码:
Option Explicit

'工程需要引用microsoft script control

Dim rs As String                '所有的表达式

Private Sub Command1_Click()
'列出所有的可能
Dim a As Long, b As Long, c As Long, d As Long
Dim s As String
Dim FJ() As String


Open App.Path & "\24点.txt" For Output As #1

For a = 1 To 10
For b = 1 To 10
For c = 1 To 10
For d = 1 To 10

    s = Test24(a, b, c, d)          '测试去
    If Len(s) > 0 Then
        Print #1, s;                '有结果就写入,因为结果是带回车的,所以不能再写入回车了
    End If
    
Next d
Next c
Next b
Next a

Close #1
MsgBox "计算完成!请检查 24点.txt 文件。", vbInformation

End Sub

Private Sub Command2_Click()
'测试4个数
Dim s2 As String
Dim a As Long, b As Long, c As Long, d As Long

'先读数
a = Val(IntTXT(0))
b = Val(IntTXT(1))
c = Val(IntTXT(2))
d = Val(IntTXT(3))

'判断范围
If a < 0 Or a > 10 Then Exit Sub
If b < 0 Or b > 10 Then Exit Sub
If c < 0 Or c > 10 Then Exit Sub
If d < 0 Or d > 10 Then Exit Sub

Text1.Text = "运算中..."
DoEvents
    
'按排列组合去测试
s2 = s2 & Test24(a, b, c, d)
s2 = s2 & Test24(a, b, d, c)
s2 = s2 & Test24(a, c, b, d)
s2 = s2 & Test24(a, c, d, b)
s2 = s2 & Test24(a, d, b, c)
s2 = s2 & Test24(a, d, c, b)

s2 = s2 & Test24(b, a, c, d)
s2 = s2 & Test24(b, a, d, c)
s2 = s2 & Test24(b, c, d, a)
s2 = s2 & Test24(b, c, a, d)
s2 = s2 & Test24(b, d, a, c)
s2 = s2 & Test24(b, d, c, a)

s2 = s2 & Test24(c, b, a, d)
s2 = s2 & Test24(c, b, d, a)
s2 = s2 & Test24(c, a, b, d)
s2 = s2 & Test24(c, a, d, b)
s2 = s2 & Test24(c, d, b, a)
s2 = s2 & Test24(c, d, a, b)

s2 = s2 & Test24(d, b, c, a)
s2 = s2 & Test24(d, b, a, c)
s2 = s2 & Test24(d, c, b, a)
s2 = s2 & Test24(d, c, a, b)
s2 = s2 & Test24(d, a, b, c)
s2 = s2 & Test24(d, a, c, b)

'检查测试结果
If Len(s2) > 0 Then
    Text1.Text = s2
Else
    Text1.Text = "无解!"
End If

End Sub

Private Sub Form_Load()

    Open App.Path & "\表达式.txt" For Binary As #1
        rs = StrConv(InputB$(LOF(1), #1), vbUnicode)
    Close #1
    
End Sub

Public Function Test24(a As Long, b As Long, c As Long, d As Long) As String

Dim s As String
Dim o As Long
Dim m As Long
Dim s2 As String
Dim FJ() As String

Dim ScriptControl1 As New scriptcontrol
ScriptControl1.Language = "VBScript"

s = rs                          '所有的表达式
s = Replace(s, "a", a)          '把数字填进去
s = Replace(s, "b", b)
s = Replace(s, "c", c)
s = Replace(s, "d", d)

FJ = Split(s, vbCrLf)           '分解成一个一个的表达式
For o = 0 To UBound(FJ)
    If Len(FJ(o)) > 0 Then      '是有效表达式
        m = ScriptControl1.Eval(FJ(o))      '运算
        If m = 24 Then                      '结果是24吗
            s2 = s2 & FJ(o) & " = 24" & vbCrLf
        End If
    End If
Next o

Test24 = s2                     '返回结果

End Function
搜索更多相关主题的帖子: 表达式 如何 
2015-06-14 21:23
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
我想出来的表达式有:

程序代码:
a + b + c + d 
a + b + c - d 

a * b + c + d 
a * b * c + d 

a * b + c - d 
a * b * c - d 

a * b - c - d 

(a + b) * c + d
(a + b) * c - d
(a + b) * (c + d)
(a + b) * (c - d)

(a - b) * c + d
(a - b) * c - d
(a - b) * (c + d)
(a - b) * (c - d)

(a + b) * c * d
(a + b) * c / d

(a - b) * c * d
(a - b) * c / d

保存为txt文件,放到工程一起。

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-14 21:24
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:1 
这是个遍历算法问题,给你一个思路,看行不行。
首先四个数的全排列,保存入1个24行,4列的2维数组中,以后的每次计算按序取其中1行的4个数。
构建1个递归函数。完成2个数的运算,2个数有2种排列,考虚到首位可能有负号,操作符有2*4=8种,因此2个数运算有16种结果。
得到前2个数结果后,有2个分支,第1个是将结果继续和第3个数运算,得到16*16种结果,再和第4个数运算得到16*16*16种结果;第2个分支是,第1、2个数得到的16种结果和第3、第4个数运算的16种结果再进行2个数的计算。
有了思路一步一步来,有问题再一起讨论。

大开眼界
2015-06-15 08:54
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
我也就是想过这个问题,所以把 算法的排列写到文本里面去。
修改TEST24函数,以便支持注释
程序代码:
Public Function Test24(a As Long, b As Long, c As Long, d As Long) As String
On Error Resume Next

Dim s As String
Dim o As Long
Dim m As Long
Dim s2 As String
Dim FJ() As String

Dim ScriptControl1 As New ScriptControl
ScriptControl1.Language = "VBScript"

s = rs                          '所有的表达式
s = Replace(s, "a", a)          '把数字填进去
s = Replace(s, "b", b)
s = Replace(s, "c", c)
s = Replace(s, "d", d)

FJ = Split(s, vbCrLf)           '分解成一个一个的表达式
For o = 0 To UBound(FJ)
    If Len(FJ(o)) > 0 Then    '是有效表达式
        If Left(FJ(o), 1) <> ";" Then           '非注释
            m = ScriptControl1.Eval(FJ(o))      '运算
            If m = 24 Then                      '结果是24吗
                s2 = s2 & FJ(o) & " = 24" & vbCrLf
            End If
        End If
    End If
Next o

Test24 = s2                     '返回结果

End Function


按照你说的,我重新排列过了表达式:
(a + b) + (c + d)
(a + b) + (c - d)
(a + b) + (c * d)
(a + b) + (c / d)

(a - b) + (c + d)
(a - b) + (c - d)
(a - b) + (c * d)
(a - b) + (c / d)

(a * b) + (c + d)
(a * b) + (c - d)
(a * b) + (c * d)
(a * b) + (c / d)

(a / b) + (c + d)
(a / b) + (c - d)
(a / b) + (c * d)
(a / b) + (c / d)

(a + b) - (c + d)
(a + b) - (c - d)
(a + b) - (c * d)
(a + b) - (c / d)

(a - b) - (c + d)
(a - b) - (c - d)
(a - b) - (c * d)
(a - b) - (c / d)

(a * b) - (c + d)
(a * b) - (c - d)
(a * b) - (c * d)
(a * b) - (c / d)

(a / b) - (c + d)
(a / b) - (c - d)
(a / b) - (c * d)
(a / b) - (c / d)

(a + b) * (c + d)
(a + b) * (c - d)
(a + b) * (c * d)
(a + b) * (c / d)

(a - b) * (c + d)
(a - b) * (c - d)
(a - b) * (c * d)
(a - b) * (c / d)

(a * b) * (c + d)
(a * b) * (c - d)
(a * b) * (c * d)
(a * b) * (c / d)

(a / b) * (c + d)
(a / b) * (c - d)
(a / b) * (c * d)
(a / b) * (c / d)

(a + b) / (c + d)
(a + b) / (c - d)
(a + b) / (c * d)
(a + b) / (c / d)

(a - b) / (c + d)
(a - b) / (c - d)
(a - b) / (c * d)
(a - b) / (c / d)

(a * b) / (c + d)
(a * b) / (c - d)
(a * b) / (c * d)
(a * b) / (c / d)

(a / b) / (c + d)
(a / b) / (c - d)
(a / b) / (c * d)
(a / b) / (c / d)

((a + b) + c) + d
((a + b) + c) - d
((a + b) + c) * d
((a + b) + c) / d

((a - b) + c) + d
((a - b) + c) - d
((a - b) + c) * d
((a - b) + c) / d

((a * b) + c) + d
((a * b) + c) - d
((a * b) + c) * d
((a * b) + c) / d

((a / b) + c) + d
((a / b) + c) - d
((a / b) + c) * d
((a / b) + c) / d

((a + b) - c) + d
((a + b) - c) - d
((a + b) - c) * d
((a + b) - c) / d

((a - b) - c) + d
((a - b) - c) - d
((a - b) - c) * d
((a - b) - c) / d

((a * b) - c) + d
((a * b) - c) - d
((a * b) - c) * d
((a * b) - c) / d

((a / b) - c) + d
((a / b) - c) - d
((a / b) - c) * d
((a / b) - c) / d

((a + b) * c) + d
((a + b) * c) - d
((a + b) * c) * d
((a + b) * c) / d

((a - b) * c) + d
((a - b) * c) - d
((a - b) * c) * d
((a - b) * c) / d

((a * b) * c) + d
((a * b) * c) - d
((a * b) * c) * d
((a * b) * c) / d

((a / b) * c) + d
((a / b) * c) - d
((a / b) * c) * d
((a / b) * c) / d

((a + b) / c) + d
((a + b) / c) - d
((a + b) / c) * d
((a + b) / c) / d

((a - b) / c) + d
((a - b) / c) - d
((a - b) / c) * d
((a - b) / c) / d

((a * b) / c) + d
((a * b) / c) - d
((a * b) / c) * d
((a * b) / c) / d

((a / b) / c) + d
((a / b) / c) - d
((a / b) / c) * d
((a / b) / c) / d


仔细考虑一下,还是使用这种写好了的表达式来检索好写程序。如果把这些算法写到程序里,会好烦好烦,太多分支了。
如果是 发布的工程,可以使用 资源编辑器,写到程序内部去。

[ 本帖最后由 风吹过b 于 2015-6-15 11:57 编辑 ]

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-15 11:32
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
还有如:
a+(b+c)+d
a+(b+c)-d
a+(b+c)*d
a+(b+c)/d

可以转化为
(b+c)+d+a
(b+c)-d+a
(b+c)*d+a
(b+c)/d+a

因为 程序里会把 abcd 互换位置,所以这种的排列就没有意义了。

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-15 11:35
wmf2014
Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19
等 级:贵宾
威 望:216
帖 子:2039
专家分:11273
注 册:2014-12-6
收藏
得分:1 
个人觉得还是穷举吧,顶多根据交换律规则加个判断,去除相同的式子。
另:abcd有上下限吧,肯定不能为0.

能编个毛线衣吗?
2015-06-15 13:44
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
按我最后排列的 表达式来穷举的。

如果是 输入的4个数。
范围判断在这:
'先读数
a = Val(IntTXT(0))
b = Val(IntTXT(1))
c = Val(IntTXT(2))
d = Val(IntTXT(3))

'判断范围
If a < 0 Or a > 10 Then Exit Sub
If b < 0 Or b > 10 Then Exit Sub
If c < 0 Or c > 10 Then Exit Sub
If d < 0 Or d > 10 Then Exit Sub

这4个数,按 24种排列,代入这些表达式求值。
'按排列组合去测试
s2 = s2 & Test24(a, b, c, d)
s2 = s2 & Test24(a, b, d, c)
s2 = s2 & Test24(a, c, b, d)
s2 = s2 & Test24(a, c, d, b)
s2 = s2 & Test24(a, d, b, c)
s2 = s2 & Test24(a, d, c, b)

s2 = s2 & Test24(b, a, c, d)
s2 = s2 & Test24(b, a, d, c)
s2 = s2 & Test24(b, c, d, a)
s2 = s2 & Test24(b, c, a, d)
s2 = s2 & Test24(b, d, a, c)
s2 = s2 & Test24(b, d, c, a)

s2 = s2 & Test24(c, b, a, d)
s2 = s2 & Test24(c, b, d, a)
s2 = s2 & Test24(c, a, b, d)
s2 = s2 & Test24(c, a, d, b)
s2 = s2 & Test24(c, d, b, a)
s2 = s2 & Test24(c, d, a, b)

s2 = s2 & Test24(d, b, c, a)
s2 = s2 & Test24(d, b, a, c)
s2 = s2 & Test24(d, c, b, a)
s2 = s2 & Test24(d, c, a, b)
s2 = s2 & Test24(d, a, b, c)
s2 = s2 & Test24(d, a, c, b)

如果是 测试所有的结果:
那 就不区分 24种组合了,因为四层循环,就会使所有的可能都会去测试。
For a = 1 To 10
For b = 1 To 10
For c = 1 To 10
For d = 1 To 10

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-15 16:48
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:0 
回复 4楼 风吹过b
遍历,递归对wmf2014版主来说肯定是小菜一碟。
我按3楼的思路写了一个,很初步,没有完善,包括输出重复的情况。脑子早就不好使了,转递归转不出来,就没有采用。
"~-"表示两数交换位置相减,"~/"表示两数交换位置相除。
程序代码:
Option Explicit
Dim DataTab(1 To 4, 1 To 24) As Single
Dim Orgin(1 To 4) As Single


Private Sub Command1_Click()
  Dim i As Integer
  Dim temp() As String
  Text1.Text = ""
  temp = Split(Text2.Text, " ")
  For i = 0 To UBound(temp)
    Orgin(i + 1) = Val(temp(i))
  Next
  permutation
  For i = 1 To 24
    Getone (i)
  Next

End Sub
Sub permutation() 'Get all permutation of Orgin to DataTab
  Dim i As Integer
  Dim j As Integer
  Dim m As Integer
  Dim n As Integer
  Dim k As Integer
  k = 1
  For i = 1 To 4
    For j = 1 To 4
      If j <> i Then
        For m = 1 To 4
          If m <> i And m <> j Then
            For n = 1 To 4
              If n <> i And n <> j And n <> m Then
                DataTab(1, k) = Orgin(i): DataTab(2, k) = Orgin(j): DataTab(3, k) = Orgin(m): DataTab(4, k) = Orgin(n)
                k = k + 1
              End If
            Next
          End If
        Next
      End If
    Next
  Next
End Sub

Private Sub Form_Load()
  Dim i As Integer
  Me.Show

 

End Sub

Sub calculate(ByVal x As Single, ByVal y As Single, output() As Single)
  ReDim output(1 To 6) As Single
  output(1) = x + y
  output(2) = x - y
  output(3) = x * y
  If y = 0 Then
    output(4) = 99.99
    Else
     output(4) = x / y
  End If
  output(5) = y - x
  If x = 0 Then
    output(6) = 99.99
  Else
    output(6) = y / x
  End If
End Sub

Function Convert(a As Integer) As String
  Select Case a
    Case Is = 1
      Convert = "+"
    Case Is = 2
      Convert = "-"
    Case Is = 3
      Convert = "*"
    Case Is = 4
      Convert = "/"
    Case Is = 5
      Convert = "~-"
    Case Is = 6
      Convert = "~/"
    Case Is = 0
      Convert = "~/"
  End Select
End Function

Sub Getone(x As Integer) 'Get outputs of x row
  Dim i As Integer
  Dim j As Integer
  Dim k As Integer
  Dim temp21() As Single
  Dim temp22() As Single
  Dim temp23() As Single
  Dim temp3() As Single
  Dim temp4() As Single
  Dim temp() As Single
  
  ReDim temp21(1 To 6) 'Combination of 1 and 2
  calculate DataTab(1, x), DataTab(2, x), temp21

 
  ReDim temp22(1 To 6) 'combination of 3 and 4
  calculate DataTab(3, x), DataTab(4, x), temp22

  ReDim temp23(1 To 216) 'combination of temp21 and temp22
  For i = 1 To 6
    For j = 1 To 6
      calculate temp21(i), temp22(j), temp
      For k = 1 To 6
        temp23(36 * (i - 1) + 6 * (j - 1) + k) = temp(k)
      Next
    Next
  Next
  For i = 1 To 216
    If temp23(i) = 24 Then
      Text1.Text = Text1.Text & "(" & DataTab(1, x) & Convert(1 + Int((i - 1) / 36)) & DataTab(2, x) & ")" & Convert(i Mod 6) & "(" & DataTab(3, x) & Convert(1 + Int(((i Mod 36) - 1) / 6)) & DataTab(4, x) & ")" & vbCrLf
    End If
  Next
  


 
  ReDim temp3(1 To 36) 'combination of temp21 and 3
 
  For i = 1 To 6
    calculate temp21(i), DataTab(3, x), temp
    For j = 1 To 6
      temp3(6 * (i - 1) + j) = temp(j)
    Next
  Next


 
  ReDim temp4(1 To 216) 'combination of temp3 and 4
  For i = 1 To 36
    calculate temp3(i), DataTab(4, x), temp
    For j = 1 To 6
      temp4(6 * (i - 1) + j) = temp(j)
    Next
  Next

  For i = 1 To 216
    If temp4(i) = 24 Then
      Text1.Text = Text1.Text & "((" & DataTab(1, x) & Convert(1 + Int((i - 1) / 36)) & DataTab(2, x) & ")" & Convert(1 + Int(((i Mod 36) - 1) / 6)) & DataTab(3, x) & ")" & Convert(i Mod 6) & DataTab(4, x) & vbCrLf
    End If
  Next
   
End Sub

 

大开眼界
2015-06-15 17:17
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
回复 8楼 边小白
24点的规则是:

4个 1-10 的数字,可以重复。使用四则运算符,可以使用括号,计算出 24 来。

临时去掉数据范围得出来的结果,里面有因为取整造成错误的情况,看来要修正程序。
((7 / 12) * 10) + 18 = 24
((7 * 10) / 12) + 18 = 24
(7 + 18) - (12 / 10) = 24
(7 + 18) - (10 / 12) = 24
((10 * 7) / 12) + 18 = 24
((10 / 12) * 7) + 18 = 24
((10 * 18) - 12) / 7 = 24
(18 + 7) - (10 / 12) = 24
(18 + 7) - (12 / 10) = 24
((18 * 10) - 12) / 7 = 24

修正的结果为 浮点数,得到了是:
((18 * 10) - 12) / 7 = 24
((10 * 18) - 12) / 7 = 24

[ 本帖最后由 风吹过b 于 2015-6-15 17:28 编辑 ]

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-15 17:27
vbyou126
Rank: 1
等 级:新手上路
帖 子:6
专家分:0
注 册:2015-4-27
收藏
得分:0 
有更厉害的算法,
2015-06-16 17:36
快速回复:24 点问题
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.058189 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved