Search faster using array - But it slows down
 

Hi, the macro below builds number and then checks the next set it
builds against all the other sets it has built to see if there is a
match of
more than 4 numbers.
I expected it to be fast, it is, at the beginning... but slows down
dramatically the more it has to check... is so big a slow to be
expected?
or is there a tweak I have not done... cheers

ste

Full code

Sub chechformatches()

Dim A, B, C, D, E, F
Dim mycounter As Long
Dim hitcounter As Long
Dim allcounter As Long
Dim allscen As Long

Application.ScreenUpdating = False

hitcounter = 0

'Just clears the sheet ready for generation
Dim startcell, endcell, Rng As Range
Set startcell = Sheets("Max Lines").Range("A3")
Set endcell = Sheets("Max Lines").Range("G" & Rows.count).End
(xlUp).Offset(1, 0)
Set Rng = Range(startcell, endcell)
Rng.ClearContents
Rng.Interior.ColorIndex = xlNone
Sheets("Max Lines").Range("AB4:AB403").ClearContents


For A = 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

'+++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++
++++++++++++++++++++++
'Check the generated line for a match of 4 or more from the previously
generated lines
Dim twoballarrArray(999999, 7) As Variant
Dim myintRow
Dim myintColumn
Dim AllMatches, myLastRow, myxlrow, myk, thematches As Long
Dim IfAthere, IfBthere, IfCthere, IfDthere, IfEthere, IfFthere As
Integer

myxlrow = 1

myLastRow = Sheets("Max Lines").Cells(myxlrow, 1).End(xlDown).Row
'Bottom of the table to check against

For myintColumn = 2 To 7 'The amount of columns wide
For myintRow = 2 To myLastRow 'The amount of Rows to go down

twoballarrArray(myintRow, myintColumn) = Sheets("Max Lines").Cells
(myintRow, myintColumn) ' The array to check, columns and rows

Next
Next

For myxlrow = 1 To myLastRow 'From the first row to the last row with
data in it

For myk = 2 To 7 'Check the columns

Select Case twoballarrArray(myxlrow, myk)
Case A: IfAthere = 1
Case B: IfBthere = 1
Case C: IfCthere = 1
Case D: IfDthere = 1
Case E: IfEthere = 1
Case F: IfFthere = 1
End Select

Next

AllMatches = IfAthere + IfBthere + IfCthere + IfDthere + IfEthere +
IfFthere 'The total of all the matches

IfAthere = 0
IfBthere = 0
IfCthere = 0
IfDthere = 0 ' Set the matches back to zero
IfEthere = 0
IfFthere = 0

If AllMatches 4 Then
thematches = 1
End If

Next
If thematches = 0 Then

'This writes all the data to the sheet much faster using the
array (the resize just expands the range to write in)
Dim z
z = Array(allscen, A, B, C, D, E, F)
Sheets("Max Lines").Range("A" & Rows.count).End(xlUp).Offset(1,
0).Resize(, 7) = z

hitcounter = hitcounter + 1

End If

AllMatches = 0
thematches = 0

mycounter = mycounter + 1

Application.StatusBar = "Checking Line" & " " & Format(A, "#00") & "
" & Format(B, "#00") & " " & Format(C, "#00") & " " & Format(D,
"#00") & " " & Format(E, "#00") & " " & Format(F, "#00") & " " & _
"Completed = " & Format(mycounter, "#00000000") & " " & "Found
Singular Repeat = " & Format(hitcounter, "#000")

Next F
Next E
Next D
Next C
Next B
Next A

Application.StatusBar = False

End Sub

Search faster using array - But it slows down
 

when you use arrays it will but the arrays in memory and depending on
the available memory on your computer will determine the speed. The PC
swaps unused data in memory to the hard drive which is a slow process.

The VBA routines on the worksheet are optimize for speed. Sometimes
code will run faster if you use arrays and sometimes it won't. Usually
samll amounts of data the you will access often in a macro are ideal to
put into memory. Large amounts of data it is better to keep the data on
the worksheet and not to use arrays.


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=145585

Search faster using array - But it slows down
 

Thank Joel,

So there is no obvious alteration I can make to increase the speed as
it is?

I just thought it would be quicker!

I thought with the table being in memory it would be ok... hmmmm...

Ste

Search faster using array - But it slows down
 

