Brute force method using VBA to solve 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 a math puzzle for Vietnamese 8-year-olds that has recently gone viral on the internet. In mathematics, such an equation is called an underdetermined system . Of course it has several solutions and brute force seems to be the easiest way to find all solutions.
I am interested in learning how to solve an equation using VBA and present the solutions in an MS Excel sheet, as I cannot find a way to make such a program due to lack of knowledge of VBA programming.
I am aware of similar posts on Stack Overflow such as this and, but the answers there don't help me very much.
Here's 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 Sub
It seems to work, but it's not nice and very slow.
source to share
Anastasia-Romanova 秀 since you do not declare variables (from a to j), your code works with those variables that do not correspond to the Variant type by default. While variations can be extremely useful, they cannot be used here.
I ran your code unchanged and on my machine, it took 851 seconds.
Since VBA is optimized for Longs, just adding one line to your code to declare variables (a through j) as Longs, the runtime on my machine was reduced to 120 seconds. So it's seven times faster just to use the appropriate variable type!
My hit on solving this puzzle in VBA is significantly faster. In fact, it is much faster (and shorter) than anything posted so far on this page. On my machine, it returns all 136 correct combinations in less than one second.
There is a lot of nonsense (world, web, even here on this page!) That VBA is too slow. Don't believe it. Of course, compiled languages can be faster, but in most cases it depends on how well you know how to handle your language. I have been programming in BASIC since the 1970s.
Here is my Vietnamese puzzle solution I created for your question. 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 Sub
Method # 2:
Anastasia, I will try to explain this later today when I have more time. But for now, please consider my next hit. It is now even shorter and ends in about 1/10 of a second. Now I am using the heap 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 Sub
Method number 3
And here's an even shorter version. Can anyone come up with a shorter version or faster 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
source to share
I was going to present a different answer, but since my last answer was quite distant, I just overwritten it. This still uses the Monte Carlo style of random number method, but it gets a little lumpy when you need to make sure you haven't solved this random number combination yet.
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
My solution time for all combinations is around 3s - 3.5s.
source to share
Ok, 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 Sub
It seems to work, but as I mentioned in the comment section below my question, it's not nice and very slow.
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 3
There are 128 solutions and it took 984.61 seconds or 16 minutes and 24.61 seconds.
source to share
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
source to share
Sorry - I can't comment. I wouldn't use VBA or stuff for this. In my oppinion it works for logical languages like prologue. You can see some examples in multiple languages on the zebra puzzle above here .
The only way in VBA I know is to use for-loops - which is not fast, which is not nice and very limited. This is why I consulted logic languages like prologue or VERY FAST programming languages like C # / C ++. Sorry to be unable to help you.
source to share