Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

How to make this  looping faster

Posted on 2006-06-21
30
Medium Priority
?
365 Views
Last Modified: 2010-04-07
Hi! Is there anyway to make this loop faster?


for ctr1 = 1 to NumOfChar
        for ctr2 = 1 to NumOfChar
                   for ctr3 = 1 to NumOfChar
                            for ctr4 = 1 to NumOfChar
                                       for ctr5 = 1 to NumOfChar

                                          ******my statement********


                                       next ctr5
                             next ctr4
                  next ctr3
         next ctr2
next ctr1
0
Comment
Question by:JackOfPH
  • 8
  • 6
  • 5
  • +5
30 Comments
 
LVL 143

Expert Comment

by:Guy Hengel [angelIII / a3]
ID: 16949513
depends alot on what "My Statement" is.
if you are concatenating strings, you might use the stringbuilder class, will be up to 1000% faster
0
 
LVL 17

Expert Comment

by:inthedark
ID: 16949708
If you are working with strings, with some actions, it is millions% faster to convert them to byte arrays first.

But we need to see or know what your are trying to achieve
0
 
LVL 10

Expert Comment

by:cool12399
ID: 16953658
hehe, sounds like a comp sci homework question :) (i know that because I've had to answer similar questions
before, and it looks strangely like one of those questions)... if it *is*, you *should* be doing your hmwk yourself...

but technically speaking, yes, to make it loop faster since you have "NumOfChar" as the range each time from 1, the loop
you described is technically equivalent to NumOfChar^5

so
for ctr1 = 1 to (NumOfChar ^ 5)
    ******my statement********
next ctr1

is technically equivalent to what you wrote, but "faster", because you have less actual "machine" code instructions
being executed each time. It is a very marginal difference (unless you are using a stack each time for the loop, in
which case it is a big difference), but bottomline, the loop above is faster than what you have.

0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 15

Author Comment

by:JackOfPH
ID: 16956337
to cool12399

This is not a homework... I graduated 2 years ago... I am asking this because I dealing of permutations... in my program... I need to make the program faster.

to others, Angel and inthedark here is the statement...

for ctr1 = 1 to NumOfChar
        for ctr2 = 1 to NumOfChar
                   for ctr3 = 1 to NumOfChar
                            for ctr4 = 1 to NumOfChar
                                       for ctr5 = 1 to NumOfChar

                                    list1.additem myArray(ctr1) + myArray(ctr2) + myArray(ctr3) + myArray(ctr4) + myArray(ctr5)


                                       next ctr5
                             next ctr4
                  next ctr3
         next ctr2
next ctr1


please help?
0
 
LVL 15

Author Comment

by:JackOfPH
ID: 16956343
whats the string builder class? can anyone explain?
0
 
LVL 15

Author Comment

by:JackOfPH
ID: 16956366
I am just using vb 6.0? Does string builder comes from vb.net, c#?
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 16956471
>>list1.additem myArray(ctr1) + myArray(ctr2) + myArray(ctr3) + myArray(ctr4) + myArray(ctr5)


string builder will not help you.

If you use listbox, you better change to use listview instead.
0
 
LVL 86

Expert Comment

by:Mike Tomlinson
ID: 16956587
It looks like you are basically "counting" using the elements of the "myArray".

What is in "myArray"?

Just to get your creative juices flowing, here is a different approach to a "counting" system:
http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_21857955.html

In the above PAQ, you can specify the characters to use in the counting sequence...
0
 
LVL 18

Expert Comment

by:Sethi
ID: 16956621
One way of making loops faster is by not using the variable name with the Next clause. So you Next clauses will look like this:

                                     next
                             next
                  next
         next
next

Instead of:
                                     next ctr5
                             next ctr4
                  next ctr3
         next ctr2
next ctr1

0
 
LVL 15

Author Comment

by:JackOfPH
ID: 16956774
my array holds characters alphbet letters.
0
 
LVL 18

Expert Comment

by:Sethi
ID: 16956779
What I have mentioned in an optimization tip for any loop and it will work in your case too.
0
 
LVL 15

Author Comment