There is a very large overhead time whenever VBA reads from a worksheet or
writes to a worksheet.
(see Variant Benchmark http://www.decisionmodels.com/downloads.htm )

So its nearly always better to start the routine by reading all the data
from the worksheet straight into a variant, then do the loops just on
arrays, then when the loops are finished write back to the worksheet.

The reason your VBA is slow is because you are reading a cell and writing a
small array to cells on each iteration of your inmost loop, so the routine
incurs the large overhead on every single iteration of the loops.

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


"Ste Mac" wrote in message
...
Hi, the macro below builds number and then checks the next set it
builds against all the other sets it has built to see if there is a
match of
more than 4 numbers.
I expected it to be fast, it is, at the beginning... but slows down
dramatically the more it has to check... is so big a slow to be
expected?
or is there a tweak I have not done... cheers

ste

Full code

Sub chechformatches()

Dim A, B, C, D, E, F
Dim mycounter As Long
Dim hitcounter As Long
Dim allcounter As Long
Dim allscen As Long

Application.ScreenUpdating = False

hitcounter = 0

'Just clears the sheet ready for generation
Dim startcell, endcell, Rng As Range
Set startcell = Sheets("Max Lines").Range("A3")
Set endcell = Sheets("Max Lines").Range("G" & Rows.count).End
(xlUp).Offset(1, 0)
Set Rng = Range(startcell, endcell)
Rng.ClearContents
Rng.Interior.ColorIndex = xlNone
Sheets("Max Lines").Range("AB4:AB403").ClearContents


For A = 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

'+++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++
++++++++++++++++++++++
'Check the generated line for a match of 4 or more from the previously
generated lines
Dim twoballarrArray(999999, 7) As Variant
Dim myintRow
Dim myintColumn
Dim AllMatches, myLastRow, myxlrow, myk, thematches As Long
Dim IfAthere, IfBthere, IfCthere, IfDthere, IfEthere, IfFthere As
Integer

myxlrow = 1

myLastRow = Sheets("Max Lines").Cells(myxlrow, 1).End(xlDown).Row
'Bottom of the table to check against

For myintColumn = 2 To 7 'The amount of columns wide
For myintRow = 2 To myLastRow 'The amount of Rows to go down

twoballarrArray(myintRow, myintColumn) = Sheets("Max Lines").Cells
(myintRow, myintColumn) ' The array to check, columns and rows

Next
Next

For myxlrow = 1 To myLastRow 'From the first row to the last row with
data in it

For myk = 2 To 7 'Check the columns

Select Case twoballarrArray(myxlrow, myk)
Case A: IfAthere = 1
Case B: IfBthere = 1
Case C: IfCthere = 1
Case D: IfDthere = 1
Case E: IfEthere = 1
Case F: IfFthere = 1
End Select

Next

AllMatches = IfAthere + IfBthere + IfCthere + IfDthere + IfEthere +
IfFthere 'The total of all the matches

IfAthere = 0
IfBthere = 0
IfCthere = 0
IfDthere = 0 ' Set the matches back to zero
IfEthere = 0
IfFthere = 0

If AllMatches 4 Then
thematches = 1
End If

Next
If thematches = 0 Then

'This writes all the data to the sheet much faster using the
array (the resize just expands the range to write in)
Dim z
z = Array(allscen, A, B, C, D, E, F)
Sheets("Max Lines").Range("A" & Rows.count).End(xlUp).Offset(1,
0).Resize(, 7) = z

hitcounter = hitcounter + 1

End If

AllMatches = 0
thematches = 0

mycounter = mycounter + 1

Application.StatusBar = "Checking Line" & " " & Format(A, "#00") & "
" & Format(B, "#00") & " " & Format(C, "#00") & " " & Format(D,
"#00") & " " & Format(E, "#00") & " " & Format(F, "#00") & " " & _
"Completed = " & Format(mycounter, "#00000000") & " " & "Found
Singular Repeat = " & Format(hitcounter, "#000")

Next F
Next E
Next D
Next C
Next B
Next A

Application.StatusBar = False

End Sub

Search faster using array - But it slows down
 

Hi Charles, wow, this is interesting can you give me an example
please...

So, you are saying do not write anything to the sheet until the end?

Ste

Search faster using array - But it slows down
 

Yes, keep all the intermediate stuff in arrays then write to the sheet at
the end.

here is a simple example reading and writing about 260000 cells

option base 1
option explicit
sub SteCheck()
dim vArr as variant
dim j as long
dim k as long

'read from a sheet into a variant
vArr=Worksheets("MySheet").Range("A3:Z10000")
' varr now contains a 2-dimensional array of worksheet data

