The brute force method using VBA for solving an equation with nine unknown variables
This equation: a+(13*b/c)+d+(12*e)-f+(g*h/i)=87 appears when trying to solve the maths puzzle for Vietnamese eight-year-olds that recently became viral all over
-
Okay, here is my attempt:
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 SubIt seems to work but as I mentioned in the comment section below my question it's not nice and very slow.
The output:
a b c d e f g h i 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 3There are 128 solutions and it took time 984.61 seconds or 16 minutes and 24.61 seconds.
讨论(0) -
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讨论(0) -
Anastasiya-Romanova 秀, since you are not declaring the variables (a through j), your code is running with those variables defaulting to the Variant type. While variants can be enormously useful, they should not be used here.
I ran your code unaltered and on my machine, it took 851 seconds to complete.
Since VBA is optimized for Longs, simply adding one line to your code to declare the variables (a through j) as Longs, brought the running time on my machine down to 120 seconds. So that's seven times faster just for using the appropriate variable type!
My stab at solving this puzzle in VBA runs considerably faster. In fact, it's much faster (and shorter) than anything posted thus far on this page. On my same machine, it returns all 136 correct combinations in less than one second.
There is a lot of nonsense out there (the world, the net, even here on this page!) about VBA being too slow. Don't believe it. Sure, compiled languages can be faster, but much of the time it comes down to how well you know how to handle your language. I've been programming in the BASIC language since the 1970s.
Here is my solution to the Vietnam Puzzle that I crafted for your question. Please place this in a new code module:
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 SubMethod #2:
Anastasiya, I will try to explain it later today, when I have more time. But in the meantime, please examine my next stab at this. It is now even shorter and completes in about 1/10th of a second. I am now using Heap's Permutation 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 SubMethod #3
And here is an even shorter version. Can anyone come up with either a shorter version or a quicker version?
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讨论(0) -
Sorry - can't comment. I wouldn't use VBA or stuff for this. In my oppinion this is a job for logical languages like prolog. You can see some examples in multiple languages on the zebra-puzzle over here.
The only way in VBA I know is using for-loops - which isn't fast, which isn't nice, and which is very limited. This is why I'd advice logical languages like prolog or VERY FAST programming languages like C# / C++. Sorry for can't really helping you.
讨论(0) -
I was going to submit another answer but since my last answer was pretty off base I've just overwritten it. This still uses a Monte Carlo style random number approach but it gets a bit lumpy when you have to make sure you haven't already solved with that random number combination.
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 FunctionMy solution time for all combinations is around 3s - 3.5s.
讨论(0)
加载中...
- 热议问题