用VBA求解一个含有九个未知variables的方程的蛮力方法
当试图解决越南八岁儿童的math难题时，出现这个等式： a+(13*b/c)+d+(12*e)-f+(g*h/i)=87互联网。 在math中，这样一个方程被称为欠定系统 。 当然，它有不止一个解决scheme，蛮力方法似乎是find所有解决scheme的最简单的方法。
我有兴趣知道如何使用VBA解决方程，并将解决scheme展示在MS Excel工作表中，因为由于缺乏VBA编程知识，无法find制作此类程序的方法。
我知道堆栈溢出像这样和这个类似的post，但那里的答案不帮我很多。
这是我的尝试：
Sub Vietnam_Problem() Dim StartTime As Double StartTime = Timer j = 2 'initial value for number of rows For a = 1 To 9 For b = 1 To 9 For c = 1 To 9 For d = 1 To 9 For e = 1 To 9 For f = 1 To 9 For g = 1 To 9 For h = 1 To 9 For i = 1 To 9 If a <> b And a <> c And a <> d And a <> e And a <> f And a <> g And a <> h And a <> i And b <> c And b <> d And b <> e And b <> f And b <> g And b <> h And b <> i And c <> d And c <> e And c <> f And c <> g And c <> h And c <> i And d <> e And d <> f And d <> g And d <> h And d <> i And e <> f And e <> g And e <> h And e <> i And f <> g And f <> h And f <> i And g <> h And g <> i And h <> i And a + (13 * b / c) + d + (12 * e) - f + (g * h / i) = 87 Then Cells(j, 1) = a Cells(j, 2) = b Cells(j, 3) = c Cells(j, 4) = d Cells(j, 5) = e Cells(j, 6) = f Cells(j, 7) = g Cells(j, 8) = h Cells(j, 9) = i j = j + 1 End If Next i Next h Next g Next f Next e Next d Next c Next b Next a Cells(2, 11) = j - 2 'number of solutions Cells(2, 12) = Round(Timer - StartTime, 2) 'running time of VBA code End Sub
它似乎工作，但不是很好，很慢。
Anastasiya-Romanova秀，因为你没有声明variables（a到j），你的代码运行与默认为Varianttypes的variables。 虽然变体可以是非常有用的，他们不应该在这里使用。
我的代码保持不变，在我的机器上完成了851秒。
由于VBA针对Longs进行了优化，因此只需将一行代码添加到代码中，将variables（a到j）声明为Long，便可将运行时间降至120秒。 所以这只是使用适当的variablestypes的七倍！
我在刺中解决这个难题在VBA运行相当快。 实际上，它比这个页面上发布的任何东西都要快得多（也比较短）。 在同一台机器上，它在不到一秒的时间内返回所有136个正确的组合。
那里有很多废话（世界，网页，甚至在这个页面上！）关于VBA太慢了。 不要相信。 当然，编译语言可以更快，但大部分时间归结为你如何知道如何处理你的语言。 自20世纪70年代以来，我一直使用BASIC语言进行编程。
这是我为您的问题制作的越南难题的解决scheme。 请把它放在一个新的代码模块中：
Option Explicit Private z As Long, v As Variant Public Sub Vietnam() Dim s As String s = "123456789" ReDim v(1 To 200, 1 To 9) Call FilterPermutations("", s) [a1:i200] = v End End Sub Private Sub FilterPermutations(s1 As String, s2 As String) Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long, _ g As Long, h As Long, i As Long, j As Long, m As Long, n As Long n = Len(s2) If n < 2 Then a = Mid$(s1, 1, 1): b = Mid$(s1, 2, 1): c = Mid$(s1, 3, 1) d = Mid$(s1, 4, 1): e = Mid$(s1, 5, 1): f = Mid$(s1, 6, 1) g = Mid$(s1, 7, 1): h = Mid$(s1, 8, 1): i = s2 If a + (13 * b / c) + d + (12 * e) - f + (g * h / i) = 87 Then z = z + 1 v(z, 1) = a: v(z, 2) = b: v(z, 3) = c v(z, 4) = d: v(z, 5) = e: v(z, 6) = f v(z, 7) = g: v(z, 8) = h: v(z, 9) = i End If Else For m = 1 To n FilterPermutations s1 + Mid$(s2, m, 1), Left$(s2, m - 1) + Right$(s2, n - m) Next End If End Sub
方法2：
阿纳斯塔西娅，今天晚些时候我会试着解释一下，当我有更多的时间。 但在此期间，请检查我的下一个刺。 现在甚至更短，大约1/10秒完成。 我现在正在使用堆的置换algorithm：
Option Explicit Private z As Long, v As Variant Public Sub VietnamHeap() Dim a(0 To 8) As Long a(0) = 1: a(1) = 2: a(2) = 3: a(3) = 4: a(4) = 5: a(5) = 6: a(6) = 7: a(7) = 8: a(8) = 9 ReDim v(1 To 200, 1 To 9) Generate 9, a [a1:i200] = v End End Sub Sub Generate(n As Long, a() As Long) Dim t As Long, i As Long If n = 1 Then If a(0) + (13 * a(1) / a(2)) + a(3) + (12 * a(4)) - a(5) + (a(6) * a(7) / a(8)) = 87 Then z = z + 1 For i = 1 To 9: v(z, i) = a(i - 1): Next End If Else For i = 0 To n - 2 Generate n - 1, a If n Mod 2 = 1 Then t = a(0): a(0) = a(n - 1): a(n - 1) = t Else t = a(i): a(i) = a(n - 1): a(n - 1) = t End If Next Generate n - 1, a End If End Sub
方法＃3
这是一个更短的版本。 任何人都可以拿出更短的版本或更快的版本？
Const q = 9 Dim z As Long, v(1 To 999, 1 To q) Public Sub VietnamHeap() Dim a(1 To q) As Long For z = 1 To q: a(z) = z: Next: z = 0 Gen q, a [a1].Resize(UBound(v), q) = v: End End Sub Sub Gen(n As Long, a() As Long) Dim i As Long, k As Long, t As Long If n > 1 Then For i = 1 To n - 1 Gen n - 1, a If n Mod 2 = 1 Then k = 1 Else k = i t = a(k): a(k) = a(n): a(n) = t Next Gen n - 1, a Else If 87 = a(1) + 13 * a(2) / a(3) + a(4) + 12 * a(5) - a(6) + a(7) * a(8) / a(9) Then z = z + 1: For i = 1 To q: v(z, i) = a(i): Next End If End Sub
我要提交另一个答案，但自从我的最后一个答案是相当基础的，我刚刚覆盖它。 这仍然使用蒙特卡罗风格的随机数的方法，但是当你必须确定你还没有用这个随机数组合解决时，它会变得有点笨拙。
Sub MonteCarlo() Dim startTime As Single startTime = Timer Dim trialSol As Double Dim solCounter As Integer solCounter = 0 Dim trialNums() As Integer Dim solutions As Collection Set solutions = New Collection Dim existingSol As Boolean existingSol = False Do trialNums = CreateRandomArray trialSol = ToSolve(trialNums(1), trialNums(2), _ trialNums(3), trialNums(4), _ trialNums(5), trialNums(6), _ trialNums(7), trialNums(8), _ trialNums(9)) If trialSol = 87 Then If Not ExistsIn(solutions, trialNums) Then solutions.Add (trialNums) End If End If Loop Until (solutions.Count = 128) Dim solutionTime As Single solutionTime = Round(Timer - startTime, 5) Dim i As Integer For i = 1 To solutions.Count Debug.Print "Solution " & i & ":"; vbTab; _ solutions.Item(i)(1); vbTab; _ solutions.Item(i)(2); vbTab; _ solutions.Item(i)(3); vbTab; _ solutions.Item(i)(4); vbTab; _ solutions.Item(i)(5); vbTab; _ solutions.Item(i)(6); vbTab; _ solutions.Item(i)(7); vbTab; _ solutions.Item(i)(8); vbTab; _ solutions.Item(i)(9) Next i Debug.Print "Solution time: " & solutionTime & " ms" End Sub Function ExistsIn(col As Collection, arr() As Integer) As Boolean Dim ei As Boolean ei = False Dim i As Integer Dim temparr() As Integer If col.Count > 0 Then For i = 1 To col.Count temparr = col.Item(i) ei = AreEqual(temparr, arr) Next i End If ExistsIn = ei End Function Function AreEqual(array1() As Integer, array2() As Integer) As Boolean Dim eq As Boolean eq = True For i = LBound(array1) To UBound(array1) If array1(i) <> array2(i) Then eq = False Exit For End If Next i AreEqual = eq End Function Function ToSolve(a As Integer, b As Integer, _ c As Integer, d As Integer, _ e As Integer, f As Integer, _ g As Integer, h As Integer, _ i As Integer) As Double ToSolve = a + (13 * b / c) + d + (12 * e) - f + (g * h / i) End Function Function CreateRandomArray() As Integer() Dim numbers As New Collection Dim i As Integer For i = 1 To 9 numbers.Add i Next i Dim rndNums(9) As Integer Dim rndInd As Integer For i = 1 To 9 rndInt = CInt(((numbers.Count - 1) * Rnd) + 1) rndNums(i) = numbers(rndInt) numbers.Remove (rndInt) Next i CreateRandomArray = rndNums End Function
我所有组合的解决scheme时间大约是3s – 3.5s。
好的，这是我的尝试：
Sub Vietnam_Problem() Dim StartTime As Double StartTime = Timer j = 2 'initial value for number of rows For a = 1 To 9 For b = 1 To 9 For c = 1 To 9 For d = 1 To 9 For e = 1 To 9 For f = 1 To 9 For g = 1 To 9 For h = 1 To 9 For i = 1 To 9 If a <> b And a <> c And a <> d And a <> e And a <> f And a <> g And a <> h And a <> i And b <> c And b <> d And b <> e And b <> f And b <> g And b <> h And b <> i And c <> d And c <> e And c <> f And c <> g And c <> h And c <> i And d <> e And d <> f And d <> g And d <> h And d <> i And e <> f And e <> g And e <> h And e <> i And f <> g And f <> h And f <> i And g <> h And g <> i And h <> i And a + (13 * b / c) + d + (12 * e) - f + (g * h / i) = 87 Then Cells(j, 1) = a Cells(j, 2) = b Cells(j, 3) = c Cells(j, 4) = d Cells(j, 5) = e Cells(j, 6) = f Cells(j, 7) = g Cells(j, 8) = h Cells(j, 9) = i j = j + 1 End If Next i Next h Next g Next f Next e Next d Next c Next b Next a Cells(2, 11) = j - 2 'number of solutions Cells(2, 12) = Round(Timer - StartTime, 2) 'running time of VBA code End Sub
这似乎工作，但正如我在我的问题下面的评论部分中提到，这不是很好，很慢。
输出：
abcdefghi 1 2 6 4 7 8 3 5 9 1 2 6 4 7 8 5 3 9 1 3 2 4 5 8 7 9 6 1 3 2 4 5 8 9 7 6 1 3 2 9 5 6 4 7 8 1 3 2 9 5 6 7 4 8 1 3 4 7 6 5 2 9 8 1 3 4 7 6 5 9 2 8 1 3 6 2 7 9 4 5 8 1 3 6 2 7 9 5 4 8 1 3 9 4 7 8 2 5 6 1 3 9 4 7 8 5 2 6 1 4 8 2 7 9 3 5 6 1 4 8 2 7 9 5 3 6 1 5 2 3 4 8 7 9 6 1 5 2 3 4 8 9 7 6 1 5 2 8 4 7 3 9 6 1 5 2 8 4 7 9 3 6 1 5 3 9 4 2 7 8 6 1 5 3 9 4 2 8 7 6 1 9 6 4 5 8 3 7 2 1 9 6 4 5 8 7 3 2 1 9 6 7 5 2 3 4 8 1 9 6 7 5 2 4 3 8 2 1 4 3 7 9 5 6 8 2 1 4 3 7 9 6 5 8 2 3 6 1 7 9 4 5 8 2 3 6 1 7 9 5 4 8 2 4 8 1 7 9 3 5 6 2 4 8 1 7 9 5 3 6 2 8 6 9 4 1 5 7 3 2 8 6 9 4 1 7 5 3 2 9 6 3 5 1 4 7 8 2 9 6 3 5 1 7 4 8 3 1 4 2 7 9 5 6 8 3 1 4 2 7 9 6 5 8 3 2 1 5 4 7 8 9 6 3 2 1 5 4 7 9 8 6 3 2 4 8 5 1 7 9 6 3 2 4 8 5 1 9 7 6 3 2 8 6 5 1 7 9 4 3 2 8 6 5 1 9 7 4 3 5 2 1 4 8 7 9 6 3 5 2 1 4 8 9 7 6 3 6 4 9 5 8 1 7 2 3 6 4 9 5 8 7 1 2 3 9 2 8 1 5 6 7 4 3 9 2 8 1 5 7 6 4 3 9 6 2 5 1 4 7 8 3 9 6 2 5 1 7 4 8 4 2 6 1 7 8 3 5 9 4 2 6 1 7 8 5 3 9 4 3 2 1 5 8 7 9 6 4 3 2 1 5 8 9 7 6 4 3 9 1 7 8 2 5 6 4 3 9 1 7 8 5 2 6 4 9 6 1 5 8 3 7 2 4 9 6 1 5 8 7 3 2 5 1 2 9 6 7 3 4 8 5 1 2 9 6 7 4 3 8 5 2 1 3 4 7 8 9 6 5 2 1 3 4 7 9 8 6 5 3 1 7 2 6 8 9 4 5 3 1 7 2 6 9 8 4 5 4 1 9 2 7 3 8 6 5 4 1 9 2 7 8 3 6 5 4 8 9 6 7 1 3 2 5 4 8 9 6 7 3 1 2 5 7 2 8 3 9 1 6 4 5 7 2 8 3 9 6 1 4 5 9 3 6 2 1 7 8 4 5 9 3 6 2 1 8 7 4 6 2 8 3 5 1 7 9 4 6 2 8 3 5 1 9 7 4 6 3 1 9 2 5 7 8 4 6 3 1 9 2 5 8 7 4 6 9 3 5 2 1 7 8 4 6 9 3 5 2 1 8 7 4 7 1 4 9 6 5 2 3 8 7 1 4 9 6 5 3 2 8 7 2 8 9 6 5 1 3 4 7 2 8 9 6 5 3 1 4 7 3 1 5 2 6 8 9 4 7 3 1 5 2 6 9 8 4 7 3 2 8 5 9 1 6 4 7 3 2 8 5 9 6 1 4 7 3 4 1 6 5 2 9 8 7 3 4 1 6 5 9 2 8 7 5 2 8 4 9 1 3 6 7 5 2 8 4 9 3 1 6 7 6 4 8 5 9 1 3 2 7 6 4 8 5 9 3 1 2 7 9 6 1 5 2 3 4 8 7 9 6 1 5 2 4 3 8 8 2 4 3 5 1 7 9 6 8 2 4 3 5 1 9 7 6 8 3 2 7 5 9 1 6 4 8 3 2 7 5 9 6 1 4 8 5 2 1 4 7 3 9 6 8 5 2 1 4 7 9 3 6 8 5 2 7 4 9 1 3 6 8 5 2 7 4 9 3 1 6 8 6 4 7 5 9 1 3 2 8 6 4 7 5 9 3 1 2 8 7 2 5 3 9 1 6 4 8 7 2 5 3 9 6 1 4 8 9 2 3 1 5 6 7 4 8 9 2 3 1 5 7 6 4 9 1 2 5 6 7 3 4 8 9 1 2 5 6 7 4 3 8 9 1 4 7 6 5 2 3 8 9 1 4 7 6 5 3 2 8 9 2 8 7 6 5 1 3 4 9 2 8 7 6 5 3 1 4 9 3 1 6 2 5 7 8 4 9 3 1 6 2 5 8 7 4 9 3 2 1 5 6 4 7 8 9 3 2 1 5 6 7 4 8 9 4 1 5 2 7 3 8 6 9 4 1 5 2 7 8 3 6 9 4 8 5 6 7 1 3 2 9 4 8 5 6 7 3 1 2 9 5 3 1 4 2 7 8 6 9 5 3 1 4 2 8 7 6 9 6 4 3 5 8 1 7 2 9 6 4 3 5 8 7 1 2 9 8 6 2 4 1 5 7 3 9 8 6 2 4 1 7 5 3
有128个解决scheme，耗时984.61秒或16分24.61秒。
Public j As Long '<--new line Private Sub Permutate(list() As Long, ByVal pointer As Long) If pointer = UBound(list) Then Dim lower_bound As Long lower_bound = LBound(list) Validate list(lower_bound), list(lower_bound + 1), list(lower_bound + 2), list(lower_bound + 3), list(lower_bound + 4), list(lower_bound + 5), list(lower_bound + 6), list(lower_bound + 7), list(lower_bound + 8) Exit Sub End If Dim i As Long For i = pointer To UBound(list) Dim permutation() As Long permutation = list permutation(pointer) = list(i) permutation(i) = list(pointer) Permutate permutation, pointer + 1 Next End Sub Private Sub Validate(ByVal a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, ByVal e As Long, ByVal f As Long, ByVal g As Long, ByVal h As Long, ByVal i As Long) If a + (13 * b / c) + d + (12 * e) - f + (g * h / i) = 87 Then Cells(j, 1) = a '<--new line Cells(j, 2) = b '<--new line Cells(j, 3) = c '<--new line Cells(j, 4) = d '<--new line Cells(j, 5) = e '<--new line Cells(j, 6) = f '<--new line Cells(j, 7) = g '<--new line Cells(j, 8) = h '<--new line Cells(j, 9) = i '<--new line j = j + 1 '<--new line 'Debug.Print a, b, c, d, e, f, g, h, i End If End Sub Public Sub Vietnam_Problem() Dim numbers(1 To 9) As Long Dim i As Long Dim StartTime As Double StartTime = Timer j = 1 '<--new line For i = 1 To 9 numbers(i) = i Next Permutate numbers, LBound(numbers) Cells(2, 12) = Round(Timer - StartTime, 2) End Sub
对不起 – 不能评论。 我不会使用VBA或这个东西。 在我看来，这是一个像prolog这样的逻辑语言的工作。 你可以在这里看到斑马谜题上多种语言的一些例子。
我知道VBA的唯一方法是使用for循环 – 这不是快，这不是很好，而且是非常有限的。 这就是为什么我会build议逻辑语言像prolog或非常快速的编程语言，如C＃/ C ++。 对不起，真的不能帮你。