for j=lbound(varr,1) to ubound(varr,1)
' loop on rows
for k=lbound(varr,2) to Ubound(varr,2)
' loop on cols
varr(j,k)=varr(j,k)+j*k
next k
next j

' write result back
Worksheets("MySheet").Range("A3:Z10000")=varr

end sub

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

"Ste Mac" wrote in message
...
Hi Charles, wow, this is interesting can you give me an example
please...

So, you are saying do not write anything to the sheet until the end?

Ste

Search faster using array - But it slows down
 

Charles, I have just run your example and my word its fast, I would
NEVER have looked in this direction.

The macro I have was put together from people such as yourself in this
ng.

Charles, will show me how you would insert your code into mine please.

This is most interesting.

Thankyou very much

Ste

Search faster using array - But it slows down
 

Just out of curiosity, exactly what is your code accomplishing (that is,
what is the start condition and what end condition are you looking to
achieve)... I just have this "feeling" there may be a different, more
efficient approach available, but I am not totally sure what your code is
attempting to do.

--
Rick (MVP - Excel)


"Ste Mac" wrote in message
...
Charles, I have just run your example and my word its fast, I would
NEVER have looked in this direction.

The macro I have was put together from people such as yourself in this
ng.

Charles, will show me how you would insert your code into mine please.

This is most interesting.

Thankyou very much

Ste

Search faster using array - But it slows down
 

Hi Rick, the code builds a line of numbers (starting 1,2,3,4,5,6) and
so on... once a set of numbers
has been 'kept' I do not want another set of numbers that have 4 or
more of the numbers that have been
'kept' in them, hence the match bit.

Charles has shown me that the data, instead of being written to the
sheet on each 'kept' set of numbers,
it can be saved until the end and write the whole lot to the sheet at
once.

I do not know how to do this: ie save all the data until the end.

Charles wrote an example piece of code, I have had a play with it and
it is very very fast, and would like to
see it utilised in my macro...

Ste

Search faster using array - But it slows down
 

I'm sorry, but your have not added significantly to your previous
description of what you want your output to look like for me to understand
what you are attempting to do. Could you, perhaps, give a sample output
(Columns A to G) of a few lines of what you expect the code to produce and
and example or two of what you would consider as invalid output. Try and
remember you are describing some you are intimately familiar with to a bunch
of people who have no idea what you are trying to do... that means you
cannot take for granted any information in your description.

--
Rick (MVP - Excel)


"Ste Mac" wrote in message
...
Hi Rick, the code builds a line of numbers (starting 1,2,3,4,5,6) and
so on... once a set of numbers
has been 'kept' I do not want another set of numbers that have 4 or
more of the numbers that have been
'kept' in them, hence the match bit.

Charles has shown me that the data, instead of being written to the
sheet on each 'kept' set of numbers,
it can be saved until the end and write the whole lot to the sheet at
once.

I do not know how to do this: ie save all the data until the end.

Charles wrote an example piece of code, I have had a play with it and
it is very very fast, and would like to
see it utilised in my macro...

Ste

Search faster using array - But it slows down
 

Apologies Rick... l'll try again

The macro generates 6 numbers starting with 1-2-3-4-5-6 and then
1-2-3-4-5-7 and so on...

What l am trying to do is, if a set of numbers generated has 4 or more
numbers in a set
of six numbers that have already been generated then l do not want the
line...

An example:

1-2-3-4-5-6 has been generated by the macro (this line is kept)
1-2-3-4-5-7 is the next generated numbers: But it has 4 or more
numbers from the previously generated number - no good
1-2-3-4-5-8 is the next but still has 4 or more numbers from the 1st
generated numbers - no good
1-2-3-4-5-9 is the next but still has 4 or more numbers from the 1st
generated numbers - no good

and so on, until a set of generated numbers arrive that have 4 or less
numbers fron any of the previously kept lines

The next generated lin that has 4 or less numbers from the 'kept' sets
is:
1-2-3-4-7-8

So we have kept
1-2-3-4-5-6
1-2-3-4-7-8
1-2-3-4-9-10
1-2-3-4-11-12
Which all have 4 or less numbers from the generated sets of 6 numbers

The macro works fine, the problem arises when the 'kept' sets of
numbers start to mount up, it takes longer
and longer to check them and/or write them to the sheet....

I changed Charles's example to write out approx 500,000 numbers and it
only took about 3 seconds
but I have no idea how to implement his code... but it look like he
was dead right about writing the data
to the sheet...

