Разбивка на слоги

Признаюсь, всё, что касается применения программ к языку, словам, речи, отпугивает меня своей сложностью. Я считаю, что мне это пока что не под силу. Так было и в этот раз, когда на форуме я увидел тему о расстановке переносов. При обсуждении упомянули алгоритм Ляна-Кнута, суть которого состоит в определении набора правил переноса (шаблонов) и применения этих шаблонов к словам. Я нашёл упрощённый вариант этого алгоритма, который подкупает простотой и ясностью. Итак, каждое слово представляется как набор из трёх видов букв: гласных (g), согласных (s) и букв й, ь, ъ (x). Например, слово "семейство" будет выглядеть как "sgsgxsssg". Для такого упрощённого представления слова можно сформулировать несколько правил переноса (я реализовал 19):

1. "gssssg" → "gs-sssg", как в слове "чув-ствовать"
2. "gsssg" → "gss-sg", как в слове "шест-надцать"
3. "sgsssg" → "sgsssg", как в слове "откры-вать"
4. "gssxg" → "gs-sxg", как в слове "счас-тье"
5. "xgsg" → "xgsg", как в слове "кой-ка"
6. "xgg" → "xgg", как в слове "?"
7. "gssg" → "gs-sg", как в слове "оловян-ный"
8. "sgsg" → "sg-sg", как в слове "пе-рестройка"
9. "sggg" → "sggg", как в слове "?"
10. "sggs" → "sggs", как в слове "?"
11. "xgsg" → "xg-sg", как в слове "йо-гурт"
12. "xss" → "xss", как в слове "?"
13. "sgxsg" → "sgx-sg", как в слове "Незнай-ка"
14. "gsg" → "g-sg", как в слове "а-бажур"
15. "sgg" → "sg-g", как в слове "си-яние"
16. "sgsssgx" → "sgsssgx", как в слове "пере-стройка"
17. "sgsxsg" → "sgsx-sg", как в слове "малень-кий"
18. "sgssg" → "sg-ssg", как в слове "за-крывать"
19. "sgxg" → "sg-xg", как в слове "ра-йон"

 1 
 2 
 3 
 4 
 5 
 6 
 7 
 8 
 9 
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 
55 
56 
57 
58 
59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 
72 
73 
74 
75 
76 
77 
78 
79 
80 
81 
82 
83 
84 
85 
86 
87 
88 
89 
90 
91 
92 
93 
94 
95 
96 
97 
98 
99 
100 
Public Type HyphenPair
    Pattern As String
    Position As Integer
End Type

Dim arHPairs() As HyphenPair
Private Const x As String = "йьъ"
Private Const g As String = "аеёиоуыэюяaeiouy"
Private Const s As String = "бвгджзклмнпрстфхцчшщbcdfghjklmnpqrstvwxz"

Public Function HyphenateWord(ByVal text As String, Optional Delimiter As String = "-", Optional DebugMode As Boolean = False) As String
    Dim i As Integer
    Dim sb As String
    Dim sText As String
    
    sText = StrConv(text, vbLowerCase)
    'Инициализация массива с шаблонами переноса
    Call Main
    
    'Формализация текста по шаблону xgs
    For i = 1 To Len(sText)
        If InStr(x, Mid(sText, i, 1)) <> 0 Then
            sb = sb & "x"
        ElseIf InStr(g, Mid(sText, i, 1)) <> 0 Then
            sb = sb & "g"
        ElseIf InStr(s, Mid(sText, i, 1)) <> 0 Then
            sb = sb & "s"
        End If
    Next
    
    Dim hp As HyphenPair 'Текущий шаблон переноса
    Dim index As Integer 'положение шаблона в формализованном тексте
    Dim actualindex As Integer 'положение переноса в реальном тексте
    Dim FirstMatchFound As Boolean 'Флаг найденного совпадения в формализованном тексте
    Dim patternsBuff As String 'Отладочный буфер для записи сработавших шаблонов
    
    Do
        Dim temp As Integer
        Dim hptemp As HyphenPair
        FirstMatchFound = False
        'Поиск совпадения с шаблоном,
        'расположенного ближе всего к началу формализованного текста
        For i = 0 To UBound(arHPairs)
            hptemp = arHPairs(i)
            temp = InStr(sb, hptemp.Pattern)
            'Поиск первого совпадения
            If Not FirstMatchFound Then
                FirstMatchFound = InStr(sb, hptemp.Pattern)
                index = temp
                hp = hptemp
            End If
            If FirstMatchFound And temp <> 0 Then
                If temp < index Then
                    index = temp
                    hp = hptemp
                ElseIf temp = index Then
                    'при равных индексах предпочтение отдаётся более длинному шаблону
                    If Len(hptemp.Pattern) > Len(hp.Pattern) Then
                        index = temp
                        hp = hptemp
                    End If
                End If
            End If
        Next i
        If index <> 0 Then
            actualindex = index + hp.Position
            'Расстановка переносов в шаблоне
            sb = Mid(sb, 1, actualindex - 1) & Delimiter & Mid(sb, actualindex)
            'Расстановка переносов в тексте
            sText = Mid(sText, 1, actualindex - 1) & Delimiter & Mid(sText, actualindex)
            'Запись сработавшего паттерна
            patternsBuff = patternsBuff & " " & hp.Pattern
        End If
    Loop Until index = 0
    HyphenateWord = sText & IIf(DebugMode, vbCr & patternsBuff, "")
End Function

Sub Main()
    Dim hp As HyphenPair
    ReDim arHPairs(18)
    With arHPairs(0): .Pattern = "gssssg": .Position = 2: End With 'чув-ствовать
    With arHPairs(1): .Pattern = "gsssg": .Position = 2: End With 'откры-вать
    With arHPairs(2): .Pattern = "sgsssg": .Position = 4: End With 'шест-надцать
    With arHPairs(3): .Pattern = "gssxg": .Position = 2: End With 'счас-тье
    With arHPairs(4): .Pattern = "xgsg": .Position = 2: End With 'кой-ка
    With arHPairs(5): .Pattern = "xgg": .Position = 1: End With '?
    With arHPairs(6): .Pattern = "gssg": .Position = 2: End With 'оловян-ный
    With arHPairs(7): .Pattern = "sgsg": .Position = 2: End With 'пе-рестройка
    With arHPairs(8): .Pattern = "sggg": .Position = 2: End With '?
    With arHPairs(9): .Pattern = "sggs": .Position = 2: End With '?
    With arHPairs(10): .Pattern = "xgsg": .Position = 2: End With 'йо-гурт
    With arHPairs(11): .Pattern = "xss": .Position = 1: End With '?
    With arHPairs(12): .Pattern = "sgxsg": .Position = 3: End With 'май-ка
    With arHPairs(13): .Pattern = "gsg": .Position = 1: End With 'а-бажур
    With arHPairs(14): .Pattern = "sgg": .Position = 2: End With 'си-яние
    With arHPairs(15): .Pattern = "sgsssgx": .Position = 2: End With 'пере-стройка
    With arHPairs(16): .Pattern = "sgsxsg": .Position = 4: End With 'малень-кий
    With arHPairs(17): .Pattern = "sgssg": .Position = 2: End With 'за-крывать
    With arHPairs(18): .Pattern = "sgxg": .Position = 2: End With 'ра-йон
End Sub

Теоретически, должно работать для английского и русского, но тонкую подгонку я делал только для русского языка. Если найдёте слово (а оно есть и не одно), которое разбивается неправильно, — сообщите мне.