Solved: Math Problem Puzzle(Brain teaser)

[Aussiebear]

Sorry guys, way toooooooo deep for me. I was struggling with the initial post then Aaron posted and I was left with help help I'm drowning here, then Stanl made the tide come in, and Makako has sent it interplanetary.....

What happened to a simple post?

[mdmackillop]

Hi Ted,
I know exactly what you mean. This is my closer to my level.
http://vbaexpress.com/forum/showthread.php?t=10361
Regards
MD

[stanl]

The question: is it difficult or time consuming? I think the consesnus is that you need to evaluate 30k possibilities regardless. One way is with the assistance of Excel cells to fit a matrix, the other is to find an algorithm which could then be written as a Function() to either return "Cannot Be Solved", a list of regular math solutions, or a list of solutions w/parentheses.

I've looked at the algorithm I posted for 3 days... irritated a bit that it is not more elegant , but it appears to work so it is now time consuming not difficult. I will however, convert it to a VBA function unless that is also time consuming. Stan

[makako]

[vba]
Option Base 1
Type MathArray
MType As Integer '1 for "(", 2 for ")", 3 for "X", 4 for "Operator"
MNum As Integer
MMax As Integer
End Type
Public MOrder() As Integer
Dim PossibleArray() As Integer
Sub SearchCharacters()
Dim Vars As Range, Answ As Double, RangeA As Range, TempAns As Double, OpenPa As Integer, ClosingPa As Integer
Dim X As Long, Y As Long, Z As Integer, EString As String, CHString As String
Dim MArray() As MathArray
Set Vars = Application.InputBox("Select the Variables range", Type:=8)
Answ = InputBox("Answer:")
'Set RangeA = Application.InputBox("Select the location for answers", Type:=8)
ReDim MArray((Vars.Cells.Count * Vars.Cells.Count) + Vars.Cells.Count - 1)
Z = 1
ReDim MOrder(Vars.Cells.Count)
For X = Vars.Cells.Count To 1 Step -1
For Y = 1 To Vars.Cells.Count
If X = Y Then
MArray(Z).MType = 3
MArray(Z).MNum = 1
MArray(Z).MMax = Vars.Cells.Count
Z = Z + 1
ElseIf X > Y Then
MArray(Z).MType = 1
MArray(Z).MNum = 1
MArray(Z).MMax = 2
Z = Z + 1
ElseIf X < Y Then
MArray(Z).MType = 2
MArray(Z).MNum = 1
MArray(Z).MMax = 2
Z = Z + 1
End If
Next
If X <> 1 Then
MArray(Z).MType = 4
MArray(Z).MNum = 1
MArray(Z).MMax = 4
Z = Z + 1
End If
Next

While MArray(1).MNum < 3
EString = ""
For X = 1 To UBound(MArray)
With MArray(X)
Select Case .MType
Case 1:
If .MNum = 1 Then
EString = EString & "("
Else
EString = EString & " "
End If
Case 2:
If .MNum = 1 Then
EString = EString & ")"
Else
EString = EString & " "
End If
Case 3:
EString = EString & "X"
Case 4:
Select Case .MNum
Case 1:
EString = EString & "+"
Case 2:
EString = EString & "-"
Case 3:
EString = EString & "*"
Case 4:
EString = EString & "/"
End Select
End Select
End With
Next

For X = 1 To UBound(MOrder)
MOrder(X) = X
Next
For Y = 1 To Application.WorksheetFunction.Permut(Vars.Cells.Count, Vars.Cells.Count)
CHString = EString
For X = 1 To UBound(MOrder) 'Ini Position
CHString = Left(CHString, (InStr(CHString, "X") - 1)) & _
Vars.Cells(MOrder(X)) & Right(CHString, Len(CHString) - _
InStr(CHString, "X"))
Next
On Error Resume Next
TempAns = Evaluate("=" & CHString)
If Err.Number = 0 Then
If TempAns = Answ Then
MsgBox CHString & "=" & Answ
Exit Sub
End If
'RangeA.Value = CHString
'RangeA.Offset(, 1).Value = TempAns
'Set RangeA = RangeA.Offset(1)
End If
Err.Clear
On Error GoTo 0
'Next Iter
For X = 1 To UBound(MOrder)
MOrder(X) = 0
Next
If Y = Application.WorksheetFunction.Permut(Vars.Cells.Count, Vars.Cells.Count) Then Exit For
X = Y + 1
NextIter X, 1
Next
GotoNextPar:
For X = UBound(MArray) To 1 Step -1
With MArray(X)
If .MType = 3 Then
ElseIf .MNum >= .MMax And X <> 1 Then
.MNum = 1
Else
.MNum = .MNum + 1
Exit For
End If
End With
Next
OpenPa = 0
ClosingPa = 0
For X = 1 To UBound(MArray)
With MArray(X)
If .MType = 1 And .MNum = 1 Then
OpenPa = OpenPa + 1
ElseIf .MType = 2 And .MNum = 1 Then
ClosingPa = ClosingPa + 1
End If
End With
Next
If ClosingPa <> OpenPa Then GoTo GotoNextPar:
Wend
MsgBox "No possible combination"
End Sub
Function NextIter(X As Long, Iter As Integer)
Dim Group As Integer, Y As Long, I As Integer, J As Integer
If Iter > UBound(MOrder) Then Exit Function
If Iter = 1 Then
ReDim PossibleArray(UBound(MOrder))
For I = 1 To UBound(MOrder)
PossibleArray(I) = I
Next
End If
Y = UBound(MOrder) + 1 - Iter
Group = Application.WorksheetFunction.Permut(Y, Y) / Y
MOrder(Iter) = PossibleArray(Int((X - 1) / Group) + 1)
For I = 1 To UBound(PossibleArray)
If PossibleArray(I) = MOrder(Iter) Then
For J = I To UBound(PossibleArray) - 1
PossibleArray(J) = PossibleArray(J + 1)
Next
If UBound(PossibleArray) > 1 Then _
ReDim Preserve PossibleArray(UBound(PossibleArray) - 1)
Exit For
End If
Next
X = X Mod Group
If X = 0 Then X = Group
NextIter X, Iter + 1
End Function
[/vba]

not my cleanest code but it works, compares all permutations on any number of variables and compares all combinations (some are repeated because of the parentheses) but eventually should get to a result. Next time your son gets such homeworks i hope im on vacations

(((8+13)*6)/(23-14))

[Aaron Blood]

Next time your son gets such homeworks i hope im on vacations

(((8+13)*6)/(23-14))

Curse the foul teacher who would devise such an evil exercise

Ah well, at least I was able to predict that someone would come forth with an answer and prove me wrong.

Good job on the code to derive it.

[Len Piwowar]

Thanks for all who answered, the VBA code provided a lot of Brain food! This site is GREAT!!!