But perhaps I am going about this the wrong way Rick... and there is a
different way of doing this quickly...

This is all very interesting and a big learning curve...

Thanks a lot

Ste

Search faster using array - But it slows down
 

Sorry for the late reply (had to go to work)

How would one store all the values in the array until the code has
run?

I can understand the concept, but this is beyond my programming skills

cheers

Ste

Search faster using array - But it slows down
 

Try this: still quite slow - runs in 2 min 45 secs on my system.
Not sure if the results are correct!

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

Option Explicit
Option Base 1
Sub chechformatches()

Dim A As Long
Dim B As Long
Dim C As Long
Dim D As Long
Dim E As Long
Dim F As Long
Dim Results(10000, 6) As Long
Dim nFound As Long
Dim j As Long
Dim k As Long
Dim L As Long
Dim blNew As Boolean
Dim jSet(6) As Long
Dim nSame As Long

Application.ScreenUpdating = False

Worksheets("Results").UsedRange.Clear


For A = 1 To 25
jSet(1) = A
For B = A + 1 To 26
jSet(2) = B
For C = B + 1 To 27
jSet(3) = C
For D = C + 1 To 28
jSet(4) = D
For E = D + 1 To 29
jSet(5) = E
blNew = True
For F = E + 1 To 30
If Not blNew Then Exit For
jSet(6) = F

If nFound 0 Then

For j = nFound To 1 Step -1
nSame = 0
For k = 1 To 6
For L = 1 To 6
If jSet(L) = Results(j, k) Then
nSame = nSame + 1
Exit For
End If
Next L
If nSame 4 Then
blNew = False
Exit For
End If
Next k
If Not blNew Then Exit For
Next j
End If

If blNew Then
nFound = nFound + 1
For k = 1 To 6
Results(nFound, k) = jSet(k)
Next k
End If

Next F
Next E
Next D
Next C
Next B
Application.StatusBar = nFound
Next A

Worksheets("Results").Range("B3").Resize(5000, 6) = Results
Application.StatusBar = False

End Sub

"Ste Mac" wrote in message
...
Sorry for the late reply (had to go to work)

How would one store all the values in the array until the code has
run?

I can understand the concept, but this is beyond my programming skills

cheers

Ste

Search faster using array - But it slows down
 

Hi. Just a thought...

For F = E + 1 To 30

…do stuff

Next F,E,D,C,B,A


If we pick say variable F, then when we have a "success" with:
1-2-3-4-5-6

Then I believe there is no need to check F as it goes from 7 to 30.
Perhaps exit out of this loop at this time. This would reduce some
checking with just Variable F alone.

I'm a little confused with the statements: "4 or more", and "4 or Less"

Again, just an idea.

Dana DeLouis



On 10/20/09 10:11 AM, Charles Williams wrote:
Try this: still quite slow - runs in 2 min 45 secs on my system.
Not sure if the results are correct!

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

Option Explicit
Option Base 1
Sub chechformatches()

Dim A As Long
Dim B As Long
Dim C As Long
Dim D As Long
Dim E As Long
Dim F As Long
Dim Results(10000, 6) As Long
Dim nFound As Long
Dim j As Long
Dim k As Long
Dim L As Long
Dim blNew As Boolean
Dim jSet(6) As Long
Dim nSame As Long

Application.ScreenUpdating = False

Worksheets("Results").UsedRange.Clear


For A = 1 To 25
jSet(1) = A
For B = A + 1 To 26
jSet(2) = B
For C = B + 1 To 27
jSet(3) = C
For D = C + 1 To 28
jSet(4) = D
For E = D + 1 To 29
jSet(5) = E
blNew = True
For F = E + 1 To 30
If Not blNew Then Exit For
jSet(6) = F

If nFound 0 Then

For j = nFound To 1 Step -1
nSame = 0
For k = 1 To 6
For L = 1 To 6
If jSet(L) = Results(j, k) Then
nSame = nSame + 1
Exit For
End If
Next L
If nSame 4 Then
blNew = False
Exit For
End If
Next k
If Not blNew Then Exit For
Next j
End If

If blNew Then
nFound = nFound + 1
For k = 1 To 6
Results(nFound, k) = jSet(k)
Next k
End If

Next F
Next E
Next D
Next C
Next B
Application.StatusBar = nFound
Next A

Worksheets("Results").Range("B3").Resize(5000, 6) = Results
Application.StatusBar = False

