uses crt;

type
  PTreeNode = ^TTreeNode;
  TTreeNode = record
                left, right, parent : PTreeNode;
                value : char;
              end;

{ Vytvori prazdny strom. }
function empty_tree : PTreeNode;
begin
  empty_tree := nil; { jednoduse vratime nil }
end;

{
  Vytvori leveho ci praveho potomka uzlu x s hodnotou value.
  To, jestli bude vytvoren levy ci pravy podstrom, je urceno
  parametrem left. Pouziti viz hlavni telo programu.

  (Procedura insert netvori binarni vyhledavaci strom.
  Proste jen vytvori uzlu x noveho potomka, pokud to jde.)
}
procedure new_child(var x : PTreeNode; value : char; left : boolean);
var
  p : PTreeNode;
begin
  if
    (x <> nil) and
    ((left and (x^.left <> nil)) or (not left and (x^.right <> nil))) then
  begin
    writeln('Vytvarime syna ve stromu na miste, kde uz syn je.');
    exit;
  end;

  { vytvorime syna }
  new(p);
  p^.value := value;
  p^.parent := x;
  p^.left := nil; { hodnoty musime inicializovat }
  p^.right := nil;

  { umistime ho na odpovidajici misto }
  if x = nil then x := p          { do korene }
  else if left then x^.left := p  { levy syn }
  else x^.right := p;             { pravy syn }
end;

{ Zkratka pro vytvoreni leveho syna. }
procedure new_child_left(x : PTreeNode; value : char);
begin
  new_child(x, value, true);
end;

{ Zkratka pro vytvoreni praveho syna. }
procedure new_child_right(x : PTreeNode; value : char);
begin
  new_child(x, value, false);
end;

{ Hezky vytiskne stromecek. }
procedure print_tree(x : PTreeNode; depth : word);
var
  i : word;
begin
  if x <> nil then { pokud je strom prazdny, netiskneme nic }
  begin
    { vytiskneme pravy podstrom }
    print_tree(x^.right, depth + 1);
    { odsadime prave tisknuty prvek }
    for i := 1 to depth do write(' ');

    { a vytiskneme ho }
    writeln(x^.value);

    { vytiskneme levy podstrom }
    print_tree(x^.left, depth + 1);
  end;
end;

{ Najde nasledujici prvek ve strome. }
function succ(x : PTreeNode) : PTreeNode;
var
  t : PTreeNode;
  found : boolean;
begin
  if x = nil then succ := nil else
  begin
    { Ma praveho syna? }
    if x^.right <> nil then
    begin
      { jdi do praveho syna a pak co nejvic doleva }
      x := x^.right;
      while x^.left <> nil do x := x^.left;
    end else begin
      { jdi nahoru dokud jsi nesel vpravo }
      found := false;
      while x^.parent <> nil do
      begin
        t := x;
        x := x^.parent;
        if x^.left = t then
        begin
          found := true;
          break;
        end;
      end;

      if not found then x := nil;
    end;

    succ := x;
  end;
end;

{ Smaze uzel stromu. }
procedure delete_node(var x : PTreeNode);
var
  p, s : PTreeNode;
begin
  { potrebujeme odkaz na rodice }
  p := x^.parent;

  { Kolik ma tento uzel synu? }
  if (x^.left = nil) and (x^.right = nil) then
  begin

    { jednoduche, smazeme list }
    if p^.left = x then p^.left := nil else p^.right := nil;
    dispose(x);
    x := nil;

  end else if (x^.left = nil) or (x^.right = nil) then
  begin

    { propojime rodice s jedinym synem }
    if x^.left <> nil then s := x^.left else s := x^.right;
    if p^.left = x then p^.left := s else p^.right := s;
    s^.parent := p;

    { uvolnime pamet }
    dispose(x);
    x := nil;

  end else
  begin

    { ma oba syny, vezmeme minimum z praveho syna a vymenime hodnoty }
    s := x^.right;
    while s^.left <> nil do s := s^.left;
    x^.value := s^.value;

    { pote smazeme tento list }
    delete_node(s);

  end;
end;

var
  orig, t : PTreeNode;
begin
  clrscr;

  t := empty_tree;
  new_child(t, 'X', true); { vytvorime koren }
  new_child_left(t, 'Y'); { pridame leveho potomka }
  new_child_right(t, 'A'); { praveho potomka korenu }
  new_child_left(t^.left, 'Q'); { a tak dal postavime strom }
  new_child_right(t^.right, 'C');
  new_child_left(t^.right, 'D');
  new_child_left(t^.left^.left, 'B');

  print_tree(t, 0);
  writeln;
  orig := t;

  t := t^.left^.left^.left;
  while t <> nil do
  begin
    write(t^.value, ' ');
    if t^.left = nil then new_child_left(t, 'Z');
    t := succ(t);
  end;
  writeln;

  t := orig;
  print_tree(t, 0);
  writeln;

  delete_node(t);
  print_tree(t, 0);
end.