program ObjectTree;

{DEFINE DEBUG}

type 
  PNode = ^TNode;
  TNode = object
            private
              key : integer;
              left, right : PNode;
	      function  GetSuccessor(k:integer;var ret:PNode):PNode;
	      function _Delete(k:integer):PNode;

            public
              constructor Init(k:integer);
              destructor  Done;

              function  GetKey:integer;
	      procedure InsertNode(node:PNode);
	      function  Search(k:integer):PNode;
	      procedure PrintTree(level:integer);
	      procedure SetChildren(l:PNode; r:PNode);
	      procedure DeleteNode(k:integer);
             end;

constructor TNode.Init(k:integer);
begin
  key:=k;
  left:=nil;
  right:=nil;
  {$IFDEF DEBUG}
  writeln('TNode.Init: Vytvoren uzel s hodnoutou klice ', key);
  {$ENDIF}
end;

destructor TNode.Done;
begin
  if left <> nil then Dispose(left, Done);
  if right <> nil then Dispose(right, Done);
  {$IFDEF DEBUG}
  writeln('TNode.Done: Zrusen uzel s hodnoutou klice ', key);
  {$ENDIF}
end;

function TNode.GetKey:integer;
begin
  GetKey:=key;
end;

procedure TNode.InsertNode(node:PNode);
begin
  {$IFDEF DEBUG}
  writeln('TNode.InsetNode: aktualni uzel ', key, ' pridavany uzel ', node^.GetKey);
  {$ENDIF}
  if (node^.GetKey <= key) then
    if ( left = nil) then       { Pujdeme vlevo }
      begin
        left := node;	{vlevo nic neni, takze muzeme pridat uzel}
	{$IFDEF DEBUG}
	writeln('TNode.InserNode: Pridan uzel vlevo pod uzel s klicem ', key);
	{$ENDIF}
      end
    else
      left^.InsertNode(node) {vlevo je podstrom, nechame ho pridat uzel}
  else
    if ( right = nil) then       { Pujdeme vpravo }
      begin
        right := node;	{vpravo nic neni, takze muzeme pridat uzel}
	{$IFDEF DEBUG}
	writeln('TNode.InserNode: Pridan uzel vpravo pod uzel s klicem ', key);
	{$ENDIF}
      end
    else
      right^.InsertNode(node); {vpravo je podstrom, nechame ho pridat uzel}
end;

procedure TNode.PrintTree(level:integer);
var
  pom : integer;
begin
  writeln('*',key);
  if (right<>nil) then
    begin
      for pom:= 0 to (level*4) do write(' '); write('R: ');
      right^.PrintTree(level+1);
    end;
  if (left <> nil) then
    begin
      for pom:= 0 to (level*4) do write(' '); write('L: ');
      left^.PrintTree(level+1);
    end;
end;

function TNode.Search(k:integer):PNode;
begin
  if (key=k) then 
    begin
      {Nasli jsme hledany klic}
      Search:=@self;
      exit;
    end;
  if (k <= key) then
    if (left = nil) then
      {Hledany uzel by mel byt vlevo, ale tam uz nic neni => neexistuje}
      Search:=nil
    else
      {Hledany uzel by mel byt vlevo a neco tam je, tak hledame dal}
      Search:=left^.Search(k)
  else
    if (right = nil) then
      {Hledany uzel by mel byt vpravo, ale tam uz nic neni => neexistuje}
      Search:=nil
    else
      {Hledany uzel by mel byt vpravo a neco tam je, tak hledame dal}
      Search:=right^.Search(k);
end;

procedure TNode.SetChildren(l:PNode; r:PNode);
begin
  if (l = @self) then left:=nil else left:=l;
  if (r = @self) then right:=nil else right:=r;
end;

function TNode.GetSuccessor(k:integer; var ret:PNode):PNode;
begin
  {$IFDEF DEBUG}
  writeln('GetSuccessor: current= ',key,' k=', k);
  {$ENDIF}
  if (key > k) then
    begin
      {zaciname hledat nasledovnika}
      if (left = nil) then
        begin
	  {ja jsem naslednik}
	  GetSuccessor:=@self;
	  ret:=right;
	end
      else
        begin
	  {naslednik je nekde vlevo}
	  GetSuccessor:=left^.GetSuccessor(k,ret);
	  left:=ret;
	  ret:=@self;
	end;
    end
  else
    begin
      {hledame stejny prvek v levem podstromu}
      if (right = nil) then
        begin
	  {ja bych mohl byt naslednik}
	  if (key = k) then 
  	    GetSuccessor:=@self
	  else
	    GetSuccessor:=nil;
	  ret:=left;
	end
      else
        begin
	  {naslednik je nekde vpravo}
	  GetSuccessor:=right^.GetSuccessor(k,ret);
	  right:=ret;
	  ret:=@self;
	end;
    end;
end;

function TNode._Delete(k:integer):PNode;
var
  ret,out : PNode;
