| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 2978 人关注过本帖, 1 人收藏
标题:24点问题我写的完整代码
只看楼主 加入收藏
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
结帖率:100%
收藏(1)
已结贴  问题点数:100 回复次数:10 
24点问题我写的完整代码
首先,感谢 lianyicq 的提醒和例子。
再次,感谢 wmf2014 的测试。
开个百分散分贴,两位版主进来接分。

24点问题的规则:刚百度了一下,发现我前面搞错了范围。但以前在 计算器上玩的时候只有 一位数。
规则:给出4个数字,所给数字均为有整数(1至13之间),用加、减、乘、除(可加括号)把给出的数算成24,每个数必须用一次且只能用一次。
我们一般计算过程中,不能在计算过程出现小数、负数 ,只能出现自然数(包括 0 )。
现在,平时,可以考虑几个人用扑克玩一会儿,特别陪着孩子玩,很开动脑筋的。
========================
窗体:控件:
Label ,四个,用于提示 输入4个值。当然,按 一次性输入 ,之间用空格输入也是可以了。
 我标签的 Caption  分别是:&A= 、&B=、&C=、&D= ,可以用键盘 ALT+A、B、C、D 在这四个输入框中任何切换。
IntTxt :TextBox ,控件数组,下标从 0 到 3,对应 四个值。
Command1:CommandButton,求解按钮,  Caption:求解
Text1:TextBox,显示结果用,MultiLine =True(允许多行) ;ScrollBars =2(竖滚动条)

---------------窗体代码---------------------
程序代码:
Option Explicit
Private Sub Command1_Click()
'测试4个数
Dim s As String
Dim a(0 To 4) As Long
Dim i As Long, j As Long, k As Long, o As Long

For i = 0 To 3
    If Not IsNumeric(IntTXT(i)) Then Exit Sub           '输入的不是数字
    a(i) = Val(IntTXT(i))
    If a(i) < 0 Or a(i) > 13 Then Exit Sub
Next i

Text1.Text = "运算中..."
DoEvents

For i = 0 To 3
    For j = 0 To 3
        For k = 0 To 3
            For o = 0 To 3
                If j <> i And k <> j And k <> i And o <> i And o <> j And o <> k Then      '之间全不相同,则去运算
                    s = s & Test24_2(a(i), a(j), a(k), a(o))
                End If
            Next o
        Next k
    Next j
Next i

'去掉括号之间的空格
s = Replace(s, "( (", "((")

'去多余的空格
Do
    i = Len(s)
    s = Replace(s, "  ", " ")
Loop While Len(s) <> i

'去重
Dim fj() As String
'分行
fj = Split(s, vbCrLf)

'扫描
For i = 0 To UBound(fj)
    For j = i + 1 To UBound(fj)
        If fj(i) = fj(j) Then       '扫描到后面有相同的
            fj(j) = ""              '后面的清空
        End If
    Next j
Next i
'重新组合,不能使用 join 函数是因为有空行在
s = ""
For i = 0 To UBound(fj)
    If Len(fj(i)) > 0 Then
        s = s & fj(i) & vbCrLf
    End If
Next i

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

Private Sub IntTXT_GotFocus(Index As Integer)
'获得焦点时选中所有的文本
With IntTXT(Index)
    .SelStart = 0
    .SelLength = Len(.Text)
End With
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
'全选和复制
If Shift = 2 Then                   '经测试,Ctrl =2
    If KeyCode = vbKeyA Then
        Text1.SelStart = 0
        Text1.SelLength = Len(Text1.Text)
    ElseIf KeyCode = vbKeyC Then
        Clipboard.Clear
        Clipboard.SetText Text1.Text
    Else
        KeyCode = 0
    End If
End If
End Sub


----------------模块代码---------------------
程序代码:
Option Explicit

Public Type T24type
    s As String         '用来组合的表达式或单变量
    v As Long           '计算用的值
End Type

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

Dim r1(4) As T24type, r2(4) As T24type, r3(4) As T24type
Dim l1 As T24type, l2 As T24type
Dim l3 As T24type, l4 As T24type
Dim i As Long, j As Long, m As Long
Dim s As String

'第一个数
l1.s = CStr(a)
l1.v = a
'第二个数
l2.s = CStr(b)
l2.v = b
'第三个数
l3.s = CStr(c)
l3.v = c
'第四个数
l4.s = CStr(d)
l4.v = d

'第一个数与第二个数计算
Call operation(l1, l2, r1)

'第一分支,第1、2数运算后与第3、4数运算

'第三个数与第四个数计算
Call operation(l3, l4, r2)
For i = 1 To 4
    If r1(i).v > 0 Then
        For j = 1 To 4
            If r2(j).v >= 0 Then
                Call operation(r1(i), r2(j), r3)
                For m = 1 To 4
                    If r3(m).v = 24 Then
                        s = s & r3(m).s & " = 24" & vbCrLf
                    End If
                Next m
            End If
        Next j
    End If
