To classify letters in words as vowels and consonants

Question

Given a word, I need a function that returns the structure of the word in terms of vowels and consonants. "c" stands for consonants and "v" for vowels. If the letter "y" is the first letter of a word, it is a consonant, otherwise, it considered a vowel. For example, wordClass("dance") returns "cvccv" and wordClass("yucky") returns "cvccv".

I tried this but there is probably a more efficient way to do this:

Function wordClass(word As String) As String
    Dim vowels(1 To 6) As String, vowelsNoY(1 To 5) As String, consonants(1 To 22) As String, pattern(1 To 5) As String
    Dim i As Integer, j As Integer
    
    vowels(1) = "a"
    vowels(2) = "e"
    vowels(3) = "i"
    vowels(4) = "o"
    vowels(5) = "u"
    vowels(6) = "y"
    
    vowelsNoY(1) = "a"
    vowelsNoY(2) = "e"
    vowelsNoY(3) = "i"
    vowelsNoY(4) = "o"
    vowelsNoY(5) = "u"
    
    consonants(1) = "b"
    consonants(2) = "c"
    consonants(3) = "d"
    consonants(4) = "f"
    consonants(5) = "g"
    consonants(6) = "h"
    consonants(7) = "j"
    consonants(8) = "k"
    consonants(9) = "l"
    consonants(10) = "m"
    consonants(11) = "n"
    consonants(12) = "p"
    consonants(13) = "q"
    consonants(14) = "r"
    consonants(15) = "s"
    consonants(16) = "t"
    consonants(18) = "v"
    consonants(19) = "w"
    consonants(20) = "x"
    consonants(21) = "y"
    consonants(22) = "Z"
    
    For h = 1 To Len(consonants)
    
        If StrComp(Mid(word, 1, 1), vowelsNoY(h), vbTextCompare) = 0 Then
            pattern(1) = "v"
        ElseIf StrComp(Mid(word, 1, 1), consonants(h), vbTextCompare) = 0 Then
            pattern(1) = "c"
        End If
    
    Next h
        
    For i = 2 To Len(word)
        
        For j = 2 To Len(word)
            If StrComp(Mid(word, i, 1), vowels(j), vbTextCompare) = 0 Then
                pattern(j) = "v"
            ElseIf StrComp(Mid(word, i, 1), consonants(j), vbTextCompare) = 0 Then
                pattern(j) = "c"
            End If
        Next j
    Next i
            
    wordClass = CStr(pattern)
    
End Function

Answer 1

Alternative via Array match

Instead of relating each single letter to different type arrays, this approach gets the ordinal position of vowels alone in one go via Match executed upon an array of all letters against the vowels array (including y):

    vowelpos = Application.Match(s2Arr(LCase(word)), Array("y", "a", "e", "i", "o", "u"), 0)

Thus each numeric value corresponds to a vowel, non-findings (Error 2042) to a consonant (the "starting y"-exception is considered in section b).

Function cv(ByVal word As String) As String
'a) get position of vowel within vowels array {y.a.e.i.o.u}
    Dim vowelpos
    vowelpos = Application.Match(s2Arr(LCase(word)), Array("y", "a", "e", "i", "o", "u"), 0)
'b) consider starting "y" as consonant (i.e. not as vowel)
    If vowelpos(1) = 1 Then vowelpos(1) = "Starting Y"
'c) replace letters with their type abbreviation "v"owel|"c"onsonant
    Dim i As Long
    For i = 1 To UBound(vowelpos)
        vowelpos(i) = IIf(IsNumeric(vowelpos(i)), "v", "c")
    Next i
'd) return joined letter types
    cv = Join(vowelpos, vbNullString)
End Function

Help function s2Arr()

Allows to atomize string into a letters array.

Function s2Arr(ByVal s As String) As Variant
'Purp: return array of all single characters in a string
'Idea: https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
    s = StrConv(s, vbUnicode)
    s2Arr = Split(s, vbNullChar, Len(s) \ 2)
End Function

Answer 2

Well, here's yet another answer. This time the letters and thier type are used to populate a Collection in Dictionary mode so we can simplify the code when scanning through a word. Thus we only have to deal with the special case of y as the first letter.

Private Type State

    LetterType                      As Collection

End Type

Private s                           As State

Public Sub TestWordClass()

    Debug.Print "The word class of Yucky is cvccv: Found is "; WordClass("Yucky")

End Sub


Public Function WordClass(ByVal ipWord As String) As String

    Dim myResult As String
    Dim myFirstLetter As String

    If s.LetterType Is Nothing Then SetupLetterTypes

    myFirstLetter = VBA.LCase$(VBA.Left$(ipWord, 1))
    If myFirstLetter = "y" Then
        
        myResult = "c"

    Else

        myResult = s.LetterType(myFirstLetter)

    End If


    Dim myIndex As Long
    For myIndex = 2 To VBA.Len(ipWord)

        Dim myLetter As String
        myLetter = VBA.LCase$(VBA.Mid$(ipWord, myIndex, 1))
        myResult = myResult & s.LetterType(myLetter)

    Next

    WordClass = myResult

End Function