begin
  {$IFDEF DEBUG}
  writeln('_Delete: current ', key, ', delete ', k);
  {$ENDIF}
  if (key = k) then
    begin
      {ja jsem ten chudak, co se ho chteji zbavit}
      if ((left <> nil) and (right <> nil)) then
       begin
         out:=left^.GetSuccessor(key,ret);
	 if (out=nil) then		{vlevo neni nikdo stejny jako ja}
           out:=right^.GetSuccessor(key,ret);
	 {oklestim se a prevedu potomky na sveho nastupce}
         out^.SetChildren(left,right);
         left:=nil; right:=nil;
	 _Delete:=out;
       end
      else
        if (left <> nil) then
	  begin
	    {Posuneme cely levy podstrom}
	    _Delete:=left;
	    left:=nil;
	  end
	else if (right <> nil) then
	  begin
	    {Posuneme cely pravy podstrom}
	    _Delete:=right;
	    right:=nil;
	  end
	else
	  begin
	    {staci zrusit sam sebe}
	    _Delete:=nil;
	  end;
    end
  else
    begin
      _Delete:=@self;
      if ((k <= key) and (left<>nil)) then
        begin
          ret:=left^._Delete(k);
	  if (ret <> left) then
	    begin
	      Dispose(left,Done);
	      left:=ret;
	    end;
        end;

      if ((k > key) and (right<>nil)) then
        begin
          ret:=right^._Delete(k);
	  if (ret <> right) then
	    begin
	      Dispose(right,Done);
	      right:=ret;
	    end;
	end;
    end;
end;

procedure TNode.DeleteNode(k:integer);
var
  ret : PNode;
begin
  if (key = k) then
    writeln('Neumim smazat koren')
  else
    begin
      if ((k <= key) and (left<>nil)) then
        begin
          ret:=left^._Delete(k);
	  if (ret <> left) then
	    begin
	      Dispose(left,Done);
	      left:=ret;
	    end;
	end;
      if ((k > key) and (right<>nil)) then
        begin
          ret:=right^._Delete(k);
	  if (ret <> right) then
	    begin
	      Dispose(right,Done);
	      right:=ret;
	    end;
	end;
    end;
end;

function HledejUzel(r:PNode;k:integer):boolean;
var
  Pomocny : PNode;
begin
  write('Hledam uzel s hodnotou klice ', k, ': ');
  Pomocny:=r^.Search(k);
  if (Pomocny <> nil) then
    begin
      writeln('nalezen, vraci hodnotu klice: ', Pomocny^.GetKey);
      writeln('Podstromy nalezeneho uzlu:');
      Pomocny^.PrintTree(0);
      HledejUzel:=true;
    end
  else
    begin
      writeln('nenalezen');
      HledejUzel:=false;
    end;
end;

procedure VyrobStrom(Koren:PNode);
var
  Pomocny : PNode;
begin
  New(Pomocny, Init(5)); Koren^.InsertNode(Pomocny);
  New(Pomocny, Init(3)); Koren^.InsertNode(Pomocny);
  New(Pomocny, Init(12)); Koren^.InsertNode(Pomocny);
  New(Pomocny, Init(10)); Koren^.InsertNode(Pomocny);
  New(Pomocny, Init(13)); Koren^.InsertNode(Pomocny);
  New(Pomocny, Init(6)); Koren^.InsertNode(Pomocny);
  New(Pomocny, Init(7)); Koren^.InsertNode(Pomocny);
  New(Pomocny, Init(16)); Koren^.InsertNode(Pomocny);
  New(Pomocny, Init(20)); Koren^.InsertNode(Pomocny);
  New(Pomocny, Init(18)); Koren^.InsertNode(Pomocny);
  New(Pomocny, Init(23)); Koren^.InsertNode(Pomocny);
  New(Pomocny, Init(7)); Koren^.InsertNode(Pomocny);
  New(Pomocny, Init(8)); Koren^.InsertNode(Pomocny);
end;

procedure DeleteDemo(Koren:PNode; Klic:integer);
begin
  writeln('--------------------------------------------------');
  writeln('Novy strom:');
  New(Koren, Init(15));
  VyrobStrom(Koren);
  Koren^.PrintTree(0);
  Koren^.DeleteNode(klic);
  writeln('Smazeme uzel s klicem ',klic,':');
  Koren^.PrintTree(0);
  Dispose(Koren,Done);
end;

var
  Koren   : PNode;
begin
  New(Koren, Init(15));
  writeln('Koren ma hodnotu: ', Koren^.GetKey);
  VyrobStrom(Koren);
  Koren^.PrintTree(0);
  HledejUzel(Koren, 15);
  HledejUzel(Koren, 1);
  Koren^.PrintTree(0);
  Dispose(Koren,Done);

  DeleteDemo(Koren,13);
  DeleteDemo(Koren,16);
  DeleteDemo(Koren,7);
end.

