Search faster using array - But it slows down

[Ste Mac]

Hi Dana, using Charles's code it generates 4539 unique sets.

It looks like its bang on the money, scanning down the sets I cannot
see any more than four number repeats... quite cool really...

Ste

 

[Dana DeLouis]

4539 unique sets

Hi. I may be wrong, but I show many more than that (in about 1 minute)

I'll just throw this out for consideration...
Our solutions start to diverge here:

You have...

1,2,3,4,29,30
1,2,3,4,8,9
1,2,3,5,10,11
1,2,3,5,12,13

I have...

1,2,3,4,29,30
1,2,3,5,7,9
1,2,3,5,8,10
1,2,3,5,11,13

and the differences grows from here.
Again, I may be wrong.

= = = = = = = =
Dana DeLouis

 

[Dana DeLouis]

Ahh. I have a small typo in the second line of your data.
Let me try again...

You have...

1,2,3,4,29,30
1,2,3,5,8,9
1,2,3,5,10,11
1,2,3,5,12,13

I have...

1,2,3,4,29,30
1,2,3,5,7,9
1,2,3,5,8,10
1,2,3,5,11,13

And the differences grow from here.
Still... I may be wrong.

Dana DeLouis

<snip>

 

[joel]

To find the source of the problem I think you are going to need to fin
the 1st difference. Post the soce you are using and then make sure yo
are both using the same macro

 

[Dana DeLouis]

Hi. I may be wrong, but our first difference is as mentioned...

His...
1,2,3,5,8,9

Mine...
1,2,3,5,7,9

I "think" the source of the difference is here.

When we get to 1,2,3,5,7,8
we both agree that this is not valid (ie 1,2,3,7,8 appeared earlier)
and the code sets blNew to False
The code goes on to increment F, and we have...

For F = E + 1 To 30
If Not blNew Then Exit For

We are exiting F here, and not checking 1,2,3,4,7,9

I noticed that in the beginning the code finds the first valid solution.
1,2,3,4,5,6
It then goes on to check
1,2,3,4,5,7

I believe the code was trying / or should, try to exit F here because
there is no need to check F as it goes from 7 to 30. I "Think" this is
the source of our differences.

Again... I may be wrong.

= = = = = = =
Dana DeLouis

 

[Dana DeLouis]

Oops. Typo again. Sorry.

When we get to 1,2,3,5,7,8
we both agree that this is not valid (ie 1,2,3,7,8 appeared earlier)
and the code sets blNew to False
The code goes on to increment F, and we have...

For F = E + 1 To 30
If Not blNew Then Exit For

We are exiting F here, and not checking 1,2,3,5,7,9

I "Think" this is the source of our differences.


<snip>

 

[Charles Williams]

Hi Dana,

I think you are correct. The optimisation excludes many possible valid sets.

It needs a better approach, any ideas?

regards
Charles
___________________________________
The Excel Calculation Site
http://www.decisionmodels.com

 

[Dana DeLouis]

Hi Dana,
I think you are correct. The optimisation excludes many possible valid sets.
It needs a better approach, any ideas?

regards
Charles

<snip>

Hi Charles.
If I am not mistaken, this found 18,655 solutions in 25 Seconds.
= = = = = =
Dana DeLouis

Sub SpecialSubsets()
'// = = = = = = = = = = = = = = = = = = = = = = = = = =
Dim A As Long, B As Long, C As Long, D As Long, E As Long, F As Long
Dim N1 As Long, N2 As Long, N3 As Long, N4 As Long, N5 As Long, N6 As Long
Dim Tme As Double
Dim M 'Matrix
Dim S 'Solutions
Dim T 'Temp Array
'// = = = = = = = = = = = = = = = = = = = = = = = = = =

Set M = CreateObject("Scripting.Dictionary")
Set S = CreateObject("Scripting.Dictionary")

ActiveSheet.Cells.Clear
Tme = Timer
On Error Resume Next
With M

