| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1959 人关注过本帖
标题:24 点问题
只看楼主 加入收藏
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4941
专家分:30047
注 册:2008-10-15
收藏
得分:0 
不考虑交换,按二种情况写过了,现在写成了模块。代码如下:

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
    For j = 1 To 4
        If r1(i).v >= 0 And r2(i).v >= 0 Then
            Call operation(r1(j), r2(i), 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
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

Test24_2 = s

End Function

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

Dim t As Single

'加法
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 & " - " & b.s & " )"
Else
    r(2).v = -1
End If

'乘法
r(3).v = a.v * b.v
r(3).s = "( " & a.s & " * " & b.s & " )"

'除法,只允许整除
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 = "( " & a.s & " / " & b.s & " )"
    Else
        r(4).v = -1
    End If
   
Else
    r(4).v = -1
End If

End Sub


如输入 1 2 3 4
结果为:
( ( 1 * 2 ) * ( 3 * 4 ) ) = 24
( ( ( 1 + 2 ) + 3 ) * 4 ) = 24
( ( ( 1 * 2 ) * 3 ) * 4 ) = 24
( ( 1 * 2 ) * ( 4 * 3 ) ) = 24
( ( ( 1 * 2 ) * 4 ) * 3 ) = 24
( ( 1 + 3 ) * ( 2 + 4 ) ) = 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 * 3 ) * 4 ) * 2 ) = 24
( ( 1 * 4 ) * ( 2 * 3 ) ) = 24
( ( ( 1 * 4 ) * 2 ) * 3 ) = 24
( ( 1 * 4 ) * ( 3 * 2 ) ) = 24
( ( ( 1 * 4 ) * 3 ) * 2 ) = 24
( ( 2 * 1 ) * ( 3 * 4 ) ) = 24
( ( 2 / 1 ) * ( 3 * 4 ) ) = 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 * 1 ) * 4 ) * 3 ) = 24
( ( ( 2 / 1 ) * 4 ) * 3 ) = 24
( ( 2 * 3 ) * ( 4 * 1 ) ) = 24
( ( ( 2 * 3 ) * 4 ) * 1 ) = 24
( ( ( 2 * 3 ) * 4 ) / 1 ) = 24
( ( 2 * 3 ) * ( 1 * 4 ) ) = 24
( ( ( 2 + 3 ) + 1 ) * 4 ) = 24
( ( ( 2 * 3 ) * 1 ) * 4 ) = 24
( ( ( 2 * 3 ) / 1 ) * 4 ) = 24
( ( 2 + 4 ) * ( 1 + 3 ) ) = 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
( ( ( 2 * 4 ) * 3 ) / 1 ) = 24
( ( 3 * 2 ) * ( 1 * 4 ) ) = 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 * 2 ) * 4 ) / 1 ) = 24
( ( 3 + 1 ) * ( 2 + 4 ) ) = 24
( ( 3 * 1 ) * ( 2 * 4 ) ) = 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 * 1 ) * 4 ) * 2 ) = 24
( ( ( 3 / 1 ) * 4 ) * 2 ) = 24
( ( 3 * 4 ) * ( 2 * 1 ) ) = 24
( ( ( 3 * 4 ) * 2 ) * 1 ) = 24
( ( ( 3 * 4 ) * 2 ) / 1 ) = 24
( ( 3 * 4 ) * ( 1 * 2 ) ) = 24
( ( ( 3 * 4 ) * 1 ) * 2 ) = 24
( ( ( 3 * 4 ) / 1 ) * 2 ) = 24
( ( 4 + 2 ) * ( 3 + 1 ) ) = 24
( ( 4 * 2 ) * ( 3 * 1 ) ) = 24
( ( 4 * 2 ) * ( 3 / 1 ) ) = 24
( ( ( 4 * 2 ) * 3 ) * 1 ) = 24
( ( ( 4 * 2 ) * 3 ) / 1 ) = 24
( ( 4 + 2 ) * ( 1 + 3 ) ) = 24
( ( 4 * 2 ) * ( 1 * 3 ) ) = 24
( ( ( 4 * 2 ) * 1 ) * 3 ) = 24
( ( ( 4 * 2 ) / 1 ) * 3 ) = 24
( ( 4 * 3 ) * ( 2 * 1 ) ) = 24
( ( ( 4 * 3 ) * 2 ) * 1 ) = 24
( ( ( 4 * 3 ) * 2 ) / 1 ) = 24
( ( 4 * 3 ) * ( 1 * 2 ) ) = 24
( ( ( 4 * 3 ) * 1 ) * 2 ) = 24
( ( ( 4 * 3 ) / 1 ) * 2 ) = 24
( ( 4 * 1 ) * ( 2 * 3 ) ) = 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 / 1 ) * 3 ) * 2 ) = 24

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-16 22:33
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4941
专家分:30047
注 册:2008-10-15
收藏
得分:0 
手工对比了一下, 使用表达式时,运算过程中出现负数。而使用算法时,可以把负数丢弃。
如果出现负数时,后面有交换过结果来运算的情况,也不需要,答案更适合小学生看了。
运算速度,算法快很多很多。 不错。