Next i

'第二分支,第1、2数运算后与第3数运算,再与第4数运算
For i = 1 To 4
    If r1(i).v >= 0 Then
        Call operation(r1(i), l3, r2)
        For j = 1 To 4
            If r2(j).v >= 0 Then
                Call operation(r2(j), l4, r3)
                For m = 1 To 4
                    If r3(m).v = 24 Then
                        s = s & r3(m).s & " = 24" & vbCrLf
                    End If
                Next m
            End If
        Next j
    End If
Next i

'先第2、3数运算后,再与第1数运算,第4数运算。
Call operation(l2, l3, r1)
For i = 1 To 4
    If r1(i).v > 0 Then
        Call operation(l1, r1(i), r2)
        For j = 1 To 4
            If r2(j).v > 0 Then
                Call operation(r2(j), l4, r3)
                For m = 1 To 4
                    If r3(m).v = 24 Then
                        s = s & r3(m).s & " = 24" & vbCrLf
                    End If
                Next m
            End If
        Next j
    End If
Next i

'先第2、3数运算后,再与第4数运算,第1数运算。
Call operation(l2, l3, r1)
For i = 1 To 4
    If r1(i).v > 0 Then
        Call operation(r1(i), l4, r2)
        For j = 1 To 4
            If r2(j).v > 0 Then
                Call operation(l1, r2(j), r3)
                For m = 1 To 4
                    If r3(m).v = 24 Then
                        s = s & r3(m).s & " = 24" & vbCrLf
                    End If
                Next m
            End If
        Next j
    End If
Next i

'先第3、4数运算后,再与第2数运算,第1数运算。
Call operation(l3, l4, r1)
For i = 1 To 4
    If r1(i).v > 0 Then
        Call operation(l2, r1(i), r2)
        For j = 1 To 4
            If r2(j).v > 0 Then
                Call operation(l1, r2(j), r3)
                For m = 1 To 4
                    If r3(m).v = 24 Then
                        s = s & r3(m).s & " = 24" & vbCrLf
                    End If
                Next m
            End If
        Next j
    End If
Next i

Test24_2 = s
End Function

Public Sub operation(a As T24type, b As T24type, r() As T24type)

Dim t As Single
Dim s1 As String, s2 As String

'如果前一次没做乘除法,并且是表达式,则先加好括号,留给 减 乘 除 用
If Len(a.s) > 2 And (InStr(1, a.s, "+") > 0 Or InStr(1, a.s, "-") > 0) Then      '>2,是因为10=2,而表达式,去掉空格也最少=3
    s1 = "( " & a.s & " )"
Else
    s1 = a.s
End If

If Len(b.s) > 2 And (InStr(1, b.s, "+") > 0 Or InStr(1, b.s, "-") > 0) Then
    s2 = "( " & b.s & " )"
Else
    s2 = b.s
End If

'加法
r(1).v = a.v + b.v
r(1).s = " " & a.s & " + " & b.s & " "

'减法,不考虑负数
If a.v > b.v Then
    r(2).v = a.v - b.v
    r(2).s = " " & a.s & " - " & s2 & " "
Else
    r(2).v = -1
End If

'乘法
r(3).v = a.v * b.v
r(3).s = "  " & s1 & " * " & s2 & "  "          '使用可能增加了括号的表达式组合

'除法,只允许整除
If a.v >= b.v And b.v > 0 Then
    If a.v Mod b.v = 0 Then
        r(4).v = a.v / b.v
        r(4).s = "  " & s1 & " / " & s2 & "  "  '使用可能增加了括号的表达式组合
    Else
        r(4).v = -1
    End If
Else
    r(4).v = -1
End If

End Sub


[ 本帖最后由 风吹过b 于 2015-6-18 22:57 编辑 ]
搜索更多相关主题的帖子: 自然数 百度 计算器 
2015-06-18 22:52
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
完整工程:
24点3.rar (3.63 KB)


