# OOP Cross Sum Solver

Not satisfied with the Brute Force Solver that I wrote for All possible combinations of 1 to 9 in the same cells without repetition, I created an OOP Cross Sum Solver.

As expected my OOP Solver crushes the Brute Force Solver performace, 0.03-0.12 seconds compared to 109 - 400 seconds respectively.

I probably should post the Brute Force Solver instead but I found it boring.

The Contest Center:CROSS SUMS Rules

"Your job is to fill the numbers from 1 to 9 into the 9 empty boxes so that the arithmetic in each row is correct. The math operations are performed from left to right. So to evaluate 1+2×5 you first add 1+2 to get 3, and then multiply that by 5 to get 15. When performing the operations you may never go below zero, and each division must be even. Thus you could not have 5-7+4 because 5-7 goes below 0, and you could not have 7÷2+6 because 7÷2 is not an even division, it has a remainder."

## Class Overview

• Node: Basically a list of numbers. Each Node is linked to 2
• Equations Equation: Processes a set of 3 Nodes, 2 operators, and an Answer
• Solver: Links 9 Nodes to 6 Equations

## Calculate

Initially the Solver will trigger each Equation to Calculate. As an Equation is calculated, each of its Nodes numbers lists are optimised by removing numbers that can not be used to solve the Equation. If a Node's list is reduced to 1 then the Nodes value is removed from all other Node's number lists. If an Equation causes a Node to change than all Equations are recalculated. This is necessary because each Node is linked to 2 Equations. At this point if an Equation is not solved then the ApplyBruteForce method of each Equation can be used to solve the Puzzle.

## ApplyBruteForce

This method first saves each nodes state and then attempts to solve each Equation but testing all combinations of its Nodes number lists. If an answer can not be determined after an Equation is tested than the Nodes state are restored and the next Equation is evaluated.

Note: All problems were solved on or before the 3rd Equation was tested. It is possible that an this method will not solve all problems. If this is the case than a true Brute Force method will need to be added.

## Class: Node

Attribute VB_Name = "Node"
Option Explicit
Private passed() As Boolean
Private numbers() As Long
Private saved() As Long
Private Index As Long
Public Dirty As Boolean

Private Sub Class_Initialize()
ReDim passed(8)
ReDim numbers(8)
Dim n As Long
For n = 0 To 8
numbers(n) = n + 1
Next
End Sub

Public Function Count() As Long
Count = UBound(numbers) + 1
End Function

Public Function Current() As Long
Current = numbers(Index)
End Function

Public Sub DeleteElementAt(ByVal Index As Integer, ByRef prLst As Variant)
Dim i As Integer

' Move all element back one position
For i = Index + 1 To UBound(prLst)
prLst(i - 1) = prLst(i)
Next

' Shrink the array by one, removing the last one
ReDim Preserve prLst(Len(prLst) - 1)
End Sub

Public Function EOF() As Boolean
EOF = Index <= UBound(numbers)
End Function

Public Sub MoveFirst()
Index = 0
End Sub

Public Sub MoveNext()
Index = Index + 1
End Sub

Public Sub Remove(Value As Long)
Dim n1 As Long, n2 As Long
If UBound(numbers) = 0 Then
'Stop
Exit Sub
End If
For n1 = UBound(numbers) To 0 Step -1
If numbers(n1) = Value Then
For n2 = n1 To UBound(numbers) - 1
numbers(n2) = numbers(n2 + 1)
Next

ReDim Preserve numbers(UBound(numbers) - 1)
ReDim passed(UBound(numbers))
Exit Sub
End If
Next
End Sub

Dim oldCount As Long, n As Long, pIndex As Long
oldCount = Count

pIndex = -1
For n = 0 To UBound(numbers)
If passed(n) Then
pIndex = pIndex + 1
If pIndex < n Then numbers(pIndex) = numbers(n)
End If
Next

If pIndex < UBound(numbers) And pIndex > -1 Then ReDim Preserve numbers(pIndex)

ReDim passed(UBound(numbers))

Dirty = oldCount <> Count
End Sub

Public Sub Restore()
ReDim numbers(UBound(saved))
ReDim passed(UBound(numbers))
Dim n As Long
For n = 0 To UBound(numbers)
numbers(n) = saved(n)
Next
End Sub

Public Sub Save()
ReDim saved(UBound(numbers))
Dim n As Long
For n = 0 To UBound(numbers)
saved(n) = numbers(n)
Next
End Sub

Public Sub setValue(n As Long)
ReDim passed(0)
ReDim numbers(0)
numbers(0) = n
End Sub