by:JackOfPH
ID: 16956784
Ok trying all your suggestions... will be back in minutes... thanks
0
 
LVL 10

Expert Comment

by:cool12399
ID: 16956940
hi jack...

if you are trying to enumerate (and create) *all* different possibilities, then there are not really any loop optimizations.
if all you want to do is get the possible #, do something like:
http://www.devx.com/vb2themax/Tip/19017

------->

' number of permutations of N objects in groups of M
'
' Note: requires the FACTORIAL routine

Function Permutations(ByVal Objects As Long, ByVal GroupSize As Long) As Double
    Permutations = Factorial(Objects) / Factorial(Objects - GroupSize)
End Function
0
 
LVL 143

Expert Comment

by:Guy Hengel [angelIII / a3]
ID: 16957084
one of many stringbuilder classes for vb6:
http://www.15seconds.com/howto/pg000929.htm
but as said, this will probably not help here

>my array holds characters alphbet letters.
what kind of combinations? are they in order or what?
what is the max value of NumOfChar?
0
 
LVL 15

Author Comment

by:JackOfPH
ID: 16957771
>my array holds characters alphbet letters.
what kind of combinations? are they in order or what?
what is the max value of NumOfChar?


my array holds the characters in the alphabet

for example

myArray(1) holds the value "a" and myArray(2) holds the value "2"
0
 
LVL 15

Author Comment

by:JackOfPH
ID: 16957782
Idle mind I tried your comments... and the sample code in the link... but it gave me no speed... is there anyway?
0
 
LVL 17

Expert Comment

by:inthedark
ID: 16957798
The looping is not the issue here, you could make your code instant. But this will take a bit of time.

But for a quick fix try this.....it will make the code run way much faster

1) Qucik solution

Before the loop

FreezeSet Me
for ctr1 = 1 to NumOfChar
    For ctrl2
etc.....
    Next
Next

' After all loops are complete
FreezeClear

See next post for an instant solution......


' change private to public if you want to put code in a module.

Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

Private Sub FreezeSet(FormToFreeze As Object)
    ' lock as form so that windows will not update display
    ' to increase speed or make whole screen appear as if by magic
    'Example:  FreezSet Me
    LockWindowUpdate FormToFreeze.Hwnd
End Sub
Private Sub FreezeClear()
    ' release a locked screen
   ' Example: FreezeClear    
    LockWindowUpdate 0&
End Sub
0
 
LVL 143

Expert Comment

by:Guy Hengel [angelIII / a3]
ID: 16957867
I tried some combinations, but with NumOfChar=9, it takes already 2 seconds.
what value of NumOfChar do you use?
0
 
LVL 143

Expert Comment

by:Guy Hengel [angelIII / a3]
ID: 16957879
inthedark, fyi, the LockWindowUpdate did not change anything in my case...
0
 
LVL 15

Author Comment

by:JackOfPH
ID: 16958224
No, change...
0
 
LVL 17

Expert Comment

by:inthedark
ID: 16958450
Here is a handy permutations class I created for generating permutations for either alpha or numeric values.
It loops like a recordset, for simplicity and will return either a key value or an array of numeric values.

See examples in the declarations...

----------Class: zPermutations.cls
Option Explicit

' Class: zPermutations
' Author: Nick Young nyoung@vipintersoft.com
' Copyright (c) 2003 Nick Young
' You may use & distribute freely but provided that the author and copyright are acknowledged.

' WARNING: Read The Notes for the item property

'EXAMPLES OF USAGE:

