Code-Beispiel

Wörter in Silben zerlegen

Lizenz:	Erster Autor:	Letzte Bearbeitung:
WTFPL	ThePuppetMaster	14.06.2012

Es gibt viele Varianten um Wörter in Ihre Silben zu zerlegen. Eine wäre es mithilfe einer Datenbank nach entsprechenden Silbenkonstelationen zu suchen, was jedoch recht Zeitaufwendig und Rechenintensiv sein kann.
Eine Andere Variante ist die Abstrahierte Gramtikalische Regelkonforme Zerlegung. Sie ist jedoch nicht einfach zu integrieren und der Codeaufwand ist enorm hoch. Allerdings auch sehr Präzise.
Eine Dritte Variante (welche ich auch hier Demonstriere) ist anhand einfacher Regeln von Hinten beginnend nach den Konsonanten und Vokalen zu suchen. Sie ist zwar nicht 100%tig treffgenau, jedoch reicht es meist aus (Auch dank der neuen Rechtschreibreform) die trennung sehr genau auszuführen.
Auch früher wurde schon dieses Verfahren in vielen Rechtschreibprogrammen angewendet um den Fließtext-Zeilenumbruch ohne Blocktext zu automatisieren.

Das Verfahren, bzw. der ALgorythmus ist linear aufgebaut und beginnt von hinten an nach Vokale zu suchen. Anschliessend wird auf das erste Konsonant gewartet. Es gibt jedoch einige ausnahmefälle, die ebenfalls berücksichtigt werden, wie z.B. das "ei" oder "ie" und noch einige andere wie "ch", "sch", "ck", ... .

Die Rückgabe erfolgt als Array (Vorwärts sortiert).

Sub SilbCut(V_Wort as String, R_SilbD() as String, ByRef R_SilbC as UInteger)

R_SilbC = 0

Dim T as String = LCase(V_Wort)

Dim TL as UInteger = Len(T)

Dim X as UInteger = TL

Dim Y as UInteger

Dim XPos as UInteger = X + 1

Dim TFK as UByte

Dim TD() as String

Do

    If X <= 1 Then Exit Do

    Select Case T[X - 1]

        Case 97, 101, 105, 111, 117, 121 'aeiouy

            If TFK = 1 Then

                If ((T[X] = 105) and (T[X - 1] = 101)) or ((T[X] = 101) and (T[X - 1] = 105)) or ((T[X] = 117) and (T[X - 1] = 97)) or ((T[X] = 117) and (T[X - 1] = 101)) Then

                Else

                    R_SilbC += 1

                    Redim Preserve TD(R_SilbC) as String

                    TD(R_SilbC) = Mid(V_Wort, X + 1, XPos - X)

                    XPos = X

                    TFK = 0

                End If

            Else: TFK = 1

            End If



        Case 188, 182, 164 'äöü

            If X > 1 Then If (T[X - 2] = 195) Then TFK = 1



        Case 98, 99, 100, 102, 103, 104, 106, 107, 108, 109, 110, 112, 113, 114, 115, 116, 118, 119, 120, 122 'bcdfghjklmnpqrstvwxz

            If TFK = 1 Then

                If X > 1 Then

                    If T[X - 1] = 104 Then

                        If T[X - 2] = 99 Then X -= 1 'ch

                        If X > 1 Then If T[X - 1] = 99 Then If T[X - 2] = 115 Then X -= 1 'sc

                    ElseIf T[X - 1] = 107 Then

                        If T[X - 2] = 99 Then X -= 1 'ck

                    ElseIf T[X - 1] = 104 Then

                        If T[X - 2] = 112 Then X -= 1 'ph

                    End If

                End If

                Y = X

                Do

                    If Y <= 0 Then Exit Do

                    Select Case T[Y - 1]

                        Case 97, 101, 105, 111, 117, 121

                            TFK = 2

                            Exit Do

                        Case 188, 182, 164 'äöü

                            If Y > 1 Then If (T[Y - 2] = 195) Then TFK = 2: Exit Do

                    End Select

                    Y -= 1

                Loop

                If TFK = 1 Then X = 1

                R_SilbC += 1

                Redim Preserve TD(R_SilbC) as String

                TD(R_SilbC) = Mid(V_Wort, X, XPos - X + 1)

                XPos = X - 1

                TFK = 0

            End If



    End Select

    X -= 1

Loop

If XPos <> X Then

    R_SilbC += 1

    Redim Preserve TD(R_SilbC) as String

    TD(R_SilbC) = Left(V_Wort, XPos)

End If

Redim Preserve R_SilbD(R_SilbC) as String

For X = R_SilbC To 1 Step -1

    R_SilbD(X) = TD(R_SilbC - X + 1)

Next

End Sub

Und hier ein Beispiel mit einigen Wörtern.

Dim DC as UInteger = 24

Dim DD(DC) as String

DD(1) = "Ich"

DD(2) = "Schwäche"

DD(3) = "habe"

DD(4) = "heute"

DD(5) = "einen"

DD(6) = "kleinen"

DD(7) = "Hassliebe"

DD(8) = "Gefallen"

DD(9) = "erhalten"

DD(10) = "beschatten"

DD(11) = "betrunken"

DD(12) = "zerreiben"

DD(13) = "Gewühl"

DD(14) = "Bäche"

DD(15) = "Schwäche"

DD(16) = "Beuche"

DD(17) = "pflücken"

DD(18) = "banane"

DD(19) = "Schlawiner"

DD(20) = "Ozeanien"

DD(21) = "real"

DD(22) = "asiatisch"

DD(23) = "Toilette"

DD(24) = "Autobahnfahrer"







Dim SD() as String

Dim SC as UInteger

For X as UInteger = 1 to DC

    SilbCut(DD(X), SD(), SC)

    Print ">"; DD(X); "<   ";

    For Y as UInteger = 1 to SC

        Print SD(Y); *IIf(Y <> SC, @"-", @"");

    Next

    Print

Next

End 0

HF
TPM

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 14.06.2012 von ThePuppetMaster angelegt.
Die aktuellste Version wurde am 14.06.2012 von ThePuppetMaster gespeichert.

Bearbeiten

Versionen