Public Function ToString() As String
Dim n As Long
ReDim results(UBound(numbers))

For n = 0 To UBound(numbers)
results(n) = numbers(n)
Next

ToString = "{" & Join(results, ",") & "}"
End Function

Public Sub ValidateCurrent()
passed(Index) = True
End Sub

Public Function Value(ByVal Index As Long) As Long
Index = Index - 1
Value = numbers(Index)
End Function


## Class: Equation

Attribute VB_Name = "Equation"
Option Explicit
Private Type Members
operator(1 To 2) As String
End Type
Private this As Members
Public Node1 As Node
Public Node2 As Node
Public Node3 As Node
Public Dirty As Boolean

Public Sub Init(operator1 As String, operator2 As String, answer As Long)
this.operator(1) = operator1
this.operator(2) = operator2
End Sub

Public Function Solved() As Boolean
Solved = Count = 3
End Function

Public Sub Calculate()
Node1.MoveFirst
While Node1.EOF
Node2.MoveFirst
While Node2.EOF
Node3.MoveFirst
While Node3.EOF
If Node1.Current <> Node2.Current And Node1.Current <> Node3.Current And Node2.Current <> Node3.Current Then
Dim part1 As Long
Dim n1 As Long, n2 As Long, n3 As Long
n1 = Node1.Current
n2 = Node2.Current
n3 = Node3.Current

part1 = ev(Node1.Current, Node2.Current, this.operator(1))
If part1 >= 0 Then
If ev(part1, Node3.Current, this.operator(2)) = this.answer Then
'Debug.Print Node1.Current, Node2.Current, Node3.Current, ev(ev(Node1.Current, Node2.Current, this.operator(1)), Node3.Current, this.operator(2))
Node1.ValidateCurrent
Node2.ValidateCurrent
Node3.ValidateCurrent
End If
End If
End If
Node3.MoveNext
Wend
Node2.MoveNext
Wend
Node1.MoveNext
Wend

Dim oldCount As Long

oldCount = Count

Dirty = oldCount <> Count
End Sub

Public Function Count() As Long
Count = Node1.Count + Node2.Count + Node3.Count
End Function

End Sub

Private Function ev(v1 As Long, v2 As Long, operator As String) As Long
Select Case operator
Case "+"
ev = v1 + v2
Case "-"
ev = v1 - v2
Case "/", "÷"
ev = v1 / v2
Case "*", "×", "x", "X"
ev = v1 * v2
Case Else
Debug.Print operator
End Select
End Function

Public Function ToString() As String
ToString = this.operator(1) & " " & this.operator(2) & " " & this.answer & ": " & Node1.ToString & "," & Node2.ToString & "," & Node3.ToString
End Function

Private Sub Class_Initialize()
Set Node1 = New Node
Set Node2 = New Node
Set Node3 = New Node
End Sub


## Class: Solver

Attribute VB_Name = "Solver"
Private Type Members
Data As Variant
operator(1 To 2) As String
Solved As Boolean
End Type
Private this As Members
Private Equations(1 To 6) As Equation
Private Test(1 To 2) As Node
Private Nodes(1 To 9) As New Node

Public Sub ApplyBruteForce()
Save
Dim n As Long
For n = 1 To 6
With Equations(n)
If Not .Solved Then
Dim n1 As Long, n2 As Long, n3 As Long
For n1 = 1 To .Node1.Count
For n2 = 1 To .Node2.Count
For n3 = 1 To .Node3.Count
If .Node1.Value(n1) <> .Node2.Value(n2) And _
.Node1.Value(n1) <> .Node3.Value(n3) And _
.Node2.Value(n2) <> .Node3.Value(n3) Then

.Node1.setValue .Node1.Value(n1)
.Node2.setValue .Node2.Value(n2)
.Node3.setValue .Node3.Value(n3)

RemoveCompletedNumbers
Me.Calculate
If Solved Then Exit Sub
Restore
End If
Next
Next
Next
End If
End With
If Solved Then Exit Sub
Restore
Next
End Sub

Private Sub ForceNodeValues()
Save
Dim n As Long
For n = 1 To 9
If TestNode(Nodes(n)) Then Exit Sub
Next
End Sub

Private Function TestNode(Node As Node) As Boolean
Dim n As Long

For n = 1 To Node.Count
Node.setValue Node.Value(n)
RemoveCompletedNumbers
Me.Calculate
If Solved Then
TestNode = True
Exit Function
End If
Restore
Next
End Function

