(* ****** Beispiel-Programm fÜr die Anwendung von Tries ******** *) program tries; uses crt; type zeichen = '#'..'z'; infotype = integer; key = string[10]; trie = ^trienode; trienode = record case boolean of True: (map : array[zeichen] of trie); False: (info : infotype) end; var z,wert : integer; procedure insert(w:key; wert:infotype; var p:trie); var i : integer; t,q : trie; begin t:=p; i:=1; repeat if (t^.map[w[i]] = NIL ) then begin new(q); with q^ do begin for z:=ord('#') to ord('z') do map[zeichen(z)]:=NIL; info:=-1; end; t^.map[w[i]]:=q; t:=q; end else t:=t^.map[w[i]]; inc(i); until w[i]='#'; new(q); for z:=ord('#') to ord('z') do q^.map[zeichen(z)]:=NIL; t^.map['#']:=q; t:=t^.map['#']; t^.info:=wert; end; { of insert } function member(w:key; p:trie):infotype; var i : integer; cont : boolean; t : trie; begin cont:=true; i:=1; t:=p; while cont and (w[i] <> '#') do begin t:=t^.map[w[i]]; if t=NIL then cont:=false; inc(i); end; if t^.map['#']^.map['#'] = NIL then cont:=false; if cont then begin t:=t^.map['#']; member:=t^.info; end else member:=-1; end; { of member } procedure delete(w:key; var p:trie); var i : integer; t : trie; begin i:=1; t:=p; repeat t:=t^.map[w[i]]; inc(i); until w[i]='#'; t^.map[w[i]]:=NIL; end; { of delete } (* -------------------------- Main - Programm ----------------------- *) var word : key; baum : trie; begin clrscr; new(baum); with baum^ do begin for z:=ord('#') to ord('z') do map[zeichen(z)]:=NIL; info:=-1; end; writeln('1. : Belegen von CodewÖrtern mit natÜrlichen Zahlen '); writeln('Ende der Eingabe mit CR '); writeln;writeln; repeat write(' Codewort: '); readln(word); writeln;writeln; if word<>'' then begin word:=word + '#'; write(' Wert : '); readln(wert); writeln;writeln; if word<>'#' then insert(word,wert,baum); end; until word=''; readln; clrscr; writeln('2. : Abfragen der Werte von CodewÖrtern .'); writeln('Ende der Abfrage mit CR '); writeln;writeln; repeat write(' Codewort: '); readln(word); writeln;writeln; if word<>'' then begin word:=word + '#'; wert:=member(word,baum); if wert<0 then writeln('Das Wort ist im Trie nicht enthalten ! ') else writeln('Wert des Codewortes = ',wert); writeln;writeln; end; until word=''; readln; clrscr; writeln('3. : LÖschen von CodewÖrtern '); writeln('Ende des LÖschens mit CR '); writeln;writeln; repeat write(' Codewort: '); readln(word); writeln;writeln; if word<>'' then begin word:=word + '#'; wert:=member(word,baum); if wert=-1 then writeln('Das Codewort ist nicht im Baum enthalten ! ') else begin delete(word,baum); writeln('Das Codewort wurde gelÖscht . ');writeln;writeln; end; end; until word=''; end.