End Sub

"Ste wrote in message
...
Sorry for the late reply (had to go to work)

How would one store all the values in the array until the code has
run?

I can understand the concept, but this is beyond my programming skills

cheers

Ste

Search faster using array - But it slows down
 

Thanks Charles and Dana.. I have only just got back from work, I look
forward to
using your suggestions, I will have a go tomorrow and let you guy's
know...

Charles, I will run your code and check the results against mine and
see if they compare.
Looking at your code, it will take me some time to try and understand
whats going on.

This is a very interesting.

Again, thank you very much for your help

Ste

Search faster using array - But it slows down
 

YOU would get a big speed improvement by improving the algorithm for
comaring the previous results to the present results. If you are smart
you can spped up the reuslt


Old Results 1 2 3 4 5 6

New Results 1 2 3 4 5 6


You first compare 1 with 1 and there is a match. You then exit the 1st
for loop and compare 2 against 1. This is not necessary because you
already had a match of the one.

See if this works and the spped improvement you get

from

For k = 1 To 6
For L = 1 To 6
If jSet(L) = Results(j, k) Then
nSame = nSame + 1
Exit For
End If
Next L
If nSame 4 Then
blNew = False
Exit For
end If
next K


To

LastL = 1
For k = 1 To 6
For L = LastL To 6
If jSet(L) = Results(j, k) Then
nSame = nSame + 1
LastL = L + 1
Exit For
End If
Next L
If nSame 4 Then
blNew = False
Exit For
end If
next K


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=145585

Search faster using array - But it slows down
 

Good idea, seems to work : 2 min 20 sec on my system

I am sure this could be optimised even more!

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

"joel" wrote in message
...

YOU would get a big speed improvement by improving the algorithm for
comaring the previous results to the present results. If you are smart
you can spped up the reuslt


Old Results 1 2 3 4 5 6

New Results 1 2 3 4 5 6


You first compare 1 with 1 and there is a match. You then exit the 1st
for loop and compare 2 against 1. This is not necessary because you
already had a match of the one.

See if this works and the spped improvement you get

from

For k = 1 To 6
For L = 1 To 6
If jSet(L) = Results(j, k) Then
nSame = nSame + 1
Exit For
End If
Next L
If nSame 4 Then
blNew = False
Exit For
end If
next K


To

LastL = 1
For k = 1 To 6
For L = LastL To 6
If jSet(L) = Results(j, k) Then
nSame = nSame + 1
LastL = L + 1
Exit For
End If
Next L
If nSame 4 Then
blNew = False
Exit For
end If
next K


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=145585

Search faster using array - But it slows down
 

It works because the number in the two arays being compared are always
increasing


we get numbers like

1 2 3 4 5 6

Not

1 2 3 4 6 5


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=145585

Search faster using array - But it slows down
 

Absolutely amazing Charles... what a massive increase in speed,
fantastic... but I will be honest, to understand
the code I would have to sit here for months!

I also added Joel's tweak... clever, cheers Joel

I would never have looked at this way, it gives me a lot to look at
and think about.

Many many thanks for your help

Ste

Search faster using array - But it slows down
 

Just out of curiosity, what are the total number of unique solutions to
your problem of 30 numbers, taken 6 at a time, with no set having the
same 5 or 6 numbers?

Dana DeLouis


On 10/21/09 5:13 AM, Ste Mac wrote:
Absolutely amazing Charles... what a massive increase in speed,
fantastic... but I will be honest, to understand
the code I would have to sit here for months!

I also added Joel's tweak... clever, cheers Joel

I would never have looked at this way, it gives me a lot to look at
and think about.

Many many thanks for your help

Ste

Search faster using array - But it slows down
 

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

Search faster using array - But it slows down
 

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 he

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



On 10/21/09 5:51 PM, Ste Mac wrote:
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

Search faster using array - But it slows down
 

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

Search faster using array - But it slows down
 

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


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=145585

Search faster using array - But it slows down
 

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



On 10/24/09 6:06 AM, joel wrote:
To find the source of the problem I think you are going to need to find
the 1st difference. Post the soce you are using and then make sure you
are both using the same macro.

Search faster using array - But it slows down
 

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

Search faster using array - But it slows down
 

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" wrote in message
...
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

Search faster using array - But it slows down
 

Charles Williams wrote:
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

Search faster using array - But it slows down
 

Looks good to me, excellent


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

"Dana DeLouis" wrote in message
...
Charles Williams wrote:
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