'' example 1 using numeric keys
'Dim Px As zPermutations
'Set Px = New zPermutations
'Px.Elements = 3
'Px.AddKey 1
'Px.AddKey 2
'Px.AddKey 3
'Px.Numeric = True
'Px.MoveFirst
'Do While Not Px.EOF
'    Debug.Print Px.CurrentKey
'    Px.MoveNext
'Loop
'Stop
'
'' example 2 using aplha keys
'Set Px = New zPermutations
'Px.Elements = 3
'Px.AddKey "A"
'Px.AddKey "B"
'Px.AddKey "C"
'Px.Numeric = False
'Px.MoveFirst
'Do While Not Px.EOF
'    Debug.Print Px.CurrentKey
'    Px.MoveNext
'Loop
'Stop
'
'' Example 3 using array of values
'Set Px = New zPermutations
'Px.Elements = 3
'Px.AddKey 1
'Px.AddKey 2
'Px.AddKey 3
'Px.Numeric = True
'Px.ArrayBase = 0 ' set
'
'Px.MoveFirst
'
'Dim CurrentKey() As Long
'Dim lc As Long
'
'Do While Not Px.EOF
'    Px.LoadCurrentLongArray CurrentKey()
'    For lc = LBound(CurrentKey) To UBound(CurrentKey)
'        Debug.Print CStr(CurrentKey(lc)); " ";
'    Next lc
'    Debug.Print
'    Px.MoveNext
'Loop
'Stop


Dim mlElements As Long

Dim B() As Boolean
Dim Sequence() As Long


Dim mbComplete As Boolean
Dim mlCurrent As Long

Public ElementsFound As Long

Public Numeric As Boolean


Dim mlKeyCount
Dim mvKeys() As Variant

Dim mlArrayBase As Long

Public Function AddKey(Key)

' adds a key value for the next element

mlKeyCount = mlKeyCount + 1
ReDim Preserve mvKeys(mlKeyCount - 1)
mvKeys(mlKeyCount - 1) = Key

End Function


Public Property Let ArrayBase(plNewValue As Long)
mlArrayBase = plNewValue
End Property

Public Function Char(Item) As String
' converts a binary value into a letter
' so zero is A, 1 is B etc.
Char = Chr(Item + 65)
End Function


Public Function CurrentKey() As String

' display the current key value
' this may key may be meaningless if numeric keys above 9 are used.

If Numeric Then
    Dim sKey As String
    Dim lc As Long
   
    sKey = Space(mlElements + 1)
   
    For lc = 0 To mlElements
        Mid(sKey, lc + 1, 1) = Chr(48 + mvKeys(Sequence(lc)))
    Next lc
    CurrentKey = sKey
Else

   
   
    sKey = ""
   
    For lc = 0 To mlElements
        sKey = sKey & mvKeys(Sequence(lc))
    Next lc
    CurrentKey = sKey
End If

End Function

Public Sub LoadCurrentLongArray(rLongArray() As Long)

' display the current key value
' this may key may be meaningless if numeric keys above 9 are used.
Static bDone As Boolean
If Not bDone Then
    bDone = True
    ReDim rLongArray(mlArrayBase To mlArrayBase + mlElements)
End If

Dim sKey As String
Dim lc As Long

sKey = ""

For lc = 0 To mlElements
    rLongArray(lc + mlArrayBase) = mvKeys(Sequence(lc))
Next lc


End Sub
Public Function EOF() As Boolean

' returns true if all possibles been found?

EOF = mbComplete
End Function
Public Property Get Item(Element) As Variant

' ** WARNING: READ THESE NOTES:
' make this the default proeprty
' Select Tools, Provedure attributes, select the Item propery,
' then Advanced, change the procedure ID to Default,
' then click APPLY

' this will return the key value for an element
' or if no keys were specified it will return
' the numeric value of the sequence

If mlKeyCount > 0 Then
    Item = mvKeys(Sequence(Element))
Else
    Item = Sequence(Element)
End If

End Property

Public Property Get Value(Element) As Long

' this will return the numeric value for an element

Value = Sequence(Element)

End Property

Public Sub MoveFirst()

' move to the start of the sequence

ReDim B(mlElements)
ReDim Sequence(mlElements)

Dim lc As Long

' SET UP LOWEST POSSIBLE VALUE
For lc = 0 To mlElements
    Sequence(lc) = lc
Next

' setup starting point for next move
mlCurrent = mlElements
ElementsFound = 1
mbComplete = False

End Sub

Public Sub MoveNext()

' setup key values for the next item

Dim bInvalid As Boolean
Dim lc As Long
Dim lVal As Long

' keep looping until the next valid permutation is found

' example 42345 is invalid so add 1
' butthe thing that makes this routine fast
' is that it knows that the 2nd 4 is repeated and must be changed next

