permutations checkspelling speed

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
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
Code:
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
 
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
 
Upvote 0

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
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.
 
Upvote 0
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.
 
Upvote 0
Gene,

Some keep thinking, that I can answer that kinda questions :-D 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. :huh: 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
 
Upvote 0
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(y)


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
 
Upvote 0
15 minutes! When I run the code on a 7 letter word, "related", it takes 10 seconds to generate,
Book1
ABCD
1relatedrelated
2related
3alerted
4altered
5altered
6alerted
7treadle
8treadle
900: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.

Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,971
Members
452,371
Latest member
Frana

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top