Public Sub Calculate()
Dim n As Long
For n = 1 To 6
Equations(n).Calculate
If Equations(n).Dirty Then
RemoveCompletedNumbers
n = 0
End If
Next
End Sub

Public Function getData() As Variant
Dim results As Variant
results = this.Data

If Solved Then
results(1, 1) = Nodes(1).Value(1)
results(1, 3) = Nodes(2).Value(1)
results(1, 5) = Nodes(3).Value(1)
results(3, 1) = Nodes(4).Value(1)
results(3, 3) = Nodes(5).Value(1)
results(3, 5) = Nodes(6).Value(1)
results(5, 1) = Nodes(7).Value(1)
results(5, 3) = Nodes(8).Value(1)
results(5, 5) = Nodes(9).Value(1)
End If
getData = results
End Function

Public Sub Init(Data As Variant)
this.Data = Data
this.Solved = False
InitEquations
Equations(1).Init CStr(Data(1, 2)), CStr(Data(1, 4)), CLng(Data(1, 7))
Equations(2).Init CStr(Data(3, 2)), CStr(Data(3, 4)), CLng(Data(3, 7))
Equations(3).Init CStr(Data(5, 2)), CStr(Data(5, 4)), CLng(Data(5, 7))
Equations(4).Init CStr(Data(2, 1)), CStr(Data(4, 1)), CLng(Data(7, 1))
Equations(5).Init CStr(Data(2, 3)), CStr(Data(4, 3)), CLng(Data(7, 3))
Equations(6).Init CStr(Data(2, 5)), CStr(Data(4, 5)), CLng(Data(7, 5))

With Equations(1)
Set .Node1 = Nodes(1)
Set .Node2 = Nodes(2)
Set .Node3 = Nodes(3)
End With

With Equations(2)
Set .Node1 = Nodes(4)
Set .Node2 = Nodes(5)
Set .Node3 = Nodes(6)
End With

With Equations(3)
Set .Node1 = Nodes(7)
Set .Node2 = Nodes(8)
Set .Node3 = Nodes(9)
End With

With Equations(4)
Set .Node1 = Nodes(1)
Set .Node2 = Nodes(4)
Set .Node3 = Nodes(7)
End With

With Equations(5)
Set .Node1 = Nodes(2)
Set .Node2 = Nodes(5)
Set .Node3 = Nodes(8)
End With

With Equations(6)
Set .Node1 = Nodes(3)
Set .Node2 = Nodes(6)
Set .Node3 = Nodes(9)
End With
End Sub

Private Sub InitEquations()
Dim n As Long
For n = 1 To 6
Set Equations(n) = New Equation
Next
End Sub

Private Sub RemoveCompletedNumbers()
Dim item1 As Variant, item2 As Variant
For Each item1 In Nodes
If item1.Count = 1 And item1.Dirty Then
item1.Dirty = False
For Each item2 In Nodes
If Not item1 Is item2 Then
item2.Remove item1.Value(1)
End If
Next
End If
Next
End Sub

Public Sub Restore()
Dim n As Long
For n = 1 To 9
Nodes(n).Restore
Next
End Sub

Public Sub Save()
Dim n As Long
For n = 1 To 9
Nodes(n).Save
Next
End Sub

Public Function Solved() As Boolean
Dim n As Long
Dim dups As New Collection
For n = 1 To 9
If Nodes(n).Count > 1 Then Exit Function
On Error Resume Next
If Err.Number <> 0 Then
Exit Function
End If
On Error GoTo 0
Next
Solved = True
End Function

Public Function ToString() As String
Dim results(1 To 6) As String

For n = 1 To 6
results(n) = Equations(n).ToString
Next

ToString = Join(results, vbNewLine)
End Function


Module: TestMod

Attribute VB_Name = "TestMod"
Option Explicit
Const BaseRange As String = "A1:G7", ValueRange As String = "A1,C1,E1,A3,C3,E3,A5,C5,E5"

Sub TestCrossSum()
' C2, L2, U2, AD2, AM2, AV2, C11, L11, U11, AD11, AM11, AV11
Dim t As Double: t = Timer
TestSolver Range("C2")
'TestSolver Range("U11")
Debug.Print Round(Timer - t, 2)
End Sub

Sub TestAll()
Application.ScreenUpdating = False
Dim t As Double: t = Timer

With ThisWorkbook.Worksheets("Cross Sums")
Dim r As Long, c As Long
For r = 1 To 2
For c = 1 To 6
TestSolver .Cells(r * 9 - 7, c * 9 - 6)
Next
Next
End With
Debug.Print Round(Timer - t, 2)
End Sub