Do
       
    Advance
   
    If mbComplete Then Exit Sub
   
   
    ' now see if the current sequence is a valid permutation
   
    ' clear an incidator so see if a value has been found
    For lc = 0 To mlElements
        B(lc) = False
    Next
   
   
   
    bInvalid = False
   
    For lc = 0 To mlElements
        lVal = Sequence(lc)
        If B(lVal) Then
            bInvalid = True
            Exit For
        Else
            B(lVal) = True
        End If
    Next
   
    If Not bInvalid Then
        ' make sure next advance will work on the last change
        mlCurrent = mlElements
        Exit Do
    End If
   
Loop
   
ElementsFound = ElementsFound + 1

End Sub


Private Sub Advance()

' to see what this functions does is imagine you
' are working in base 10 and you have the number
' 12349
' add 1 to this number and you get 12350
' this function does the same but in the specified base

' ABC
' ACA
' ACB

Do
    ' add 1 to the last returned sequence
    Sequence(mlCurrent) = Sequence(mlCurrent) + 1
    If Sequence(mlCurrent) <= mlElements Then
        mlCurrent = mlElements
       ' Form1.List1.AddItem "N: " + CurrentKey
        Exit Sub
    End If
    Sequence(mlCurrent) = 0
    mlCurrent = mlCurrent - 1
    If mlCurrent < 0 Then
        mbComplete = True
        Exit Sub
    End If
Loop

End Sub
Public Property Get Elements() As Long

' returns the number of elements

Elements = mlElements + 1

End Property


Public Property Let Elements(NewValue As Long)

' Sets the number of elements to be used

' example value passed as 5
' is elements 0 to 4 so the number 4 is stored

' but don't allow less than 2 elements
If NewValue < 2 Then
    mlElements = 1
Else
    mlElements = NewValue - 1
End If

ReDim mvKeys(mlElements)
Dim lc As Long
For lc = 0 To mlElements
    mvKeys(lc) = Chr(65 + lc)
Next lc
mlKeyCount = 0

MoveFirst

End Property



Public Property Get Permutations() As Double

' calculate the possibilities

Dim P As Double
Dim lc As Double

P = 1
For lc = mlElements + 1 To 2 Step -1
    P = P * lc
Next

Permutations = P

End Property


Private Sub Class_Initialize()
    mlArrayBase = 0
End Sub





0
 
LVL 17

Expert Comment

by:inthedark
ID: 16958762
Here is a method to display as you were trying but not using a list box (which is slow) but using a virtual window VP

The results display instantly.


1) New project
2) Add picture box called VP

When you run the app press page/down and page/up to scroll through data.

Also set the VP.appearance to flat and the scalemode to pixels


-----------------------sample.frm
Option Explicit

Dim mlTextHeight As Long
Dim mlLinesInWindow As Long
Dim mlTopLine As Long
Dim mlTotalLines As Long

Dim MyArray(1 To 5) As String


Private Type udtPagePoint
    Positions(1 To 5) As Long
End Type

Dim Pages() As udtPagePoint
Dim Current As udtPagePoint

Dim mlLineHeight As Long
Dim mlLinesInVP As Long
Dim mlPage As Long
Dim mlMaxPages As Long

Dim mbEOF As Boolean

Sub Advance()

' get next number

Dim lc As Long
lc = UBound(MyArray)
Do

    Current.Positions(lc) = Current.Positions(lc) + 1
    If Current.Positions(lc) <= UBound(MyArray) Then
        mbEOF = False
        Exit Do
    End If
    Current.Positions(lc) = 1
    lc = lc - 1
    If lc < 1 Then
        mbEOF = True
        Exit Do
    End If
Loop
   
End Sub

Sub DisplayWindow()
If mlPage > UBound(Pages) Then
    ReDim Preserve Pages(UBound(Pages) + 100)
End If
If mlPage > mlMaxPages Then
    mlMaxPages = mlPage
    Pages(mlPage) = Current
    mbEOF = False
Else
    If mlPage < 0 Then
        mlPage = 0
        MoveFirst
    End If
    Current = Pages(mlPage)
    mbEOF = False
End If
   
Dim lc As Long
VP.Cls

