(* ------------------- VERSION 170 vom 30.09.85 -------------------- *)
PACKET silbentrennung DEFINES
trenn,
schreibe trennvektor,
ist ausnahme wort,
lade ausnahmen,
entlade ausnahmen:
(* Programm zur Silbentrennung
Autor: Klaus-Uwe Koschnick / Rainer Hahn
Stand: 1.7.1 (Febr. 1984)
1.7.4 (Mai 1984) (Ausnahme-Woerterbuch, Verbesserungen)
*)
(*--------------------- Ausnahme Woerterbuch -----------------------*)
DATASPACE VAR ds1 :: nilspace;
FILE VAR f;
LET name table length = 1024,
max hash chars = 5;
INT VAR anz worte :: 0,
hash index;
INITFLAG VAR this packet :: FALSE;
TEXT VAR dummy,
name ohne trennstellen,
trennstellen,
blanked name;
BOUND ROW name table length TEXT VAR name table;
PROC init packet:
IF NOT initialized (this packet)
THEN anz worte := 0
FI
END PROC init packet;
PROC init name table:
forget (ds1);
ds1 := nilspace;
name table := ds1;
INT VAR i;
FOR i FROM 1 UPTO name table length REP
cout (i);
name table [i] := ""
END REP;
anz worte := 0.
END PROC init name table;
PROC lade ausnahmen:
lade ausnahmen (last param)
END PROC lade ausnahmen;
PROC lade ausnahmen (TEXT CONST filename):
IF exists (filename)
THEN lade
ELSE errorstop ("Datei nicht vorhanden")
FI.
lade:
init packet;
IF anz worte > 0
THEN IF yes ("überschreiben")
THEN init nametable
ELIF no ("anfügen")
THEN LEAVE lade ausnahmen
FI
ELSE init nametable
FI;
line (2);
f := sequential file (input, file name);
WHILE NOT eof (f) REP
get (f, dummy);
IF subtext (dummy, 1, 2) = "(*"
THEN ueberlese kommentar
ELSE lade wort (* Vor.: Worte ohne Blanks *)
FI
END REP.
ueberlese kommentar:
WHILE NOT eof (f) AND pos (dummy, "*)") = 0 REP
get (f, dummy);
END REP.
lade wort:
line ;
anz worte INCR 1;
put (anz worte);
stelle namen ohne trennstellen her;
put (name ohne trennstellen);
blanked name := " ";
name ohne trennstellen CAT " ";
blanked name CAT name ohne trennstellen;
hash;
IF pos (name table [hash index], blanked name) > 0
THEN put ("(bereits geladen)")
ELSE insert char (name ohne trennstellen, " ", 1);
name ohne trennstellen CAT trennstellen;
name table [hash index] CAT name ohne trennstellen;
FI.
stelle namen ohne trennstellen her:
INT VAR number;
name ohne trennstellen := dummy;
trennstellen := "";
WHILE pos (name ohne trennstellen, "-") > 0 REP
number := pos (name ohne trennstellen, "-");
delete char (name ohne trennstellen, number);
trennstellen CAT text (number - 1);
trennstellen CAT " "
END REP.
END PROC lade ausnahmen;
PROC entlade ausnahmen (TEXT CONST file name):
init packet;
IF exists (file name)
THEN errorstop ("Datei existiert bereits")
ELSE unload
FI.
unload:
f := sequential file (output, file name);
INT VAR i;
FOR i FROM 1 UPTO name table length REP
cout (i);
IF name table [i] <> ""
THEN putline (f, name table [i])
FI
END REP.
END PROC entlade ausnahmen;
BOOL PROC ist ausnahme wort (TEXT CONST word,
INT CONST maximum, INT VAR trenn position):
init packet;
IF anz worte > 0
THEN blanked name fuer hash bilden;
hash;
IF pos (name table [hash index], blanked name) > 0
THEN trennstelle suchen
FI
FI;
FALSE.
blanked name fuer hash bilden:
blanked name := " ";
IF maximum <= max hash chars
THEN eliminiere ggf satzzeichen hinter dem wort;
blanked name CAT
subtext (word, 1, min (max hash chars, wortlaenge))
ELSE blanked name CAT subtext (word, 1, maximum);
FI.
eliminiere ggf satzzeichen hinter dem wort:
INT VAR wort laenge := length (word);
WHILE letztes zeichen ist kein buchstabe REP
wort laenge DECR 1;
IF wort laenge <= 2
THEN LEAVE ist ausnahme wort WITH FALSE
FI
END REP.
letztes zeichen ist kein buchstabe:
TEXT CONST letztes zeichen :: (word SUB wortlaenge);
NOT (letztes zeichen >= "A" AND letztes zeichen <= "Z" OR
letztes zeichen >= "a" AND letztes zeichen <= "z" OR
letztes zeichen >= "Ä" AND letztes zeichen <= "k" OR
letztes zeichen = "ß").
trennstelle suchen:
index der ersten ziffer suchen;
INT VAR neue ziffer := 0;
trenn position := 0;
ziffern holen.
index der ersten ziffer suchen:
dummy := name table [hash index];
INT VAR ziffern index := pos (dummy, blanked name);
ziffern index := pos (dummy, " ", ziffern index + 1) + 1.
ziffern holen:
WHILE ist ziffer REP
hole neue ziffer;
IF gefundene ziffer ist ausserhalb des trennbereichs
THEN LEAVE ist ausnahme wort WITH TRUE
FI;
trenn position := neue ziffer
END REP;
LEAVE ist ausnahme wort WITH TRUE.
ist ziffer:
ziffern index < length (dummy) AND
((dummy SUB ziffern index + 1) = " " OR (dummy SUB ziffern index + 2) = " ").
hole neue ziffer:
INT VAR ende position :: pos (dummy, " ", ziffern index);
neue ziffer := int (subtext (dummy, ziffern index, ende position - 1));
ziffern index := ende position + 1.
gefundene ziffer ist ausserhalb des trennbereichs:
neue ziffer > maximum.
END PROC ist ausnahme wort;
PROC hash:
INT VAR i;
hash index := code (blanked name SUB 2);
FOR i FROM 3 UPTO min (length (blanked name), max hash chars) REP
hash index INCR hash index;
hash index INCR code (blanked name SUB i);
decrementiere hash index
END REP.
decrementiere hash index:
WHILE hash index > name table length REP
hash index DECR 1023
END REP.
END PROC hash;
(*-------------- eigentlicher Trenn-Algorithmus --------------*)
LET zeichenkette n = "-/",
regelmaessig = " bl br chl chr dr fl fr gl gr kl kn kr pf ph pl pr
sp st schl schm schn schr schw th tr zw ",
vokal string = "aeiouyäöü",
buchstaben =
"abcdefghijklmnopqrstuvwxyzäöüßABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ",
grosse buchstaben = "ABCDEFGHIJKLMNOPQRSTUVWXYZ",
trennstrich = ""221"",
cv a = 97 , cv b = 98 , cv c = 99 , cv d = 100, cv e = 101,
cv f = 102, cv g = 103, cv i = 105, cv k = 107,
cv l = 108, cv m = 109, cv n = 110, cv o = 111,
cv p = 112, cv r = 114, cv s = 115, cv t = 116,
cv u = 117, cv w = 119, cv x = 120, cv y = 121,
cv ae = 217 , cv oe = 218 , cv ue = 219 , cv sz = 251,
weder h noch ch = 0 ,
buchstabe h = 1 ,
zeichenfolge ch = 2 ;
INT CONST minus one :: - 1;
INT VAR i, grenze, absolute grenze, sonderzeichen trennpos,
zeichen vor teilwort, teilwort laenge, a pos, e pos,
a pos minus 2, a pos minus 1, a pos plus 1, a pos plus 2,
e pos minus 1;
ROW 50 INT VAR vektor ;
TEXT VAR wort,
teilwort,
kons gr,
search,
zeichen;
BOOL VAR trennstelle gefunden ;
PROC trenn (TEXT CONST word, TEXT VAR part1, trennsymbol, INT CONST maximum):
IF ist ausnahme wort (word, maximum, position)
THEN ausnahme wort behandlung;
LEAVE trenn
FI;
INT VAR laenge :: length (word) ;
IF laenge < 4
THEN trennung nicht moeglich
ELSE wort := word ;
grenze := min (50, maximum) ;
absolute grenze := min (laenge, grenze + 5) ;
trennung versuchen
FI .
ausnahme wort behandlung:
IF position <= 0
THEN trennung nicht moeglich
ELSE part1 := subtext (word, 1, position);
IF pos (zeichenkette n, word SUB position + 1) > 0
THEN trennsymbol := " "
ELSE trennsymbol := trennstrich
FI
FI.
trennung nicht moeglich :
part 1 := "";
trennsymbol := " ".
trennung versuchen :
erstelle trennvektor ;
IF sonderzeichen trennpos > 0
THEN part 1 := subtext (word, 1, sonderzeichen trennpos) ;
trennsymbol := " "
ELSE bestimme trennposition ;
IF position = 0
THEN trennung nicht moeglich
ELSE part 1 := subtext (wort, 1, position) ;
trennsymbol := trennstrich
FI
FI .
bestimme trennposition :
INT VAR position ;
FOR position FROM grenze DOWNTO 1 REP
IF vektor [position] = 1
THEN LEAVE bestimme trennposition
FI
END REP ;
position := 0
END PROC trenn ;
BOOL PROC buchstabe (INT CONST posi) :
pos (buchstaben, wort SUB posi) > 0 OR spezialcode.
spezialcode:
INT CONST z code :: code (wort SUB posi) ;
(zcode > 96 AND zcode < 123).
END PROC buchstabe ;
OP SPERRE (INT CONST element) :
INT CONST w element :: zeichen vor teilwort + element ;
IF w element > 0 AND w element <= grenze
THEN vektor [w element] := minus one
FI
END OP SPERRE ;
OP SETZE (INT CONST element) :
INT CONST w element :: zeichen vor teilwort + element;
IF w element > 0 AND w element <= grenze AND vektor [w element] <> minus one
THEN vektor [w element] := 1 ;
trennstelle gefunden := TRUE
FI
END OP SETZE ;
BOOL PROC vorletzter buchstabe oderkeine trennung oder sperre gesetzt
(INT CONST akt buchstabenpos):
vorletzter buchstabe (akt buchstabenpos)
OR NOT trennung oder sperre gesetzt (akt buchstabenpos).
END PROC vorletzter buchstabe oderkeine trennung oder sperre gesetzt;
BOOL PROC vorletzter buchstabe (INT CONST akt buchstabenpos):
akt buchstabenpos = absolute grenze - 1
END PROC vorletzter buchstabe;
BOOL PROC trennung oder sperre gesetzt (INT CONST element):
INT CONST w element :: zeichen vor teilwort + element;
IF w element > 1 AND w element < teilwort laenge
THEN vektor [w element] = 1 OR gesperrt
ELSE TRUE
FI.
gesperrt:
IF w element >= length (wort) - 1
THEN TRUE
ELSE vektor [w element] = minus one
FI.
END PROC trennung oder sperre gesetzt;
PROC sperren und setzen (INT CONST element) :
INT CONST w element :: zeichen vor teilwort + element ;
vektor [w element - 1] := minus one;
vektor [w element] := 1
END PROC sperren und setzen ;
TEXT PROC string (INT CONST anf pos, end pos) :
subtext (teilwort, maximum, minimum).
maximum:
IF anf pos > 1
THEN anf pos
ELSE 1
FI.
minimum:
IF teilwort laenge < end pos
THEN teilwort laenge
ELSE end pos
FI.
END PROC string ;
BOOL PROC silbenanfang vor (INT CONST akt buchstabenpos):
zwei silber (akt buchstabenpos - 2) OR drei silber (akt buchstabenpos - 3)
END PROC silbenanfang vor;
BOOL PROC silbenanfang nach (INT CONST akt buchstabenpos):
zwei silber (akt buchstabenpos + 1) OR drei silber (akt buchstabenpos + 1)
END PROC silbenanfang nach;
BOOL PROC zwei silber (INT CONST akt buchstabenpos):
TEXT VAR zweier :: string (akt buchstabenpos, akt buchstabenpos + 1);
length (zweier) = 2 AND
pos ("ab an ar be er ge in um un zu re", zweier) > 0
END PROC zwei silber;
BOOL PROC drei silber (INT CONST akt buchstabenpos):
TEXT VAR dreier :: string (akt buchstabenpos, akt buchstabenpos + 2);
length (dreier) = 3 AND
pos ("auf aus bei ein end ent mit", dreier) > 0
END PROC drei silber;
BOOL PROC reg (INT CONST st pos) :
INT CONST code one :: code (teilwort SUB st pos) ,
code two :: code (teilwort SUB st pos + 1) ;
pos (regelmaessig, konsonanten) > 0 .
konsonanten :
search := " " ;
IF code one = cv c
THEN search CAT string (st pos, st pos + 2)
ELIF code one = cv s AND code two = cv c
THEN search CAT string (st pos, st pos + 3)
ELSE search CAT string (st pos, st pos + 1)
FI ;
search CAT " " ;
search
END PROC reg ;
INT PROC grenz position (INT CONST start pos, richtung):
INT VAR posit :: start pos ;
REP
posit INCR richtung
UNTIL sonderzeichen oder position unzulaessig END REP;
posit - richtung.
sonderzeichen oder position unzulaessig:
posit = 0 AND posit > absolute grenze OR ist kein buchstabe.
ist kein buchstabe:
pos (buchstaben, wort SUB posit) = 0 AND kein spezialcode.
kein spezialcode:
INT CONST z code :: code (wort SUB posit) ;
(zcode < 97 OR zcode > 121).
END PROC grenz position ;
PROC schreibe trennvektor (TEXT CONST ttt):
line ; put (ttt); INT VAR ii;
FOR ii FROM 1 UPTO length (wort) REP put(vektor [ii]) PER
END PROC schreibe trennvektor;
PROC erstelle trennvektor :
INT VAR akt pos, anfang teilwort, ende teilwort, anzahl,
zuletzt, tr pos, ind, code 1, code 2, code 3,
rechts von a pos, z code, posit;
BOOL VAR sonderzeichen modus,
aktueller buchstabe ist vokal,
vorsilbe oder nachsilbe;
sonderzeichen trennpos := 0 ;
trennstelle gefunden := FALSE ;
initialisiere trennvektor ;
akt pos := grenze ;
IF buchstabe (akt pos)
THEN zuerst teilwort
ELSE zuerst sonderzeichenblock
FI;
WHILE akt pos > 0 REP
IF sonderzeichen modus
THEN behandle sonderzeichenblock
ELSE suche trennstellen in teilwort
FI
END REP.
initialisiere trennvektor :
FOR i FROM 1 UPTO grenze REP vektor [i] := 0 END REP .
zuerst teilwort:
ende teilwort := grenz position (akt pos, 1) ;
sonderzeichen modus := FALSE .
zuerst sonderzeichenblock:
sonderzeichen modus := TRUE .
behandle sonderzeichenblock:
WHILE sonderzeichen modus REP
IF buchstabe (akt pos)
THEN sonderzeichen modus := FALSE
ELSE zeichen := wort SUB akt pos ;
IF pos (zeichenkette n, zeichen) <> 0
THEN sonderzeichen trennpos := akt pos ;
LEAVE erstelle trennvektor
FI ;
akt pos DECR 1 ;
IF akt pos = 0
THEN LEAVE erstelle trennvektor
FI
FI
END REP;
ende teilwort := akt pos .
suche trennstellen in teilwort:
bestimme anfang von teilwort ;
IF teilwort lang genug
THEN teilwort ausbauen und wandeln ;
SPERRE 1 ; SPERRE (teilwort laenge - 1) ;
vorsilben untersuchen ;
nachsilben untersuchen ;
vorsilbe oder nachsilbe := trennstelle gefunden ;
trennstelle gefunden := FALSE ;
weitere trennstellen suchen ;
IF vorsilbe oder nachsilbe
THEN LEAVE erstelle trennvektor
FI
FI ;
akt pos := anfang teilwort - 1 ;
sonderzeichen modus := TRUE .
bestimme anfang von teilwort:
anfang teilwort := grenz position (ende teilwort, minus one) .
teilwort lang genug:
teilwort laenge := ende teilwort - anfang teilwort + 1 ;
teilwort laenge > 3 .
teilwort ausbauen und wandeln:
teilwort := subtext (wort, anfang teilwort, ende teilwort);
zeichen vor teilwort := anfang teilwort - 1 ;
IF pos (grosse buchstaben, teilwort SUB 1) > 0
THEN replace (teilwort, 1, code (code (teilwort SUB 1) + 32))
FI .
(* Es ist nicht notwendig, gross geschriebene Umlaute am
Wortanfang zu wandeln! *)
weitere trennstellen suchen:
e pos := teilwort laenge ;
aktueller buchstabe ist vokal := letzter buchstabe ist vokal ;
WHILE e pos > 1 REP
anzahl := 0 ;
a pos := e pos ;
IF aktueller buchstabe ist vokal
THEN behandle vokalgruppe
ELSE behandle konsonantengruppe
FI ;
IF trennstelle gefunden
THEN LEAVE erstelle trennvektor
FI ;
e pos := a pos - 1 ;
END REP .
letzter buchstabe ist vokal:
pos (vokal string,teilwort SUB e pos) > 0 .
behandle vokalgruppe:
vokalgruppe lokalisieren ;
IF a pos > 1 AND e pos < teilwort laenge
THEN a pos plus 1 := a pos + 1 ;
a pos plus 2 := a pos + 2 ;
IF anzahl = 2
THEN vokal 2
ELIF anzahl > 2
THEN vokal 3
ELSE vokal 1
FI
FI .
vokalgruppe lokalisieren:
zuletzt := 0 ;
WHILE aktueller buchstabe ist vokal REP
zeichen := teilwort SUB a pos ;
IF pos (vokal string,zeichen) > 0
THEN z code := code(zeichen) ;
IF zuletzt <> cv e
OR (z code <> cv a AND z code <> cv o AND z code <> cv u)
THEN anzahl INCR 1
FI ;
IF a pos > 1
THEN a pos DECR 1 ;
zuletzt := z code
ELSE aktueller buchstabe ist vokal := FALSE
FI
ELSE a pos INCR 1 ;
aktueller buchstabe ist vokal := FALSE
FI
END REP .
behandle konsonantengruppe:
konsonantengruppe lokalisieren ;
IF a pos > 1 AND e pos < teilwort laenge
THEN a pos minus 2 := a pos - 2 ;
a pos minus 1 := a pos - 1 ;
a pos plus 1 := a pos + 1 ;
a pos plus 2 := a pos + 2 ;
e pos minus 1 := e pos - 1 ;
SELECT anzahl OF
CASE 1 : konsonant 1
CASE 2 : konsonant 2
OTHERWISE : konsonant 3
END SELECT
FI .
konsonantengruppe lokalisieren:
rechts von a pos := weder h noch ch ;
REP
zeichen := teilwort SUB a pos ;
IF pos (vokal string, zeichen) = 0
THEN anzahl INCR 1 ;
IF zeichen = "h"
THEN rechts von a pos := buchstabe h
ELIF zeichen = "c" AND rechts von a pos = buchstabe h
THEN anzahl DECR 1 ;
rechts von a pos := zeichenfolge ch
ELIF zeichen = "s" AND rechts von a pos = zeichenfolge ch
THEN anzahl DECR 1 ;
rechts von a pos := weder h noch ch
ELSE rechts von a pos := weder h noch ch
FI ;
IF a pos > 1
THEN a pos DECR 1
ELSE aktueller buchstabe ist vokal := TRUE
FI
ELSE a pos INCR 1 ;
aktueller buchstabe ist vokal := TRUE
FI
UNTIL aktueller buchstabe ist vokal END REP .
vorsilben untersuchen:
code 2 := code (teilwort SUB 2);
code 3 := code (teilwort SUB 3);
IF ch vierer silbe
THEN sperren und setzen (4)
ELSE restliche vorsilben
FI.
ch vierer silbe:
string (2, 4) = "ach" OR string (2, 4) = "och" OR string (2, 4) = "uch".
restliche vorsilben:
ind := pos ("abdefghimnrstuvwüu", teilwort SUB 1);
SELECT ind OF
CASE1(*a*): IF drei silber (1)
THEN sperren und setzen (3)
ELIF code 2 = cv b (*ab*)
THEN IF string(3,5) = "end" (*abend*)
THEN SPERRE 2; sperren und setzen (5)
ELIF string(3,4) = "er" (*aber*)
THEN sperren und setzen (4)
ELSE sperren und setzen (2)
FI
ELIF code 2 = cv n AND string(3,5) <> "alo" (*analo*)
THEN SETZE 2
FI
CASE2(*b*): IF code 2 = cv e (* be *)
THEN IF (teilwort SUB 3) = "h" (* be-handeln usw *)
OR (teilwort SUB 3) = "a" (* beamter *)
THEN sperren und setzen (2)
ELIF string (3, 4) = "ob" (* beobachten *)
THEN SETZE 2; sperren und setzen (4)
FI
ELIF string (2, 3) = "au" (* bauer usw *)
THEN sperren und setzen (3)
FI
CASE3(*d*): IF (code 3 = cv s AND (code 2 = cv i OR code 2 = cv e))
OR string (2, 3) = "ar" (* dis, des, dar*)
THEN sperren und setzen (3)
ELIF string (2, 4) = "enk" (* denk.. *)
THEN sperren und setzen (4)
ELIF string(2,5) = "urch" (*durch*)
THEN SPERRE 3 ; SETZE 5
FI
CASE4(*e*): IF code 2 = cv r AND code 3 <> cv n AND code 3 <> cv d
AND string (3, 4) <> "ro" (* er, aber nicht: ern, erd, erro *)
THEN SETZE 2
ELIF code 2 = cv x (* ex *)
THEN SETZE 2
ELIF (code 2 = cv m AND code 3 = cv p AND (teilwort SUB 4) = "f")
OR (code 2 = cv n AND code 3 = cv t) (* empf, ent *)
THEN sperren und setzen (3)
FI
CASE5(*f*):
CASE6(*g*): IF string (2, 5) = "egen" (* gegen *)
THEN sperren und setzen (5)
ELIF string (2, 6) = "leich" (* gleich *)
THEN IF vorletzter buchstabe (5)
THEN SPERRE 6
ELIF vorletzter buchstabe (6)
THEN sperren und setzen (4)
ELSE sperren und setzen (6)
FI
ELIF zwei silber (1)
THEN SETZE 2
FI
CASE7(*h*): IF string (2, 3) = "in" OR string (2, 3) = "er" (* hin, her *)
THEN sperren und setzen (3)
FI
CASE8(*i*): IF code 2 = cv n (* in *)
THEN IF string (3, 5) = "ter" (* inter *)
THEN sperren und setzen (5)
ELIF subtext (teilwort, 1, 5) = "insbe"
THEN sperren und setzen (3)
ELSE sperren und setzen (2)
FI;
FI
CASE9(*m*): IF string (2, 3) = "ög" AND teilwort laenge > 5 (* mög *)
THEN sperren und setzen (3);
FI
CASE10(*n*): IF string (2, 4) = "ach" AND teilwort laenge >= 7
AND (teilwort SUB 5) <> "t" (* nach, aber nicht: nacht *)
THEN SETZE 4
ELIF string (2, 6) = "ieder" (* nieder *)
THEN sperren und setzen (6)
ELIF string (2, 5) = "icht" (* nicht *)
THEN sperren und setzen (5)
ELIF string (2, 3) = "eu" (* neu *)
THEN sperren und setzen (3);
IF dreisilber (4)
THEN sperren und setzen (6)
FI
ELIF string (2, 5) = "iste"
THEN sperren und setzen (2)
FI
CASE11(*r*): IF code 2 = cv e (* re *)
THEN IF silbenanfang nach (4) (* Realeinkommen *)
THEN sperren und setzen (4)
ELSE sperren und setzen (2)
FI
FI
CASE12(*s*): IF string (2, 6) = "elbst" (* selbst *)
THEN sperren und setzen (6); SPERRE 4
FI
CASE13(*t*): IF string (2, 3) = "at" (* tat *)
THEN sperren und setzen (3)
ELIF string (2, 5) = "rans" (* trans *)
THEN sperren und setzen (5)
ELIF string (2, 4) = "heo" (* theo *)
THEN sperren und setzen (4)
FI
CASE14(*u*): IF code 2 = cv m (* um *)
THEN SETZE 2
ELIF code 2 = cv n (* un *)
THEN IF code 3 = cv i (* uni *)
THEN sperren und setzen (3)
ELSE sperren und setzen (2);
IF string (3, 5) = "ter" (* unter *)
THEN sperren und setzen (5)
FI
FI
FI
CASE15(*v*): IF string (2, 3) = "or" OR string (2, 3) = "on" OR
string (2, 3) = "er" (* vor, von, ver *)
THEN sperren und setzen (3)
FI
CASE16(*w*): IF code 2 = cv e AND code 3 = cv g (* weg *)
THEN sperren und setzen (3)
ELIF code 2 = cv i (* wi *)
THEN IF string(3,5) = "der" (* wider *)
THEN sperren und setzen (5)
ELIF string(3,6) = "eder" (* weder *)
THEN sperren und setzen (6)
FI
FI
CASE17(*ü*): IF string (2, 4) = "ber" (* über *)
THEN sperren und setzen (4)
FI
CASE18(*z*): IF code 2 = cv u (*zu*)
THEN sperren und setzen (2);
IF drei silber (3) (* zuein *)
THEN sperren und setzen (5)
FI
FI
END SELECT.
nachsilben untersuchen:
IF (teilwort SUB teilwort laenge) = "t"
THEN IF (string (teilwort laenge - 3,teilwort laenge) = "heit"
AND (teilwort SUB teilwort laenge - 4) <> "c")
OR string (teilwort laenge - 3, teilwort laenge -1) = "kei"
THEN sperren und setzen (teilwort laenge - 4)
FI
ELIF string (teilwort laenge - 2, teilwort laenge) = "tag"
THEN sperren und setzen (teilwort laenge - 3)
ELIF string (teilwort laenge - 3, teilwort laenge) = "tags"
THEN sperren und setzen (teilwort laenge - 4)
FI.
vokal 1:
IF string (a pos, a pos plus 2) = "uel"
THEN SETZE a pos
FI.
vokal 2 :
ind := pos (vokal string, teilwort SUB a pos);
code 2 := code (teilwort SUB a pos plus 1);
SELECT ind OF
CASE1(*a*): IF code 2 = cv a OR code 2 = cv i OR code 2 = cv y (*aa,ai,ay*)
THEN
ELIF code 2 = cv u
THEN silbe au behandlung
ELSE SETZE a pos
FI
CASE2(*e*): IF code 2 = cv u AND (teilwort SUB a pos plus 2) = "e" (*eue*)
THEN SETZE a pos plus 1
ELIF code 2 = cv o OR code 2 = cv ae OR code 2 = cv ue
OR code 2 = cv oe (*eo, eä, eü, eö *)
THEN SETZE a pos
FI
CASE3(*i*): IF code 2 <> cv e AND code 2 <> cv o (* i, aber nicht: ie, io *)
THEN SETZE a pos
FI
CASE4(*o*): IF code 2 = cv o OR code 2 = cv u (* oo, ou *)
THEN
ELIF code 2 = cv e (* oe *)
THEN SETZE a pos plus 1
ELSE SETZE a pos
FI
CASE5(*u*): IF (teilwort SUB a pos - 1) = "q" (* qu *)
THEN
ELIF code 2 = cv e (* ue *)
THEN SETZE a pos plus 1
ELSE SETZE a pos
FI
CASE7(*y*): IF code 2 <> cv u (* yu *)
THEN SETZE a pos
FI
OTHERWISE (*äöü*): SETZE a pos
END SELECT.
silbe au behandlung:
IF (teilwort SUB a pos + 2) = "e" (* aue, wie in dau-ernd *)
THEN SETZE a pos plus 1
ELIF a pos > 2 AND trennung oder sperre gesetzt (a pos + 2) AND
((teilwort SUB a pos + 2) = "f" OR (teilwort SUB a pos + 2) = "s")
(* aus- oder auf-Mittelsilben *)
THEN SETZE (a pos - 1)
FI.
vokal 3 :
IF string (a pos, a pos plus 2) <> "eau"
AND string (a pos plus 1, a pos+3) <> "eau"
THEN IF e pos - a pos = anzahl - 1
THEN SETZE a pos plus 1
ELSE code 1 := code(teilwort SUB a pos) ;
tr pos := a pos plus 1 ;
IF (code 1 = cv a OR code 1 = cv o OR code 1 = cv u)
AND (teilwort SUB a pos plus 1) = "e"
THEN tr pos INCR 1
FI;
code 2 := code (teilwort SUB tr pos) ;
IF (code 2 = cv a OR code 2 = cv o OR code 2 = cv u)
AND (teilwort SUB tr pos + 1) = "e"
THEN tr pos INCR 1
FI ;
SETZE tr pos
FI
FI .
konsonant 1 :
ind := pos ("bcklmnrstß", teilwort SUB a pos);
SELECT ind OF
CASE1(*b*): IF string (a pos minus 1, a pos plus 2) = "über"
THEN SETZE a pos minus 2
ELIF silbenanfang nach (a pos)
AND NOT trennung oder sperre gesetzt (a pos minus 1)
THEN SETZE a pos
ELIF vorletzter buchstabe oderkeine trennung oder sperre gesetzt
(a pos)
THEN SETZE a pos minus 1
FI;
CASE2(* c oder ch *):
IF ((teilwort SUB a pos plus 1) = "h"
AND (silbenanfang nach (a pos plus 1)
OR string (a pos, a pos + 3) = "chen"))
OR (teilwort SUB a pos plus 1) <> "h"
THEN SETZE a pos minus 1
ELSE SETZE a pos plus 1
FI
CASE3(*k*): IF string (a pos minus 2, a pos minus 1) = "ti" (* tik *)
AND silbenanfang nach (a pos)
THEN SETZE a pos
ELSE SETZE a pos minus 1
FI
CASE4(*l*): IF string (a pos - 3, a pos plus 1) = "reali"
THEN SETZE a pos plus 1
ELIF string (a pos minus 1, a pos plus 1) = "aly"
THEN SETZE a pos minus 1
ELIF string (a pos minus 2, a pos minus 1) = "ta" (*..tal..*)
OR string (a pos minus 2, a pos minus 1) = "na" (*..nal..*)
OR string (a pos minus 2, a pos minus 1) = "ia" (*..ial..*)
THEN SETZE a pos
ELSE SETZE a pos minus 1
FI
CASE5(*m*): IF string (a pos minus 2, a pos minus 1) = "to" (* ..tom..*)
THEN SETZE a pos
ELSE SETZE a pos minus 1
FI
CASE6(*n*): IF string (a pos - 4, a pos minus 1) = "gege"
OR string (a pos - 4, a pos minus 1) = "nebe" (*gegen, neben*)
THEN SETZE (a pos - 3) ; SETZE a pos
ELIF string (a pos minus 1, a pos plus 1) = "ini"
THEN
ELIF NOT silbenanfang vor (a pos)
AND ((teilwort SUB a pos minus 1) = "e" (* en *)
OR (teilwort SUB a pos minus 1) = "u") (* un *)
AND (silbenanfang nach (a pos)
OR string (a pos plus 1, a pos plus 2) = "ob")
THEN SETZE a pos
ELIF string (a pos minus 2, a pos plus 1) = "eina"
THEN SETZE a pos
ELSE SETZE a pos minus 1
FI
CASE7(*r*): IF string (a pos minus 2, a pos minus 1) = "tu" (*..tur..*)
THEN IF string (a pos plus 1, a pos plus 2) = "el"
OR (string (a pos plus 1, a pos plus 2) = "en"
AND string (a pos minus 1, apos +3) <> "ent")
(* turel OR <>turentwick*)
THEN SETZE a pos minus 1
ELSE SETZE a pos
FI
ELIF string (a pos minus 2, a pos minus 1) = "ve" (*..ver..*)
OR string (a pos minus 2, a pos minus 1) = "vo" (*..vor..*)
THEN SETZE a pos
ELIF string (a pos minus 2, a pos minus 1) = "te" (* ter *)
THEN IF dreisilber (a pos plus 1)
OR string (a pos plus 1, a pos plus 1) = "a" (*tera*)
OR string (a pos - 3, a pos minus 2) <> "zt" (*zter*)
THEN SETZE a pos
ELSE SETZE a pos minus 1
FI
ELIF (teilwort SUB a pos minus 1) = "e" (* er*)
AND silbenanfang nach (a pos)
AND string (a pos plus 1, a pos + 3) <> "ung" (*erung*)
AND string (a pos plus 1, a pos plus 2) <> "er" (*erer*)
THEN SETZE a pos
ELIF vorletzter buchstabe oderkeine trennung oder sperre gesetzt
(a pos)
THEN SETZE a pos minus 1
FI
CASE8(*s*): IF string (a pos minus 2, a pos minus 1) = "de" (* des *)
OR string (a pos minus 2, a pos minus 1) = "xi" (* ..xis *)
THEN SETZE a pos
ELIF string (a pos minus 2, a pos minus 1) = "ni" (* nis *)
AND silbenanfang nach (a pos)
THEN SETZE a pos
ELIF vorletzter buchstabe oderkeine trennung oder sperre gesetzt
(a pos)
THEN SETZE apos minus 1
FI
CASE9(*t*): IF string (a pos plus 1, a pos + 3) = "ion" (* tion *)
THEN SETZE a pos minus 1
ELIF string (a pos plus 1, a pos + 3) <> "ier" (* imitieren *)
AND (string (a pos minus 2, a pos minus 1) = "mi"(*...mit..*)
OR string (a pos minus 2, a pos minus 1) = "va"(*privat..*)
OR string (a pos minus 2, a pos minus 1) = "fi"(*profit..*)
OR string (a pos - 3, a pos minus 1) = "zei")(*..zeit..*)
THEN SETZE a pos
ELSE SETZE a pos minus 1
FI
CASE10(*ß*): IF string (a pos, a pos plus 2) = "ßen"
OR vorletzter buchstabe (a pos)
THEN SETZE a pos minus 1
ELSE SETZE a pos
FI
OTHERWISE: IF vorletzter buchstabe oderkeine trennung oder sperre gesetzt
(a pos)
THEN SETZE a pos minus 1
FI
END SELECT.
konsonant 2 :
kons gr := string (a pos, e pos);
IF a pos > 2 AND trennung oder sperre gesetzt (a pos minus 1)
THEN
ELIF ausnahme fuer zwei konsonanten
THEN SETZE a pos
ELIF kons gr = "ts"
THEN IF NOT trennung oder sperre gesetzt (a pos)
(* für <> Tatsache, tatsächlich *)
THEN SETZE e pos
FI
ELIF kons gr = "tz"
THEN IF (teilwort SUB a pos plus 2) = "e" (* ..tze.. *)
OR (teilwort SUB a pos plus 2) = "u" (* ..tzu.. *)
THEN SETZE a pos
ELSE SETZE a pos plus 1
FI
ELIF string (a pos, a pos plus 1) = "ch"(* ch zaehlt als 1 Buchstabe *)
THEN SETZE a pos plus 1 (* darum keine Abfrage mit kons gr *)
ELIF (kons gr = "dt" OR kons gr = "kt")
AND silbenanfang nach (e pos)
THEN SETZE e pos
ELIF kons gr = "ns" AND
(string (a pos - 2, a pos - 1) = "io" (* ..ions *)
OR (string (a pos minus 1, a pos) ="en" (*..ens..*)
AND (teilwort SUB a pos minus 2) <> "t")) (* aber nicht ..tensiv*)
THEN SETZE e pos
ELIF string (a pos minus 2, a pos plus 1) = "nach"
THEN IF (teilwort SUB a pos plus 2) <> "t"
THEN SETZE a pos plus 1
FI
ELIF string (e pos, e pos + 3) = "lich"
THEN IF string (a pos minus 2, a pos) = "mög"
THEN SETZE a pos
ELIF pos ("hg", teilwort SUB e pos minus 1) > 0
THEN SPERRE e pos minus 1
ELSE SETZE e pos minus 1
FI;
ELIF (reg (a pos) AND NOT trennung oder sperre gesetzt (a pos))
OR (kons gr = "sp" AND silbenanfang vor (a pos))
THEN SETZE a pos minus 1
ELIF string (a pos, a pos plus 2) = "sch"
THEN SETZE a pos plus 2
ELSE SETZE a pos
FI.
ausnahme fuer zwei konsonanten:
string (a pos minus 2, a pos) = "nis" AND a pos > 1
(*..nis.., aber nicht nisten *)
OR string (a pos minus 2, a pos plus 1) = "rafr" (* strafrecht *)
OR string (a pos - 4, a pos) = "undes" (* Bundes *)
OR string (a pos minus 1, a pos + 3) = "unter"
OR silbenanfang vor (e pos).
konsonant 3 :
code 1 := code (teilwort SUB a pos);
code 2 := code (teilwort SUB a pos plus 1);
code 3 := code (teilwort SUB a pos plus 2);
IF NOT (ausnahme 1 OR ausnahme 2 OR ausnahme 3 OR ausnahme 4)
THEN suche regelmaessige konsonantenverbindung
FI.
ausnahme 1 :
ind := pos ("cfgklnprt", code (code 1));
SELECT ind OF
CASE1(*c*): IF code 2 = cv k (* ck *)
THEN SETZE a pos plus 1
ELIF string (a pos, a pos + 3) = "chts"
(* Rechts.., Gesichts.., .. machts..*)
THEN SETZE (a pos + 3)
ELIF string (a pos plus 1, a pos + 5) = "hstag" (* Reichstag *)
OR (string (a pos, a pos plus 2) = "chs" AND (* ..chs.. *)
string (a pos plus 2, a pos +3) <> "st")
THEN SETZE a pos plus 2
ELSE LEAVE ausnahme 1 WITH FALSE
FI;
TRUE
CASE2(*f*): IF code 2 = cv f (*ff*)
THEN IF code 3 = cv s
THEN SETZE a pos plus 2 (* ffs *)
ELSE SETZE a pos plus 1
FI
ELIF string (a pos minus 1, a pos plus 1) = "aft" (*..aft..*)
THEN IF (teilwort SUB a pos plus 2) = "s"
THEN SETZE a pos plus 2
ELSE SETZE a pos plus 1
FI
ELSE LEAVE ausnahme 1 WITH FALSE
FI;
TRUE
CASE3(*g*): IF string (a pos minus 2, a pos minus 1) = "ag" (* ags *)
THEN SETZE a pos plus 1
ELSE LEAVE ausnahme 1 WITH FALSE
FI;
TRUE
CASE4(*k*): IF string (a pos, a pos plus 1) = "kt"
AND silbenanfang nach (a pos plus 1)
THEN SETZE a pos plus 1
ELSE LEAVE ausnahme 1 WITH FALSE
FI;
TRUE
CASE5(*l*): IF code 2 = cv d OR code 2 = cv g OR code 2 = cv k (*ld, lg, lk*)
THEN SETZE a pos plus 1
ELIF string (a pos, a pos + 4) = "ltspr" (* Anwaltsprogramm *)
THEN SETZE (a pos + 2)
ELSE LEAVE ausnahme 1 WITH FALSE
FI;
TRUE
CASE6(*n*): IF string (a pos - 2, a pos) = "ein"
THEN SETZE a pos
ELIF code 2 = cv d (* nd *)
THEN IF code 3 = cv s (* nds, wie in ...stands... *)
THEN SETZE a pos plus 2
ELSE SETZE a pos plus 1
FI
ELIF code 2 = cv g (* ng *)
THEN IF code 3 = cv s (* ..ngs.. *)
THEN SETZE a pos plus 2
ELIF code 3 = cv r (* ..ngr.. *)
THEN SETZE a pos
ELIF code 3 = cv l (* ungleich *)
THEN
ELSE SETZE a pos plus 1
FI
ELIF string (a pos - 3, a pos plus 1) = "trans"
OR string (a pos - 3, a pos plus 1) = "tions" (*tionsplan*)
THEN SETZE a pos plus 1
ELIF string (a pos plus 1, a pos + 6) = "ftsper" (*ftsperspek*)
THEN SETZE (a pos + 3)
ELSE LEAVE ausnahme 1 WITH FALSE
FI;
TRUE
CASE7(*p*): IF code 2 = cv p (* pp *)
OR (code 2 = cv f AND code 3 = cv t) (* pft *)
THEN SETZE a pos plus 1; TRUE
ELSE FALSE
FI
CASE8(*r*): IF string (a pos plus 1, a pos + 4) = "tner" (* rtner *)
THEN SETZE a pos plus 1
ELIF trennung oder sperre gesetzt (a pos)
THEN
ELSE LEAVE ausnahme 1 WITH FALSE
FI;
TRUE
CASE9(*t*): IF string (a pos plus 1, a pos plus 2) = "st" (*tst*)
THEN SETZE a pos
ELIF string (a pos plus 1, a pos plus 2) = "zt"
(* letzt.. *)
THEN IF (teilwort SUB a pos + 3) = "e" (*letzte..*)
THEN SETZE a pos plus 1
ELSE SETZE a pos plus 2
FI
ELIF string (apos - 2, a pos plus 1) = "eits"
(* ..heits.., ..keits.., ..beits.. *)
OR string (a pos plus 1, a pos plus 1)= "z" (*tz*)
THEN SETZE a pos plus 1
ELSE LEAVE ausnahme 1 WITH FALSE
FI;
TRUE
OTHERWISE: FALSE
END SELECT.
ausnahme 2 :
IF e pos - a pos = 2
THEN FALSE
ELIF code 2 = cv p AND string (a pos plus 2, a pos + 3) = "ft" (* pft *)
THEN SETZE a pos plus 2; TRUE
ELSE FALSE
FI .
ausnahme 3 :
IF code 1 = cv s
THEN IF code 2 = cv t AND code 3 <> cv r (* st, aber nicht: str *)
AND pos (vokal string, teilwort SUB a pos plus 2) = 0
THEN SETZE a pos plus 1 ; TRUE
ELSE FALSE
FI
ELIF code 2 = cv s
THEN IF code 3 = cv t AND (teilwort SUB a pos + 3) <> "r"
AND pos (vokal string, teilwort SUB (a pos + 3)) = 0
THEN SETZE a pos plus 2; TRUE
ELSE FALSE
FI
ELSE FALSE
FI .
ausnahme 4 :
IF string (e pos, e pos + 3) = "lich"
THEN IF pos ("hg", teilwort SUB e pos minus 1) > 0
THEN SPERRE e pos minus 1
ELSE SETZE e pos minus 1
FI;
TRUE
ELSE FALSE
FI .
suche regelmaessige konsonantenverbindung :
FOR posit FROM a pos UPTO e pos minus 1 REP
IF reg (posit)
THEN SETZE (posit - 1); LEAVE konsonant 3
FI
END REP ;
IF (teilwort SUB e pos) <> "h" OR (teilwort SUB e pos minus 1) <> "c"
THEN SETZE e pos minus 1
ELIF (teilwort SUB e pos - 2) <> "s"
THEN SETZE (e pos - 2)
ELSE SETZE (e pos - 3)
FI
END PROC erstelle trennvektor ;
END PACKET silbentrennung;