世界最难的数组怎么赋值

dongdonggege

爱疯 发表于 2019-2-15 10:15
http://club.excelhome.net/thread-1460844-1-1.html

昨天我也是第一次碰到的这情况，所以在问，等等 ...

我是win7系统32位，excel2003

aman1516

dongdonggege 发表于 2019-2-14 22:55
老师，辛苦，许多算式都能运行。让你浪费很多时间，再次说辛苦了。
提几点意见，别不高兴。
1、正确的 ...

很有意思，持续关注本贴：
楼主这个移动火柴要求的AI 级别不低，现时只针对个位数，及移动火柴一项，还有增加、减少的算法...（实际手动求解可能小学生都可以解答，用VBA编程就呵呵了...），特别是两位数起的+-*/四则运算，或者移动、减少、增加2根火柴，甚至3根火柴以上时，复杂程度是几何级数的增长啊（或者是本人水平太菜了）
另外，个人还是觉得，应根据规则，生成所有有解的题库，或加个判断，有解的才出题，游戏才好玩..如果原来 的等式就成立，变动后仍成立，就更牛了，只不知这样的题库有多少？
同时，跟解题的几位老师学习了，帮顶起一下

dongdonggege

aman1516 发表于 2019-2-15 14:27
很有意思，持续关注本贴：
楼主这个移动火柴要求的AI 级别不低，现时只针对个位数，及移动火柴一项，还 ...

谢谢关注！

西行之鱼

看了半天，赞同microyip的方法

爱疯

dongdonggege 发表于 2019-2-15 12:05
这版确实提高了不少!
1、好像也能做两位数了。
2、支持ppt的运行。

Option Explicit

'6+4=4
'答案1，0+4=4
'答案2，8-4=4

'依次是原式、原式的备份、原式被改变1次、结果
Dim ExpBk, Exp, Change1, Result
Dim SelfDic, AddDic, DelDic


'入口
Sub huocai()
    Dim i
    Call CreateData
    Exp = InputBox("移动一根火柴，使其成立", "", "3+6=3")
    Result = "原式：" & Exp & vbLf
    For i = 1 To Len(Exp)
        Call Mov(i, SelfDic)
        Call Mov(i, AddDic, True)
    Next i
    MsgBox IIf(Len(Result) > Len(Exp) + 5, Result, "没办法"), , "结果"
End Sub


'创建数据
Private Sub CreateData()

    Exp = ""
    ExpBk = ""
    Change1 = ""

    '1. 自变：改变自身，变为另一个数
    Set SelfDic = CreateObject("scripting.dictionary")
    SelfDic("0") = Array(6, 9)
    SelfDic("2") = Array(3)
    SelfDic("3") = Array(2, 5)
    SelfDic("5") = Array(3)
    SelfDic("6") = Array(0, 9)
    SelfDic("9") = Array(0, 6)
    SelfDic("+") = Array("=")
    SelfDic("=") = Array("+")

    '2-1. 可加：增加一根火柴，变为另一个数
    Set AddDic = CreateObject("scripting.dictionary")
    AddDic("0") = Array(8)
    AddDic("1") = Array(7)
    AddDic("3") = Array(9)
    AddDic("5") = Array(6, 9)
    AddDic("6") = Array(8)
    AddDic("9") = Array(8)
    AddDic("-") = Array("=", "+")

    '2-2. 可减：减少一根火柴，变为另一个数
    Set DelDic = CreateObject("scripting.dictionary")
    DelDic("6") = Array(5)
    DelDic("7") = Array(1)
    DelDic("8") = Array(0, 6, 9)
    DelDic("9") = Array(3)
    DelDic("+") = Array("-")
    DelDic("=") = Array("-")

End Sub


'移动(位置, 字典, 是否两次变化)
'Again的 Flase用于自变，True用于因变
Sub Mov(i, Dic, Optional Again As Boolean = False)
    Dim ch, t, j, k
    ch = Mid(Exp, i, 1)
    If Dic.exists(ch) Then
        t = Dic(ch)
        For j = LBound(t) To UBound(t)
            Change1 = Exp
            Mid(Change1, i, 1) = t(j)
            If Again Then
                ExpBk = Exp
                Exp = Change1
                For k = 1 To Len(Exp)
                    If k <> i Then Call Mov(k, DelDic)
                Next k
                Exp = ExpBk
            End If
            If IsEqual(Change1) Then Result = Result & vbLf & Change1
        Next j
    End If
End Sub


'判断等式两边的和，是否相等
Function IsEqual(str) As Boolean
    Dim A, B, i, j, str2
    If UBound(Split(str, "=")) = 1 Then
        str2 = Replace(str, "-", "+-")
        A = Split(str2, "=")
        For i = 0 To 1
            B = Split(A(i), "+")
            A(i) = 0
            For j = 0 To UBound(B)
                A(i) = Val(A(i)) + Val(B(j))
            Next j
        Next i
        IsEqual = A(0) = A(1)
    End If
End Function

36.rar (101.34 KB, 下载次数: 2)

2019-2-15 19:17 上传

点击文件名下载附件

好像避免了 3+6=3 的错误，但我还是不太清晰

dongdonggege

爱疯 发表于 2019-2-15 19:26
Option Explicit

'6+4=4

3+2=9-3能做了，但是上版好像能做等号一边是两位数，这次不能了。

爱疯

dongdonggege 发表于 2019-2-15 19:52
3+2=9-3能做了，但是上版好像能做等号一边是两位数，这次不能了。

A(i) = Val(A(i)) + Val(B(j))
改成原来之前写法
A(i) =A(i) + 0+B(j)


手机回的，没法试，可能是这个原因。
但当原式右边是负数时，分隔造成""，导致相加出错。对此，再想别的方式来避免。

爱疯

dongdonggege 发表于 2019-2-15 19:52
3+2=9-3能做了，但是上版好像能做等号一边是两位数，这次不能了。

37.rar (102.97 KB, 下载次数: 5)

2019-2-16 11:46 上传

点击文件名下载附件

dongdonggege

爱疯 发表于 2019-2-16 11:46

老师的钻研精神可敬！
1、7-11=4，2-3=1，出现重复的答案，前面的版本也出现。
2、14+1=11，正确：4+7=11，出现：没办法。
3、6+9=13，正确：5+8=13，8+5=13，6+9=15，出现：5+8=13，6+9=15，两个答案。

micch

14+1=11  怎么可能变成4+7=11  14变4那不是少了两根火柴？？7那才多了一根，还有一根去哪了？


个位数是变不成两位数的，两位数也变不成个位数，因为一个数字最少都是两根火柴