Recursion or too many records lead to "Not Responding"

[GKIL67]

Using Access 2003, the following snipset produces 3.628.800 records.
It is actually a permutation procedure, in this example, call GRListWords("", "ABBREVIATE", 10) 10 letters to form all possible words in groups of 10 letters.
My problem is that I can not get them into a table - execution holds and get the message "Not responding".
Even-more, the same happens when I use Debug.Print from the immediate window!
I should also note that it never runs to more than 20K-30K records...

Can somebody figure a way to create this data table?
I've heard about the Dictionary Object, anybody with enough experience to help me out?

Thank you in advance!

Public Function GRListWords(Partial As String, myLetters As String, intLetPerWord As Integer)
''i.e. call GRListWords("", "ABBREVIATE", 10)

Dim I As Integer
Dim Result As String
Dim rs As DAO.Recordset
Dim strSQL As String
  
  strSQL = "Select * from tblGRwords order by GRword"
  Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
  
  'Delete content of table
  'CurrentDb.Execute "Delete * from tblGRwords"
  
    For I = 1 To Len(myLetters)
            Result = Partial & Mid(myLetters, I, 1)
        If Len(Result) < intLetPerWord Then
            GRListWords Result, Left(myLetters, I - 1) & Mid(myLetters, I + 1), intLetPerWord
        Else
            'Debug.Print Result
             CurrentDb.Execute "INSERT INTO tblGRwords (GRword) Values ('" & Result & "')"
        End If
    Next I
rs.Close
End Function

 

[ChrisO]

Something to try:-

Option Compare Database
Option Explicit

Private rs As DAO.Recordset


Private Sub Test()
    
    CurrentDb.Execute "Delete * From tblGRwords"
    
    Set rs = CurrentDb.OpenRecordset("tblGRwords", dbOpenDynaset)

    GRListWords "", "ABBREVIATE", 10

    MsgBox rs.RecordCount & " records"

End Sub


Public Sub GRListWords(ByRef strPartial As String, _
                       ByRef strLetters As String, _
                       ByRef intLetPerWord As Integer)
                       
    Dim intPos    As Integer
    Dim strResult As String
    
    For intPos = 1 To Len(strLetters)
        strResult = strPartial & Mid(strLetters, intPos, 1)
            
        If Len(strResult) < intLetPerWord Then
            GRListWords strResult, _
                        Left(strLetters, intPos - 1) & Mid(strLetters, intPos + 1), _
                        intLetPerWord
        Else
            rs.AddNew
                rs!GRword = strResult
            rs.Update
        End If
    Next intPos
        
End Sub

This does produce duplicates, don't know if that is what you want.

Chris.

 

[GKIL67]

Thank you Chris for straightening my code up... :banghead:

The message "Not responding" still appears and the screen appears "hanging", however the table gets filled correctly, after about 15min.
I tried to insert the DoEvents in several places and it does make a huge difference, no message, Access doesn't hang and records seem to be filling up correctly, but it takes for ever to finish - I used ctrl-Break within about 1hour (3 inserts, about 3 hours of testing).

You are very right about the duplicates... Are you suggesting something like:

rs.FindFirst "GRword = "strResult""
If Not rs.NoMatch Then
  'Keep processing.
End If

Or maybe you can suggest something that will take less running time to complete?

Thanks so much!

 

[ChrisO]

Something very strange is going on with your computer, I get 3628800 records in 85 seconds.

Is the Table local or over a network?
If network, is the Table in Access or SQL server?
Do you have a virus scan running?
Has your computer dropped in memory?
Is it going to virtual memory on disk?

Reduce string strLetters to the first 6 characters.
On my computer, this produces 720 records in 15 to 30 milliseconds.
Add one character at a time back into strLetters.

Copy and paste this code:-

Option Compare Database
Option Explicit

Public Declare Function timeGetTime Lib "Winmm.dll" () As Long

Private rs As DAO.Recordset


Sub Test()
    Dim lngStart As Long
    
    lngStart = timeGetTime()
    
    CurrentDb.Execute "Delete * From tblGRwords"
    
    Set rs = CurrentDb.OpenRecordset("tblGRwords", dbOpenDynaset)

    GRListWords "", "ABBREV", 6  ' "ABBREVIATE", 10

    MsgBox rs.RecordCount & " records in " & timeGetTime() - lngStart & " milliseconds"

End Sub


