permutations checkspelling speed

[erik.van.geit]

Hi, guys and galls,
this is one for the gurus

A1 has some characters
this code will generate all possible words, that can be made using all characters

system
permutate and checkspelling: if OK then write to column B

example
A1: iftrs
results: first frits rifts

Option Explicit


Dim CurrentRow
Const col = 2

Sub correctly_spelled_permutations()
Dim InString As String
Dim CalcSet As Integer
    
    InString = Range("A1")
    If Len(InString) < 2 Then Exit Sub

    With Application
    .ScreenUpdating = False
    CalcSet = .Calculation
    .Calculation = xlCalculationManual
    .EnableCancelKey = xlErrorHandler
    .StatusBar = "searching valid combination"
    End With

On Error GoTo skip
CurrentRow = 0

    'If Len(InString) > 8 Then
        'MsgBox "To many permutations!"
        'Exit Sub
    'Else
        ActiveSheet.Columns(col).Clear
        Call GetPermutation("", InString)
    'End If

skip:
    With Application
    .Calculation = CalcSet
    .ScreenUpdating = True
    .StatusBar = False
    End With

End Sub

Sub GetPermutation(x As String, y As String)
'The source of this algorithm is unknown
Dim i As Integer, j As Integer
j = Len(y)
    
    With Application
        If j < 2 Then
            If .CheckSpelling(x & y) Then
            CurrentRow = CurrentRow + 1
            ActiveSheet.Cells(CurrentRow, col) = x & y
            .StatusBar = "# of valid combinations: " & CurrentRow
            End If
        Else
            For i = 1 To j
            Call GetPermutation(x + Mid(y, i, 1), _
            Left(y, i - 1) + Right(y, j - i))
            Next
        End If
    End With
    
End Sub

any tricks to enhance the speed ?
thank you for reading

kind regards,
Erik

 

[erik.van.geit]

wow,
need to give some replies here

Andrew:

That's quite a nifty algorithm nonetheless. Can you not remember where you got it from?

Found on John Walkenbach's site. He writes: "The source of this algorithm is unknown"

Gene:

As it has been years (decades?) since I earned bread as a programmer, feel free to ignore (laugh?) at my input: Would it be faster if you did not use GetPermuation recursively?

I've never been a progammer. The recursion is needed to get all permutations.

Hi, Teacher,
Do you mean your machine can check about 40000 words in about 1 minute?


here you will find a very interesting technique (not excel)
http://www.nongnu.org/eliot/
look at "The World's Fastest Scrabble Program".

I think Myrna Larson is rather famous too when it comes to permutations
http://groups.google.com/group/microsoft.public.excel.misc/msg/2 150eee92452c83c

weekend-greetings from Belgium,
Erik

 

[PA HS Teacher]

Hi, Teacher,
Do you mean your machine can check about 40000 words in about 1 minute?

Erik,
Yes. Using the .CheckSpelling method I was able to check 40,320 words in 77 second, or about 524 words per second. That's not terribly fast.

I would think you may want to investigate other possibilities for checking the validity of a word. I might also consider investigating ways to prescreen each permutation before applying check spelling method to the permutation.

I think the limiting factor in terms of speed is the CheckSpelling method, which you do not have much control over. Maybe you could search a smaller dictionary?


The scrabble link is interesting. I'm not ready to "digest" it all right now. But at first glance, it looks like they find ways to pare down the dictionary to a smaller subset of the dictionary based on the rules of Scrabble and the current board. So they do not need to search the entire dictionary each time.

 

[mortgageman]

wow,
need to give some replies here

<snip>
Gene:

As it has been years (decades?) since I earned bread as a programmer, feel free to ignore (laugh?) at my input: Would it be faster if you did not use GetPermuation recursively?

I've never been a progammer. The recursion is needed to get all permutations.
<snip>
Erik

But a recursion can (always?) be replaced with a loop. That is what I meant - that perhaps the equivalent loop would be faster than the recursion.

 

[erik.van.geit]

Gene,

Some keep thinking, that I can answer that kinda questions My piano is my main occupation. It could be tested.
Nate, where are you, heeelp !

Teacher,