Private Sub SetupLetterTypes()

    Dim myLetters As Variant
    myLetters = _
        Array _
        ( _
            "aeiouybcdfghjklmnpqrstvwxz", _
            "vvvvvvcccccccccccccccccccc" _
        )
    Set s.LetterType = New Collection

    Dim myIndex As Long
    
    For myIndex = 1 To VBA.Len(myLetters(0))
        
        s.LetterType.Add Item:=VBA.Mid$(myLetters(1), myIndex, 1), Key:=VBA.Mid$(myLetters(0), myIndex, 1)
        
    Next

End Sub

Answer 3

I would use something like this. Copy this to a fresh module:

Public strVowels As String
Public arrVowels() As String

Public Function wordClass(strWord As String, Optional blnIncludeY As Boolean = False) As String

Dim lngLetter As Long

    setup blnIncludeY
    
    For lngLetter = 1 To Len(strWord)
        If lngLetter = 1 And LCase(Left(strWord, 1) = "y") Then
            wordClass = "C"
        Else
            If isVowel(Mid(strWord, lngLetter, 1)) Then
                wordClass = wordClass & "V"
            Else
                wordClass = wordClass & "C"
            End If
        End If
    Next lngLetter
    
End Function

Public Sub setup(blnIncludeY As Boolean)

strVowels = "a;e;i;o;u"
If blnIncludeY Then strVowels = strVowels & ";y"

arrVowels = Split(strVowels, ";")

End Sub

Public Function isVowel(strLetter As String)
    isVowel = Not IsError(Application.Match(LCase(strLetter), arrVowels, False))
End Function

Answer 4

You could do this in two steps with regex. Regex can search the string for individual letters and then replace all matching letters with "c" or "v". You would have 2 patterns and 2 replacements and then it would be done.

Pattern 1 : "[bcdfghjklmnpqrstvwxz]|^y" : Matches any character in that list or a leading y.

Pattern 2 : "[aeiouy]" : Matches any character in that list

Since pattern 1 is applied first, all the remaining y's can be safely assumed to be vowel. Also, since the first pattern changes all consonants to "c", they won't match pattern 2 and be double-transformed. If you were to run the Vowel regex first and change the letters to "v", the consonant pattern would match with "v" and they would all change to "c". So the consonant replacement must happen first.

Function wordClass(word As String) As String
    Dim Consonants As Object
    Set Consonants = CreateObject("VBScript.RegExp")
    With Consonants
        .Global = True
        .MultiLine = False
        .Pattern = "[bcdfghjklmnpqrstvwxz]|^y"
    End With
    
    Dim Vowels As Object
    Set Vowels = CreateObject("VBScript.RegExp")
    With Vowels
        .Global = True
        .MultiLine = False
        .Pattern = "[aeiouy]"
    End With
    
    Dim outputString As String
    outputString = LCase(word)
    
    outputString = Consonants.Replace(outputString, "c")
    outputString = Vowels.Replace(outputString, "v")
    wordClass = outputString
End Function

Answer 5

I would not define arrays, just use Instr to check if a character is within the vowels. To check for consonants, I would check that the character is not a vowel and that it is between "b" and "z" - else it is some other character.

"Efficiency" for me is mainly a matter of readability - no matter which attempt you use, everything is done in memory and unless you want to analyze millions of words, there is no need to optimize for speed.

I also check for the first character. If it is a "y", i put hardcoded that it is a Consonant and start the loop with the 2nd character.

This is my attempt:

Function wordClass(ByVal word As String) As String
    Dim i As Long, startIndex As Long
    Const vowels = "aeiouy"
    Const vowel = "V"
    Const consonant = "C"
    Const other = "?"
    
    word = LCase(word)
    If Left(word, 1) = "y" Then
        wordClass = consonant
        startIndex = 2
    Else
        wordClass = ""
        startIndex = 1
    End If
    
    For i = startIndex To Len(word)
        Dim c As String
        c = Mid(word, i, 1)
        If InStr(vowels, c) > 0 Then
            wordClass = wordClass & vowel
        ElseIf c > "a" And c <= "z" Then
            wordClass = wordClass & consonant
        Else
            wordClass = wordClass & other
        End If
    Next

End Function

Answer 6

Option Explicit

Public Sub Example()
    Debug.Print wordClass("dance")
    Debug.Print wordClass("yucky")
End Sub


Public Function wordClass(ByVal word As String) As String
    Const vowels As String = "aeiouy"
    Const vowelsNoY As String = "aeiou"
    Const consonants As String = "bcdfghjklmnopqrstvwxyz"
    
    Dim retval As String

    Dim i As Long
    For i = 1 To Len(word)
        Dim char As String
        char = Mid$(word, i, 1)
        
        If i = 1 Then
            If InStr(vowelsNoY, char) Then
                retval = retval & "v"
            ElseIf InStr(consonants, char) Then
                retval = retval & "c"
            Else
                retval = retval & "-"
            End If
        Else
            If InStr(vowels, char) Then
                retval = retval & "v"
            ElseIf InStr(consonants, char) Then
                retval = retval & "c"
            Else
                retval = retval & "-"
            End If
        End If
    Next i
    
    wordClass = retval
End Function