Public Sub GRListWords(ByRef strPartial As String, _
                       ByRef strLetters As String, _
                       ByRef intLetPerWord As Integer)
                       
    Dim intPos    As Integer
    Dim strResult As String
    
    For intPos = 1 To Len(strLetters)
        strResult = strPartial & Mid(strLetters, intPos, 1)
            
        If Len(strResult) < intLetPerWord Then
            GRListWords strResult, _
                        Left(strLetters, intPos - 1) & Mid(strLetters, intPos + 1), _
                        intLetPerWord
        Else
            rs.AddNew
                rs!GRword = strResult
            rs.Update
        End If
    Next intPos
        
End Sub

Edit:
Compact and repair.
The full 10 characters take my test database from 140k to 120544k on the first run and 240944 on the second and subsequent runs. If your computer memory has dropped to below 500 Meg it will probably be going to disk.

For testing, you can use the attached demo in Access 2003.

Chris.

 

[GKIL67]

I guess it’s a hardware issue - what I have available for the time being is an MCI N270 1.6GHZ 1GB and I also tested it on an ASUS 1015BX C50 1GHz 2GB.
None of them are quite up to the job...

The 720 records give me 239 milsecs whilst the 3628800 records anywhere from 436951 to 1529083 milsecs (the more I repeat the run the longer it takes). The MSI seems to be dropping in memory.
Kindly see the attachments. Physical memory starts off 300MB and drops to 190MB whilst CPU reaches 100%.

Much obliged Chris for taking the time to point it out so now I'm more aware...

Considering the duplicates, which greatly increases the completion time and consumes resources - even leading to the "Not Responding" msg, the purpose of the code is to de-scrabble a word and find the right word against a dictionary of words. So, the letters within the strLetters may repeat as to the word they originate from.

So, the issue now is how can the code prevent the storage of duplicates,
do you align with the idea of doing a search or have something better in mind?

 

[ChrisO]

So far, the fastest way I've found to remove duplicates is to let the system do it.

Set the field in the table to 'Indexed Yes (No Duplicates)' and run the recursion with On Error Resume Next. Doing it that way it will not matter if the algorithm is wrong, Jet will simply not let duplicates into the table.

With 10 characters you should get 453600 records but with an increase in time by a factor of about 3.5. With the word "ABBREVIATE" that is both mathematically correct and also correct with testing.

By the way, my computer is about 5 years old and has a 2.33 GHz processor and 2 GB of memory. The hard disks are RAID 0 so they should be about 10% slower than normal. I'm thinking there is something else going on at your end because you seem to be running at 20% of what my old machine can do.

Another strange thing is that I only ever get to 50% CPU usage and you seem to be running at 100%. I can even send and receive Emails while running it.

This might be a good test to find out what's going on with your machines.

Maybe someone else can test it and/or spot the difference we get in the time taken.

Chris.

 

[ChrisO]

The calculation for duplicates in permutations used here, and what ends up in the table, is…

Factorial = n!

Total of set of 10 with no duplicates:-
"ABCDEFGHIJ" = 10
We have 10! = 3628800

With ‘A’ and ‘B’ and ‘E’, each duplicated twice as in:-
"ABBREVIATE" = 10
We have 10! / 2! / 2! / 2! = 453600

With ‘A’ and ‘B’, each duplicated twice and with ‘E’ duplicated three times as in:-
"ABBREVIAEE" = 10
We have 10! / 2! / 2! / 3! = 151200

All the way to reductio ad absurdum…
With ‘A’ duplicated ten times as in:-
“AAAAAAAAAA” = 10
We have 10! / 10! =1

Factorial of the total set divided by the factorial of each of the sets of duplications.

With that said, I still think you have a problem with your computers.

Chris.

 

[GKIL67]

By the way, my computer is about 5 years old and has a 2.33 GHz processor and 2 GB of memory. The hard disks are RAID 0 so they should be about 10% slower than normal. I'm thinking there is something else going on at your end because you seem to be running at 20% of what my old machine can do.

Another strange thing is that I only ever get to 50% CPU usage and you seem to be running at 100%. I can even send and receive Emails while running it.
Chris.

Well, for this kind of job I would go for your CPU - mine is an Atom and that makes a whole lot of a difference...
Also, I run memtest overnight and Defrag, but found no errors...
Morever, I disabled all visual effects (under mycomputer/Performance/Settings), but still no noticeable improvement...
I'm not happy but I don't see I can do much about it!