Some days ago a test on my machine for only 7 characers lasted for - I do not remember exactly all at once - 15 or more minutes. Perhaps there is a problem on my computer.

Didn't read in detail, but what I understood from the link is that they use some "chains"-system, which quickly excludes a mass of possibilities which are anyway going to a dead end. (I'm sure this is very cryptic, so unclear, but it's not easy to word in my non-native language)

perhaps should go to sleep
they are switching hours here this night. (at 2 the clock goes to 3)

greetings,
Erik

 

[mortgageman]

The following non recursive works for cat, but not your example of "first"
Not sure why. I'm going to sleep on it and try again later.


Sub GetPermutation2(x As String, y As String)
'The source of this algorithm is unknown
Dim i As Integer, j As Integer
j = Len


With Application
For i = 1 To j
MsgBox i
MsgBox x + Mid(y, i, 1)
MsgBox Left(y, i - 1) + Right(y, j - i)


If .CheckSpelling(x + Mid(y, i, 1) & Left(y, i - 1) + Right(y, j - i)) Then
CurrentRow = CurrentRow + 1
ActiveSheet.Cells(CurrentRow, col) = x + Mid(y, i, 1) & Left(y, i - 1) + Right(y, j - i)
.StatusBar = "# of valid combinations: " & CurrentRow
End If
Next
End With

End Sub

 

[PA HS Teacher]

15 minutes! When I run the code on a 7 letter word, "related", it takes 10 seconds to generate,

Book1
	A	B	C	D
1	related	related
2		related
3		alerted
4		altered
5		altered
6		alerted
7		treadle
8		treadle
9		00:10.0
Sheet1

Actually the time to run appears to be virtually identical whether I write to the sheet as we go, or whether I add to a collection and then write to the sheet. The time also does not appear to depend on which letters I use. CheckSpelling is called the same number of times. I'm not sure why it takes me almost 100 x less time to run than you.

I am fairly certain that my 3 year old computer is not 100 x faster than yours. By the way I am running Office 2000.

Are you searching for words in English? Dutch?

I don't know that I've added anything significant to the code. I modified your original code slightly so that matching words are added to a collection. I then write all the words in the collection to the sheet.

Option Explicit

Dim colWords As New Collection
Dim CurrentRow
Const col = 2

Sub correctly_spelled_permutations()
Dim InString As String
Dim CalcSet As Integer
Dim iRow As Long
Dim w As Variant
Dim myStart As Double
Dim myStop As Double
    
myStart = Now

    InString = Range("A1")
    If Len(InString)< 2 Then Exit Sub

    With Application
    .ScreenUpdating = False
    CalcSet = .Calculation
    .Calculation = xlCalculationManual
    .EnableCancelKey = xlErrorHandler
    .StatusBar = "searching valid combination"
    End With


CurrentRow = 0
Set colWords = Nothing
ActiveSheet.Columns(col).Clear
Call GetPermutation("", InString)
iRow = 0

For Each w In colWords
  iRow = iRow + 1
  ActiveSheet.Cells(iRow, col).Value = w
Next w
  
myStop = Now

ActiveSheet.Cells(iRow + 1, col).Value = Format(myStop - myStart, "h:mm:ss.000")

skip:
    With Application
    .Calculation = CalcSet
    .ScreenUpdating = True
    .StatusBar = False
    End With

End Sub

Sub GetPermutation(x As String, y As String)
'The source of this algorithm is unknown
Dim i As Integer, j As Integer
j = Len(y)
    
    With Application
        If j< 2 Then
            If .CheckSpelling(x & y) Then
            CurrentRow = CurrentRow + 1
        '    ActiveSheet.Cells(CurrentRow, col) = x & y
             colWords.Add x & y
            .StatusBar = "# of valid combinations: " & CurrentRow
            End If
        Else
            For i = 1 To j
            Call GetPermutation(x + Mid(y, i, 1), _
            Left(y, i - 1) + Right(y, j - i))
            Next
        End If
    End With
    
End Sub

 

[erik.van.geit]

thanks, Teacher,

for some reason my machine was slow when testing the other time
now getting there in 2 minutes, yes, still 2 minutes

french scrabble download
http://www.veriti.net/download.php?lng=fr&pg=787

it has a fast "suggestion"tool