Code für Silbentrennung (deutsch)

[Thorsten1867]

Eine Silbentrennung basierend auf dem Algorithmus von Frankling Mark Liang (1983).
Der Code findet mögliche Trennstellen in dem Wort und markiert diese mit einem "|". Zum Code benötigt man noch die Datei mit den Trennmustern.

Sourecode + Hyphenation Patterns

Code: Alles auswählen

;/ Silbentrennung
;/ Algorithmus von Frankling Mark Liang (1983)
;/ basierend auf "hyphenator für HTML" (Mathias Nater, Zürich)
;/ Mai 2009 Thorsten Hoeppner (Thorsten1867)


Structure LangStructure
  shortestPattern.b
  longestPattern.b
  leftmin.b
  rightmin.b
EndStructure
Global Language.LangStructure

Structure PatternStructure
  chars.s
  pattern.s
EndStructure
Global NewList HyphPattern.PatternStructure(), NewList pattern.PatternStructure()

Procedure LoadPattern(PatternFile.s)
  ClearList(HyphPattern())
  If ReadFile(0, PatternFile.s)
    While Eof(0) = 0 
      pattern$ = Trim(ReadString(0,#PB_UTF8))
      AddElement(HyphPattern())
      HyphPattern()\chars = StringField(pattern$,1,":")
      HyphPattern()\pattern = StringField(pattern$,2,":")
    Wend 
    CloseFile(0)
    Select GetExtensionPart(PatternFile) ;{ Spracheinstellungen
      Case "de"
        Language\shortestPattern = 2
        Language\longestPattern = 9
        Language\leftmin = 2
        Language\rightmin = 2
      Case "en"
        Language\shortestPattern = 2
        Language\longestPattern = 8
        Language\leftmin = 2
        Language\rightmin = 2
      Case "fr"
        Language\shortestPattern = 1
        Language\longestPattern = 14
        Language\leftmin = 2
        Language\rightmin = 2
    EndSelect ;}
  Else
    MessageRequester("Lade Trennungsmuster", "Datei konnte nicht eingelesen werden.", 0)
  EndIf
EndProcedure

Procedure MathMin(zahl1, zahl2)
  If zahl1 < zahl2
    ProcedureReturn zahl1
  Else
    ProcedureReturn zahl2
  EndIf
EndProcedure

Procedure.b IsNumber(char$)
  If Asc(char$) >= 48 And Asc(char$) <= 57
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure.s GetPattern(chars.s)
  ForEach pattern()
    If chars = pattern()\chars
      ProcedureReturn pattern()\pattern
    EndIf
  Next
EndProcedure

Procedure.s InsertString(string.s, idx.b, chars.s)
  If idx > 1
    result.s = Left(string, idx-1)+chars+Mid(string, idx)
  ElseIf idx >= Len(string)
    result.s = string + chars
  Else
    result.s = chars + string
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.s HyphenateWord(wort.s)
  wort = "_"+wort+"_"
  word.s = LCase(wort)
  WLen.b = Len(word)
  
  ;{ Suche Pattern
  ClearList(pattern())
  ForEach HyphPattern()
    If FindString(word, HyphPattern()\chars, 1)
      AddElement(pattern())
      pattern()\chars = HyphPattern()\chars
      pattern()\pattern = HyphPattern()\pattern
    EndIf
  Next
  ;}
  
  Dim Hypos.s(WLen)
  
  n = WLen - Language\shortestPattern
  For p = 1 To n+1
    max = MathMin(WLen-p+1, Language\longestPattern)
    For w = Language\shortestPattern To max
      pattern.s = GetPattern(Mid(word, p, w))
      If pattern
        digits = 1
        PLen = Len(pattern)
        For i=1 To PLen ; Pattern auswerten
          char$ = Mid(pattern, i, 1)
          If IsNumber(char$)
            If i = 1
              z = p
            Else
              z = p + i - digits
            EndIf
            If Not Hypos(z) Or Hypos(z) < char$
              Hypos(z) = char$
            EndIf
            digits + 1
          EndIf
        Next
      EndIf
    Next
  Next
  inserted.b = 0
  For i = Language\leftmin To WLen-Language\rightmin
    If Val(Hypos(i))
      wort = InsertString(wort, i + inserted, Hypos(i))
      inserted + 1
    EndIf
  Next
  
  result.s = RemoveString(wort, "_")
  For i = 1 To 9
    Select i
      Case 1,3,5,7,9
        result = ReplaceString(result, Str(i), "|")
      Case 2,4,6,8
        result = RemoveString(result, Str(i))
    EndSelect
  Next
  If Left(result,1) = "|" : result = Mid(result,2) : EndIf
  ProcedureReturn result
EndProcedure

LoadPattern("HyphenPattern.de")

wort$ =  InputRequester("Silbentrennung", "Wort eingeben:", "")
result$ = HyphenateWord(wort$)
MessageRequester("Silbentrennung", ReplaceString(result$, "|", " - "), #MB_OK)

[ts-soft]

endlich mal wieder was anderes.
Hab zwar im moment keine Verwendung für, aber das kann sich ja schnell
ändern.

Danke

[Thorsten1867]

Man braucht ab und zu mal eine neue Herausforderung.

Der nächst Schritt wird dann die praktische Anrwendung beim automatischen Zeilenumbruch.

[milan1612]

Nett und funktionieren tuts auch sehr gut
Aber koenntest du mir vielleicht das Patternformat mal erklaeren,
ich werde daraus nicht schlau... . Und wie koennte man das fuer English erweitern?

[Thorsten1867]

Die Pattern sind etwas kompliziert.
Ein oberflächiger Einblick: Zusammenfassung - Liangs Thesis
Das Orginal: Word Hy-phen-a-tion by Com-put-er

Für Englisch bräuchte man eigentlich nur andere Pattern zu laden. Ich werde mal versuchen eine entsprechende Patterndatei zu konvertieren.

[Thorsten1867]

Anpassungen für andere Sprachen vorgenommen.
HyphenPattern für Deutsch / Englisch / Französisch beigelegt (ungetestet!)

[Little John]

Schöne Sache.
Vielen Dank!

Gruß, Little John

[Kiffi]

@Thorsten1867: Nett!

kann man da "Feineinstellungen" vornehmen,
so dass sowas hier nicht vorkommt?

glas - ti - sch

Grüße ... Kiffi

[Little John]

Das selbe Problem z.B. bei

Holz - ti - sch

Aber komisch ist -- zumindest für mich, der ich mich mit dem zu Grunde liegenden Algorithmus nicht beschäftigt habe -- dass

Tisch

richtigerweise nicht getrennt wird.

Gruß, Little John

[Andesdaf]

sehr nett - habe aber gerade keinen Verwendungszweck