Sub TestSolver(TopLeftCell As Range)
Dim Solver As New Solver, Header As Range, Target As Range
Set Target = TopLeftCell.Range(BaseRange)
Target.Range(ValueRange).ClearContents

Solver.Init Target.Value
Solver.Calculate

If Solver.Solved Then
Else
Solver.ApplyBruteForce
If Solver.Solved Then Header.Value = "Hard"
End If

If Solver.Solved Then
Target.Value = Solver.getData
Else
Debug.Print Solver.ToString
End If
End Sub


I'm interested in any problem that might stump the Solver, a Cross Sum Generator if anyone cares to write one, any ideas on how to write a better Solver, and as always any tips on how to improve my code.

Some quick comments. This reminds me of over 10 years ago when I was thinking of a solver for Soduku in VB6 (which I never finished writing because I always have trouble with interfaces/user forms)

## Class Node

Why not use a Collection instead of arrays for numbers and passed. This will clean up (i.e. remove) the ReDim work. I think the refactoring that you would end up doing by this approach will make the Node class simpler and cleaner. Oh, and you can then use For Each'.

You could also have property for Solved so that you return a single value instead of doing collection processing when you have actually solved this node.

## Class Equation

You use Public Members instead of Properties Set and Get. I remember somewhere in all my OOP reading that this is a bad thing (tm) to do. Probably because if you want to tweak or do some data validation you can't.

You could check to see if a Node has been solved. This will enable shortcutting to solving the second Node. This means that you can start using Boolean logic instead of counting each time you want to check something. Probably not much difference in performance, but the programming logic is a lot clearer. Which, in turn means this would be easier to maintain.

Why not pass the nodes in with the initial Init? Then nodes are not going to change address or location. This, coupled with a Property Get means that you are less likely to overwrite a Node with a new location.

Make your life a little easier and add a public Evaluate function that takes three parameters. It can return a Boolean, either the inputs evaluate to the answer, or they don't. This would be used primarily by the Brute Force solver.

Under the subroutine Calculate to declare n1, n2 and n3. You even assign them a value. But then don't use that value.

## Class Solver

As noted under Equation, passing the relevant nodes in as part of the Equation.Init would be cleaner.

Using Collections under the Nodes would make the brute force approach cleaner.

Brute force could be made a little easier by have the other Evaluate function in the Equation class.

I am not sure of your logic here. While a selection of 3 numbers may solve the equation, there may be multiple triplets. I haven't walked myself through the logic in detail here (I did say quick comments) but intuitively, I think this may shortcut the checking and may produce some wrong results. I don't see a way to walk back a series of calculations if there is found to be a conflicting set.

## General

I don't see any validation of inputs - what if a range of 8 cells are passed? I have already mentioned the use of Public members instead of Propertys Some of your Subs can be Functions and form a double duty. For example, the subroutine Calculate could return a Boolean that represents Dirty. This approach will allow you to get rid of a "global" variable. Thinking this way allows you to chain your code logic into a logical process. A good and visible process should help with code readability.

• I don't think that I have ever had a better review of my code. Your check is in the mail overnight express...lol. – TinMan Nov 23 '18 at 6:20
• Just a couple of thoughts. I intentionally used arrays because I use Dictionaries in some much of my code. I was regretting it towards the end. I thought about using Properties. I noticed that Matt used them often in Batteship. I didn't link the Nodes in Equation.Init` because of time restraints. I felt that the current setup would allow me to make all the correct links without mistakes. – TinMan Nov 23 '18 at 6:38
• I think that shortcutting when a single Node is solved is counter-productive because the number lists of the other 2 Nodes in the equations will still need to be solved. Solving node1 might cause nodes 2 and 3 to solved. In this case, 3 numbers can be excluded from all the other nodes at once. This will greatly reduce the number of operations. – TinMan Nov 23 '18 at 6:45
• Adding Solved to the Nodes and having brute force methods for each Equation is very interesting. I would like to roll-up Solved, Calculate and ApplyBruteForce into a single method. I didn't do it because I wasn't sure how long that it would take to apply brute force. – TinMan Nov 23 '18 at 6:50
• Sorry if my random thought comments are annoying. I will definitely apply most of your tips to my rewrite. I'm thinking about writing a really solid Solver and than rewriting it in a different programming language each week as a challenge. If nothing out it would keep me from spewing code all over the VBA tag. Thanks again for your time. – TinMan Nov 23 '18 at 6:57