1 Attachment(s)
How do I change my string permute class so that it handles strings longer than 1 char
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!
Attachment 183725
Here is the code of Form1 (it requires a ListBox named "List1"):
Code:
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:
Code:
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
Re: How do I change my string permute class so that it handles strings longer than 1
Re: How do I change my string permute class so that it handles strings longer than 1
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.
Re: How do I change my string permute class so that it handles strings longer than 1
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
Re: How do I change my string permute class so that it handles strings longer than 1
I was hoping that somebody might see a way to quickly change my code so that it can work with longer strings.
Re: How do I change my string permute class so that it handles strings longer than 1
I think those libraries are so advanced because it is not a simple task when you really get into it
