(* ****** 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.