How do I change my string permute class so that it handles strings longer than 1 char

[tmighty2]

Hello!

I want to recognize strings that a young child inputs even though it may contain spelling errors.
My first language is not English, but I try to explain it in English anyway:

The child might enter "kar" (because it thinks it's written this way), and my software should recognize "car".

What I did was:

I created a class and fed it the input "k", "c".
The class would then create all permutations of the children's input.

So if the child would enter "kar", it would produce
"kar, car"

If I also fed the input "o", "a", and the child enters "kor", the class would produce

"kor, kar, cor, car".

This works fine.

However, I would now like to feed it strings longer than 1 character.

For example:

"rac", "car".

So if the child would enter "rac", it would produce

"rac, car".

However, this does not work with my permutation approach. My permutation approach deals with single characters only.

Can anybody tell me how I could change my class so that it can handle strings that are longer than 1 character?

Thank you!

permute.zip

Here is the code of Form1 (it requires a ListBox named "List1"):

Option Explicit

Private Type udtReplacement
    Original As String
    Replacement As String
End Type

Private Sub Form_Load()

    Dim nReplacements(3) As udtReplacement

    nReplacements(1).Original = "a"
    nReplacements(1).Replacement = "x"
    
    nReplacements(2).Original = "kah"
    nReplacements(2).Replacement = "car"
    
    nReplacements(3).Original = "b"
    nReplacements(3).Replacement = "y"
    
    Dim sText$
    sText = "kahb"

    'For permutation results I expect this:

    'kahb
    'kxhb
    'kxhy
    'kahy
    'carb 'this does not work because my class can only handle single characters
    'cary 'this does not work because my class can only handle single characters
  
    Dim p&
    For p = 1 To UBound(nReplacements)
        
        Dim CP As clsStringPermutate
        Set CP = New clsStringPermutate
        
        Dim sRes() As String
        sRes = CP.Permute(sText, nReplacements(p).Original, nReplacements(p).Replacement)
        
        If UBound(sRes) > 0 Then
            Dim r&
            For r = 0 To UBound(sRes) - 1
                Me.List1.AddItem sRes(r)
            Next r
        End If
        
    Next p

End Sub

And this is the clsStringPermutate:

Option Explicit

Private m_InputString As String
Private m_EquiChar() As String
Private m_Result() As String
Private m_TempResult() As String
Private m_IndexIntoString() As Integer
Private m_IndexIntoChar() As Integer
Private m_TotalOccurance&
Private m_NumberOfResults&

Public Function GetReplacementStrings(lp As Integer) As String

    If lp = m_TotalOccurance Then
        ReplaceByMap
    Else
       Dim i As Integer
       i = 0
       Do While i < UBound(m_EquiChar) + 1
            ReDim Preserve m_IndexIntoChar(UBound(m_IndexIntoChar) + 1)
            m_IndexIntoChar(lp) = i
            GetReplacementStrings (lp + 1)
            i = i + 1
       Loop
       m_IndexIntoChar(lp) = 0
    End If
    
End Function

Public Function Permute(inputStr As String, s1 As String, s2 As String) As String()

    m_InputString = inputStr
    ReDim m_IndexIntoString(0)
    ReDim m_IndexIntoChar(0)
    ReDim m_TempResult(0)
    ReDim m_EquiChar(1)
    m_NumberOfResults = 0
    m_TotalOccurance = 0
    
    m_EquiChar(0) = s1
    m_EquiChar(1) = s2
    
    Prepare
    
    If (m_TotalOccurance = -1) Then
        ReDim m_Result(0)
        Permute = m_Result()
        Exit Function
    End If
    
    GetReplacementStrings (0)
    
    ReDim m_Result(m_NumberOfResults)
    Dim i As Integer
        For i = 0 To m_NumberOfResults - 1
        m_Result(i) = m_TempResult(i)
    Next i
    
    Permute = m_Result()

End Function

Private Function IsExists(inputStr As String) As Boolean

    Dim i As Integer
    For i = 0 To UBound(m_TempResult)
        If VBA.Len(m_TempResult(i)) = 0 Then
            IsExists = False
            Exit Function
        ElseIf m_TempResult(i) = inputStr Then
            IsExists = True
            Exit Function
        End If
    Next i
    IsExists = False
    
End Function

Public Function ReplaceByMap() As String

    Dim s As String
    s = m_InputString
    
    Dim i&
    For i = 0 To m_TotalOccurance - 1
        Dim y As Integer
        y = m_IndexIntoString(i)

        Dim s1 As String
        Dim s2 As String
        Dim s3 As String
        s1 = VBA.Left(s, y - 1)
        s2 = VBA.Left(m_EquiChar(m_IndexIntoChar(i)), 1)
        s3 = VBA.Right(s, VBA.Len(s) - y)
        
        s = s1 & s2 & s3
        
        If (Not IsExists(s)) Then
            ReDim Preserve m_TempResult(UBound(m_TempResult) + 1)
            m_TempResult(m_NumberOfResults) = s
            m_NumberOfResults = m_NumberOfResults + 1
        End If
    Next i

End Function

Public Sub Prepare()

    Dim i&
    For i = 0 To UBound(m_EquiChar())
        PrepareOccurenceList (i)
    Next i
    
End Sub

Private Sub PrepareOccurenceList(Index As Integer)

    Dim occurrenceAt As Integer
    occurrenceAt = VBA.InStr(1, m_InputString, m_EquiChar(Index))
    Do While (occurrenceAt <> 0)
       m_TotalOccurance = m_TotalOccurance + 1
        ReDim Preserve m_IndexIntoString(UBound(m_IndexIntoString) + 1)
        m_IndexIntoString(m_TotalOccurance - 1) = occurrenceAt
        occurrenceAt = VBA.InStr(occurrenceAt + 1, m_InputString, m_EquiChar(Index))
    Loop
    
End Sub

[Arnoutdv]

Maybe you can use something like the SoundEx algorithm:
https://en.wikipedia.org/wiki/Soundex

Sample:
https://stackoverflow.com/questions/...ng-text-in-vba

[tmighty2]

Wow, this is really cool, I didn't know it. I will try this approach. However, I would like to use my permutation class for now.
I would really like to know how to make it handle longer strings.

[dz32]

Spell check features have been in development for quite a long time and I am sure have some really advanced code behind them by now. You could try to recreate them, or just find a pre made library that suits your needs. At a minimum they would be good to study for your task.

I would say much better to use a pre made library for this.

https://www.google.com/search?q=spel...ile-gws-wiz-hp

[tmighty2]

I was hoping that somebody might see a way to quickly change my code so that it can work with longer strings.

[dz32]

I think those libraries are so advanced because it is not a simple task when you really get into it