For A = 0 + 1 To 25
For B = A + 1 To 26
For C = B + 1 To 27
For D = C + 1 To 28
For E = D + 1 To 29
For F = E + 1 To 30

N1 = 810000 * A + 27000 * B + 900 * C + 30 * D + E
If .Exists(N1) Then GoTo Skip
N2 = N1 + F - E
If .Exists(N2) Then GoTo Skip
N3 = N2 + 30 * (E - D)
If .Exists(N3) Then GoTo Skip
N4 = N3 + 900 * (D - C)
If .Exists(N4) Then GoTo Skip
N5 = N4 + 27000 * (C - B)
If .Exists(N5) Then GoTo Skip
N6 = N5 + 810000 * (B - A)
If Not .Exists(N6) Then
.Add N1, N1
.Add N2, N2
.Add N3, N3
.Add N4, N4
.Add N5, N5
.Add N6, N6
S.Add S.Count + 1, Array(A, B, C, D, E, F)
Exit For 'Exit remaining F's
End If
Skip:
Next F, E, D, C, B, A
End With
Debug.Print "Timer: ", Timer - Tme
Debug.Print "Size : ", S.Count
Debug.Print "= = = = = = = = = ="
T = S.Items
[A1].Resize(S.Count, 6) = T2(T)
End Sub

Function T2(M)
'// Transpose twice
With WorksheetFunction
T2 = .Transpose(.Transpose(M))
End With
End Function

 

[Charles Williams]

Looks good to me, excellent


Charles
___________________________________
The Excel Calculation Site
http://www.decisionmodels.com

Hi Dana,
I think you are correct. The optimisation excludes many possible valid
sets.
It needs a better approach, any ideas?

regards
Charles

<snip>

Hi Charles.
If I am not mistaken, this found 18,655 solutions in 25 Seconds.
= = = = = =
Dana DeLouis

Sub SpecialSubsets()
'// = = = = = = = = = = = = = = = = = = = = = = = = = =
Dim A As Long, B As Long, C As Long, D As Long, E As Long, F As Long
Dim N1 As Long, N2 As Long, N3 As Long, N4 As Long, N5 As Long, N6 As Long
Dim Tme As Double
Dim M 'Matrix
Dim S 'Solutions
Dim T 'Temp Array
'// = = = = = = = = = = = = = = = = = = = = = = = = = =

Set M = CreateObject("Scripting.Dictionary")
Set S = CreateObject("Scripting.Dictionary")

ActiveSheet.Cells.Clear
Tme = Timer
On Error Resume Next
With M

For A = 0 + 1 To 25
For B = A + 1 To 26
For C = B + 1 To 27
For D = C + 1 To 28
For E = D + 1 To 29
For F = E + 1 To 30

N1 = 810000 * A + 27000 * B + 900 * C + 30 * D + E
If .Exists(N1) Then GoTo Skip
N2 = N1 + F - E
If .Exists(N2) Then GoTo Skip
N3 = N2 + 30 * (E - D)
If .Exists(N3) Then GoTo Skip
N4 = N3 + 900 * (D - C)
If .Exists(N4) Then GoTo Skip
N5 = N4 + 27000 * (C - B)
If .Exists(N5) Then GoTo Skip
N6 = N5 + 810000 * (B - A)
If Not .Exists(N6) Then
.Add N1, N1
.Add N2, N2
.Add N3, N3
.Add N4, N4
.Add N5, N5
.Add N6, N6
S.Add S.Count + 1, Array(A, B, C, D, E, F)
Exit For 'Exit remaining F's
End If
Skip:
Next F, E, D, C, B, A
End With
Debug.Print "Timer: ", Timer - Tme
Debug.Print "Size : ", S.Count
Debug.Print "= = = = = = = = = ="
T = S.Items
[A1].Resize(S.Count, 6) = T2(T)
End Sub

Function T2(M)
'// Transpose twice
With WorksheetFunction
T2 = .Transpose(.Transpose(M))
End With
End Function