Dim lcc As Long

For lc = 0 To mlLinesInVP
    VP.CurrentX = 0
    VP.CurrentY = lc * mlLineHeight
    For lcc = 1 To UBound(Current.Positions)
        VP.Print MyArray(Current.Positions(lcc));
    Next
    Advance
    If mbEOF Then
        Exit Sub
    End If
Next
   
End Sub


Sub MoveFirst()
Dim lc As Long
For lc = 1 To UBound(MyArray)
    Current.Positions(lc) = 1
Next
End Sub

Sub WindowSetup()

mlLineHeight = VP.TextHeight("V") * 1.05
mlLinesInVP = VP.ScaleHeight / mlLineHeight



End Sub

Private Sub Form_Activate()
VP.SetFocus
End Sub

Private Sub Form_Load()
MyArray(1) = "A"
MyArray(2) = "B"
MyArray(3) = "C"
MyArray(4) = "D"
MyArray(5) = "E"
mlPage = 0


mlMaxPages = -1

ReDim Pages(100)

WindowSetup

mlPage = 0
MoveFirst
DisplayWindow

End Sub

Private Sub Form_Resize()

If Me.WindowState = vbMinimized Then Exit Sub

VP.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight

End Sub


Private Sub VP_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
    Case Is = vbKeyPageUp
        mlPage = mlPage - 1
        mbEOF = False
        DisplayWindow
    Case Is = vbKeyPageDown
        mlPage = mlPage + 1
        DisplayWindow
End Select
End Sub


0
 
LVL 17

Expert Comment

by:inthedark
ID: 16958775
On the form load you need to add

Me.Show
DoEvents

Before

DisplayWindow
0
 
LVL 86

Expert Comment

by:Mike Tomlinson
ID: 16959650
My code will NOT increase your speed at all.

It was simply intended to show you a different way of generating permutations.  Your current method is limited because you are hard coding a series of For...Next loops which cannot be changed programmatically.

The method I demonstrate in my link can generate any length(s) of permutations given the "character set".  You would simply initialize a string to the starting sequence and then repeatedly pass it in to the function inside a while loop until the desired string length is exceeded.

So my method is more flexible, but definitely not any faster...
0
 
LVL 10

Accepted Solution

by:
cool12399 earned 2000 total points
ID: 16965782
Ahhhhhhhhhhhhhh... Ok.

Now that you clarified your code, I know how to make it faster. You don't want to make the "loop" faster per se.
Do this before your loop:

list1.visible=false

Then execute your loop.

Then have list1.visible = true

You'll notice a huge difference in speed. So basically:

====================================

list1.visible=false
for ctr1 = 1 to NumOfChar
        for ctr2 = 1 to NumOfChar
                   for ctr3 = 1 to NumOfChar
                            for ctr4 = 1 to NumOfChar
                                       for ctr5 = 1 to NumOfChar
                                          list1.additem myArray(ctr1) + myArray(ctr2) + myArray(ctr3) + myArray(ctr4) + myArray(ctr5)
                                      next ctr5
                             next ctr4
                  next ctr3
         next ctr2
next ctr1
list1.visible=true

There ya go. Points please!

please help?
0
 
LVL 10

Expert Comment

by:cool12399
ID: 16965798
hehe, shouldn't have had the 'please help' at the end (that was a copy of the post).

Anyways, there ya go. You'll notice a huge difference. :D
0
 
LVL 9

Expert Comment

by:justchat_1
ID: 16972884
The listbox never even disappears but about 210% speed increase...
0
 
LVL 10

Expert Comment

by:cool12399
ID: 16975546
yes, once you put the listbox in the code, I knew exactly what you were talking about, because
I've had exactly the same thing! :) if you want it to 'disappear' temporarily (which might even
be a *little* faster), stick a 'doEvents' after you do the 'visible' statement, i.e.,

listbox1.visible=false
doevents
...
etc
...
listbox1.visible=true
doevents

good luck!
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 16976576
If you use listview you will have 500% faster

8->
0
 
LVL 17

Expert Comment

by:inthedark
ID: 16990645
Virtual window would be million% faster as it is instant.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

963 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question