部分测试结果:
------1 2 3 4 --------
1 * 2 * 3 * 4 = 24
( 1 + 2 + 3 ) * 4 = 24
1 * 2 * 4 * 3 = 24
( 1 + 3 ) * ( 2 + 4 ) = 24
1 * 3 * 2 * 4 = 24
( 1 + 3 + 2 ) * 4 = 24
( 1 + 3 ) * ( 4 + 2 ) = 24
1 * 3 * 4 * 2 = 24
1 * 4 * 2 * 3 = 24
1 * 4 * 3 * 2 = 24
2 * 1 * 3 * 4 = 24
2 / 1 * 3 * 4 = 24
( 2 + 1 + 3 ) * 4 = 24
2 * 1 * 4 * 3 = 24
2 / 1 * 4 * 3 = 24
2 * 3 * 1 * 4 = 24
( 2 + 3 + 1 ) * 4 = 24
2 * 3 / 1 * 4 = 24
2 * 3 * 4 * 1 = 24
2 * 3 * 4 / 1 = 24
( 2 + 4 ) * ( 1 + 3 ) = 24
2 * 4 * 1 * 3 = 24
2 * 4 / 1 * 3 = 24
( 2 + 4 ) * ( 3 + 1 ) = 24
2 * 4 * 3 * 1 = 24
2 * 4 * 3 / 1 = 24
( 3 + 1 ) * ( 2 + 4 ) = 24
3 * 1 * 2 * 4 = 24
3 / 1 * 2 * 4 = 24
( 3 + 1 + 2 ) * 4 = 24
( 3 + 1 ) * ( 4 + 2 ) = 24
3 * 1 * 4 * 2 = 24
3 / 1 * 4 * 2 = 24
3 * 2 * 1 * 4 = 24
( 3 + 2 + 1 ) * 4 = 24
3 * 2 / 1 * 4 = 24
3 * 2 * 4 * 1 = 24
3 * 2 * 4 / 1 = 24
3 * 4 * 1 * 2 = 24
3 * 4 / 1 * 2 = 24
3 * 4 * 2 * 1 = 24
3 * 4 * 2 / 1 = 24
4 * 1 * 2 * 3 = 24
4 / 1 * 2 * 3 = 24
4 * ( 1 + 2 + 3 ) = 24
4 * 1 * 3 * 2 = 24
4 / 1 * 3 * 2 = 24
4 * ( 1 + 3 + 2 ) = 24
( 4 + 2 ) * ( 1 + 3 ) = 24
4 * 2 * 1 * 3 = 24
4 * 2 / 1 * 3 = 24
4 * ( 2 + 1 + 3 ) = 24
( 4 + 2 ) * ( 3 + 1 ) = 24
4 * 2 * 3 * 1 = 24
4 * 2 * 3 / 1 = 24
4 * ( 2 + 3 + 1 ) = 24
4 * 3 * 1 * 2 = 24
4 * 3 / 1 * 2 = 24
4 * ( 3 + 1 + 2 ) = 24
4 * 3 * 2 * 1 = 24
4 * 3 * 2 / 1 = 24
4 * ( 3 + 2 + 1 ) = 24

------3 4 5 6-----------
( 3 + 5 - 4 ) * 6 = 24
( 5 + 3 - 4 ) * 6 = 24
( 5 - 4 + 3 ) * 6 = 24
( 5 - ( 4 - 3 ) ) * 6 = 24
6 * ( 3 + 5 - 4 ) = 24
6 * ( 5 - ( 4 - 3 ) ) = 24

[ 本帖最后由 风吹过b 于 2015-6-18 22:58 编辑 ]

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-18 22:53
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:50 
只能说风版做得太认真了,要求也高。
我只有佩服的份儿。

对输出去重感觉不简单,留给感兴趣的坛友们完善吧。

大开眼界
2015-06-19 08:48
wmf2014
Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19
等 级:贵宾
威 望:216
帖 子:2039
专家分:11273
注 册:2014-12-6
收藏
得分:50 
接分来了!

能编个毛线衣吗?
2015-06-19 08:49
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:0 
把"*"换为 "×" ,"/"换为 "÷"
更通用

如果加checkbox可以指定中间过程能否出现负数和小数。

[ 本帖最后由 lianyicq 于 2015-6-19 09:41 编辑 ]

大开眼界
2015-06-19 09:38
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
昨天晚上,修改了这几个地方:
一、调用,还是写了一个 嵌套循环来循环调用。
二、括号问题。把加括号放到后一步的计算中去。以前都是放到第一次计算里,现在放到后一次的计算里,根据前一次的运算符,来决定是不是给前一次的值加括号。避免了多余气括号问题。
三、去重问题。我在得到所有输出结果后再扫描去重的。
四、算法问题。增加先计算 3和4,再与 2,与1 计算。 以防止漏掉 如  6*8/(5-3) 这种情况。

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-19 09:41
yaozhiwen
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2015-6-17
收藏
得分:0 
2015-06-20 09:37
a814153
Rank: 2
等 级:论坛游民
威 望:1
帖 子:13
专家分:24
注 册:2011-6-9
收藏
得分:0 
3/(1-7/8)=24
2016-01-09 13:21
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
已明确计算过程中不得出现负数和小数。

授人于鱼,不如授人于渔
早已停用QQ了
2016-01-09 19:31
lalawo
Rank: 1
等 级:新手上路
帖 子:10
专家分:0
注 册:2009-6-14
收藏
得分:0 
十多年前编过,这个还行吧!赞一个!!不过,5551,3377 3388好像算不出来
2018-04-14 23:17
快速回复:24点问题我写的完整代码
数据加载中...
 
   



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

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