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

 

[EE2006]

Hello Eric,


I am by no means a guru, and honestly I have no idea how to make your code any faster.

That being said, I did take a look at it and it is pretty interesting. One thing I wanted to point out to you in case you weren't aware of it is that whenever there is a duplicate letter, your code will return multiple instances of all words.

For example:

A1= lexce, will return B1=excel and C1=excel


You may already be aware of this, but I figured I would point it out in case you weren't.


Have a nice day.

 

[erik.van.geit]

thank you for taking the time to get this post out of the unanswered list
yes, the problem was known to me, but is not relevant for this question
honestly I'm quite embarassed how to react, sorry

the question was about SPEED
I know it's a difficult one, at least for me

best regards,
Erik

 

[EE2006]

No need to be embarassed Eric.

I did understand your original question, however unfortunately I did not have a suggestion as to how to speed up your code.

With that being said, it is possible that by determining a way to handle duplicate letters you could improve the speed of the code.

For example, the letters bagegar entered in cell A1 returns the word garbage 4 separate times. Once you have checked for the letter g as the first letter one time, there is no need to do the second check. I'm not sure what would be the best way to do this, as I haven't taken the time to dissect your code yet, but this could be one way to reduce the speed.


Anyhow, I hope someone else can provide some more useful suggestions. I'm interested to see how this code can be improved.

 

[LucB]

Hello Erik,

No Gurus comming up yet.
They must have overlooked.

I am still interested and hopeful.

Have a nice weekend.

Kind regards,
Luc

 

[verluc]

This one is very fast :

Dim CurrentRow

Sub GetString()
Dim InString As String
InString = InputBox("Enter text to permute:")
If Len(InString) < 2 Then Exit Sub
If Len(S) >= 8 Then
MsgBox "Too many permutations!"
Exit Sub
Else
ActiveSheet.Columns(1).Clear
CurrentRow = 1
Call GetPermutation("", InString)
End If
End Sub

Sub GetPermutation(x As String, y As String)
Dim i As Integer, j As Integer
j = Len
If j < 2 Then
Cells(CurrentRow, 1) = x & y
CurrentRow = CurrentRow + 1
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 Sub

 

[erik.van.geit]

This one is very fast

no wonder: it is the same as the code above (apart from layout: please use codetags), but one "little detail" missing: there is no spellingcheck !

 

[Andrew Fergus]

Hi Erik

I experimented with 7 character strings and saved the character combinations into an array (of 500 items) and once the array was full I tested the spelling of all 500 items in one go. For all that effort I saved 1 second on a 7 character string - maybe there would be more significant savings on larger strings but it's late here and I will test it tomorrow....

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

Cheers, Andrew

 

[mortgageman]

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

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?

 

[PA HS Teacher]

Erik,
I believe the slow part is the .CheckSpelling Method itself. The possible time saved by adding results to an Array or Collection before writing to the sheet is almost trivial compared to how long it takes to check the spelling of each permutation. I ran this code, which checks the spelling but does not do anything if the permutation is an actual word. I then ran the code on 2,3,4,5,6,7, and 8 character words.

Dim myStart, myFinish As Double
 myStart = Now
 For i = 1 To Application.WorksheetFunction.Fact(Len(Range("A1").Value))
    If Application.CheckSpelling(Range("A1").Value) Then
       ' Do Nothing
    End If
 Next i
 myFinish = Now
 iRow = Range("D65535").End(xlUp).Row + 1
 Cells(iRow, 4).Value = Range("A1").Value
 Cells(iRow, 5).Value = myFinish - myStart
 Cells(iRow, 6).Value = Application.WorksheetFunction.Fact(Len(Range("A1").Value))

Here are my results:

Book1
	D	E	F	G
1	String	Calc Time	Permutations
2	AB	0:00.000	2
3	AB	0:00.000	2
4	ABC	0:00.000	6
5	ABCD	0:00.000	24
6	ABCDE	0:00.000	120
7	ABCDEF	0:02.000	720
8	ABCDEFG	0:10.000	5040
9	ABCDEFGH	1:17.000	40320
Sheet1

As you can see, by the time you get up to 8 characters it take my machine over a minute to check the 40,320 possibilities.

This isn't really my area of expertise, so I'm not sure how I can access the Main Dictionary. I was wondering if it would be possible to write all the entries in the Main Dictionary to a Spreadsheet. (I know it would huge 65,535 rows x Many Columns). Would an Index(Match) applied to this range be any faster?