{
------------------------------------------------------------------------------- 
Autor: Jan Kohlhof
Email: kohj@hrz.tu-chemnitz.de
-------------------------------------------------------------------------------
}

UNIT suchbaum;

INTERFACE
uses crt;
type mytype =  integer;
     
     liste = ^element;
     element = record
                key:mytype;
		next:liste;
	       end;
	       
     baum = ^knoten;
     knoten = record
     		key:mytype;
		l,r:baum;
	      end;
	      
     stack= ^stackelement;
     stackelement = record
                     key:baum;
		     next:stack;
		    end;
	      
procedure initbaum(var b:baum);
procedure ins(var b:baum;x:mytype);
procedure del(var b:baum;x:mytype);
procedure ausgeben(b:baum;x,y,m:integer);
function rebuild(pre,post:liste):baum;

procedure initlist(var l:liste);
procedure insLast(var l:liste;x:mytype);
function preorder(b:baum):liste;
function postorder(b:baum):liste;
procedure listeausgeben(l:liste);

procedure initstack(var s:stack);
procedure push(var s:stack;x:baum);
function pop(var s:stack):baum;

IMPLEMENTATION
{----------------------------- Baumoperationen ------------------------------ }
procedure initbaum(var b:baum);
begin 
 b:=nil;
end;

procedure ins(var b:baum;x:mytype);
begin
 if b<>nil then
  begin
   if x > b^.key then ins(b^.r,x)
   else if x < b^.key then ins(b^.l,x);
  end
 else 
  { Hier sind wir an der richtigen Stelle im Baum angelangt und 
    fuegen das Element ein }
  begin
   new(b);
   b^.key:=x;
   b^.l:=nil;b^.r:=nil;
  end;
end;

function leftmost(b:baum):baum;
begin
 while b^.l <> nil DO b:=b^.l;
 leftmost:=b;
end;

procedure del(var b:baum;x:mytype);
var q:baum;
begin
{ Verfahren :
	- Suche das zu loeschende Element im Baum und 
	  entferne das Element unter beruecksichtigung folgender 
	  Faelle:
	   1. Blattknoten (trivial)
	   2. linker oder rechter Sohn = nil 
	          -> hochziehen des existierenden Sohnes
           3. innerer Knoten 
	       -> entweder linkester knoten des rechten Teilbaums oder
	                   rechtester knoten des linken Teilbaums
	          ersetzt den zu loeschenden knoten. }

if b<>nil then 
 if x > b^.key then del(b^.r,x)
 else if x < b^.key then del(b^.l,x)
 else { Element gefunden -> Abarbeiten der div. Faelle }
  begin
   if (b^.l<>nil) and (b^.r<>nil) then
    begin
     q:=leftmost(b^.r); { suchen den linkesten knoten im rechten TB }
     b^.key:=q^.key;   { Tauschen der Daten }
     del(b^.r,q^.key); { Loeschen des ausgetauschten knotens
                         hier laufen wir nochmal den TB runter :( }
    end
   else
    begin  
     q:=b;
     if b^.l=nil then b:=b^.r
     else b:=b^.l;
     dispose(q);
    end;
  end;
end;

function preorder(b:baum):liste;
var l:liste; 
    s:stack;
begin
initlist(l);
if b<>nil then 
 begin
  initstack(s);
  push(s,b);
  while s<>nil do
   begin
    b:=pop(s);
    insLast(l,b^.key);
    if b^.r<>nil then push(s,b^.r);
    if b^.l<>nil then push(s,b^.l);
   end;
  preorder:=l;
 end;
end;

function postorder(b:baum):liste;
var l:liste;

 procedure order(b:baum;var l:liste);
  begin
   if b<>nil then 
    begin
     order(b^.l,l);
     order(b^.r,l);
     insLast(l,b^.key);
    end;
  end;
  
begin
initlist(l);
order(b,l);
postorder:=l;
end;

function rebuild(pre,post:liste):baum;
var b:baum;

  procedure build(pre,post:liste;var baum:baum);
  var a,b:liste;
   begin
    a:=pre; 
    { Suche die Wurzel in a, preorder }
    while a^.key<>baum^.key do a:=a^.next;
    if (a^.next<>nil)and(a^.key > a^.next^.key) then
     begin { linken Sohn einfuegen }
      new(baum^.l);
      baum^.l^.key:=a^.next^.key;
      baum^.l^.l:=nil;baum^.l^.r:=nil;
      build(pre,post,baum^.l);
     end;
    b:=post;
    {Suche den Vorgaenger der Wurzel in b,postorder}
    while ((b^.next<>nil)and(b^.next^.key<>baum^.key)) do b:=b^.next;
    if ((b^.next<>nil)and(b^.next^.key < b^.key)) then
     begin { rechten Sohn einfuegen }
      new(baum^.r);
      baum^.r^.key:=b^.key;
      baum^.r^.l:=nil;baum^.r^.r:=nil;
      build(pre,post,baum^.r);
     end;
   end;

begin
if(pre<>nil)and(post<>nil) then
 begin
  new(b);
  b^.key:=pre^.key;
  b^.l:=nil;b^.r:=nil;
  build(pre,post,b);
  rebuild:=b;
 end
else rebuild:=nil;
end;

procedure ausgeben(b:baum;x,y,m:integer);
begin
if b<>NIL then begin
               m:=(m div 3)*2;
               ausgeben(b^.l,x-m,y+1,m);
                gotoxy(x,2*y);write(b^.key);
               ausgeben(b^.r,x+m,y+1,m);
               end;
end;

{ -------------------------- Stackoperationen -------------------------- }

procedure initstack(var s:stack);
begin
s:=nil;
end;

procedure push(var s:stack;x:baum);
var q:stack;
begin
new(q);
q^.key:=x;
q^.next:=s;
s:=q;
end;

function pop(var s:stack):baum;
var q:stack;
begin
q:=s;
pop:=q^.key;
s:=s^.next;
dispose(q);
end;

{ -------------------------- Listenoperationen -------------------------- }

procedure initlist(var l:liste);
begin
l:=nil;
end;

procedure insLast(var l:liste;x:mytype);
var q:liste;
begin
q:=l;
if q<>nil then
 begin
  while q^.next<>nil DO q:=q^.next; { gehe zum letzten Element }
  new(q^.next);
  q^.next^.key:=x;
  q^.next^.next:=nil;
 end
else
 begin
  new(l);
  l^.key:=x;
  l^.next:=nil;
 end;
end;

procedure listeausgeben(l:liste);
begin
while l<>nil DO
 begin
  write(l^.key,' ');
  l:=l^.next;
 end;
writeln;
end;

begin
end.