为什么我不考虑 交换呢。是因为我调用时,会把这4个数 重新排列组合 24 种进行调用,所以不需要考虑交换的问题。
为什么这么多的括号,是为了排版的表示运算的先后。

增加去重功能。先要把多余的括号干掉,然后再来去重。 其中,如果是加法的话,去括号就很烦,需要修改运算函数的组合算法。
'去掉括号之间的空格
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 = 1 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 = 1 To UBound(fj)
    If Len(fj(i)) > 0 Then
        s = s & fj(i) & vbCrLf
    End If
Next i


r(3).s = "  " & a.s & " * " & b.s & "  "

        r(4).s = "  " & a.s & " / " & b.s & "  "

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-16 22:58
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:0 
回复 12楼 风吹过b
必须考虑两数交换的减和除。因为按我贴的代码的第2种情况,首先是第1和第2个数运算,得到的结果再和第3个数运算...
不交换就不能出现(c¤(a¤b))¤d 其中¤是任意运算符.
比如5 5 5 1。
按我贴的代码输出是((5~/1)~-5)*5
转化正规输出是(5-(1/5))*5

按12楼代码就不能出现结果

我贴的代码用列表的方法把运算结果都包含了,继续要做的只是代码优化和输出格式化的问题

大开眼界
2015-06-17 08:55
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4941
专家分:30047
注 册:2008-10-15
收藏
得分:0 
我明确要排除计算过程中的非整数。

(5-(1/5))*5
这里面:1/5 ,得到的小数,我计算过程中就会丢弃。

你说这种情况,先计算 2和3,然后再结合 1 ,再结合 4 ,
如果是1@(2?3) 1和2、3做 减法,除法,我前面是没有涉及到。这点是我考虑不周。

按我前面的调用方法,我确实不需要考虑交换
如:(假设不丢弃 非整数 )
5 5 1 5 ,你可以得出  (5-(1/5))*5 这种情况,我得不出。
但我 后面调用里,有  5 1 5 5 这个调用,,如果补充算法后,我就得出这个式子了。

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-17 09:49
wmf2014
Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19
等 级:贵宾
威 望:216
帖 子:2039
专家分:11273
注 册:2014-12-6
收藏
得分:0 
回复 17楼 风吹过b
复制了你的代码,我怎么只拿到3个算式?
( ( 1 * 2 ) * ( 3 * 4 ) ) = 24
( ( ( 1 + 2 ) + 3 ) * 4 ) = 24
( ( ( 1 * 2 ) * 3 ) * 4 ) = 24

能编个毛线衣吗?
2015-06-17 10:39
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4941
专家分:30047
注 册:2008-10-15
收藏
得分:0 
调用代码在这。在调用代码里 组合的。

'测试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_2(a, b, c, d)
s2 = s2 & Test24_2(a, b, d, c)
s2 = s2 & Test24_2(a, c, b, d)
s2 = s2 & Test24_2(a, c, d, b)
s2 = s2 & Test24_2(a, d, b, c)
s2 = s2 & Test24_2(a, d, c, b)

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

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

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

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

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-17 10:53
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4941
专家分:30047
注 册:2008-10-15
收藏
得分:0 
模块完整的代码:
程序代码:
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


'去掉括号之间的空格
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 = 1 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

Test24_2 = s

End Function

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

Dim t As Single

'加法
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 & " - " & b.s & " )"
Else
    r(2).v = -1
End If

'乘法
r(3).v = a.v * b.v
'r(3).s = "( " & a.s & " * " & b.s & " )"
r(3).s = "  " & a.s & " * " & b.s & "  "

'除法,只允许整除
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 = "( " & a.s & " / " & b.s & " )"
        r(4).s = "  " & a.s & " / " & b.s & "  "
    Else
        r(4).v = -1
    End If
    
Else
    r(4).v = -1
End If

End Sub


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

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-17 10:54
wmf2014
Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19
等 级:贵宾
威 望:216
帖 子:2039
专家分:11273
注 册:2014-12-6
收藏
得分:0 
还是只有3个,另5,6,7,8没有答案,应该有(5+7-8)*6=24
1 * 2 * 3 * 4 = 24
 (( 1 + 2 ) + 3 ) * 4 = 24
 ( 1 + ( 2 + 3 ) ) * 4 = 24

即使是1,2,3,4应该还有(1+3)*(4+2)的组合

[ 本帖最后由 wmf2014 于 2015-6-17 11:29 编辑 ]

能编个毛线衣吗?
2015-06-17 11:19
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4941
专家分:30047
注 册:2008-10-15
收藏
得分:0 
你看一下我 19楼 的调用代码,我是调用了 24次。

我函数分工∶调用过程中完成变换,test24 完成当前4个数的组合,然后另一个函数负责计算。

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-17 11:27
wmf2014
Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19
等 级:贵宾
威 望:216
帖 子:2039
专家分:11273
注 册:2014-12-6
收藏
得分:0 
回复 22楼 风吹过b
嗯,知道额,不过你(5,6,7,8)的确无解,你测试下。

能编个毛线衣吗?
2015-06-17 11:36
快速回复:24 点问题
数据加载中...
 
   



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

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