Cod sursa(job #946014)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 3 mai 2013 17:23:21
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 3.22 kb
program binary_search_tries;
  type arbore=^celula;
       celula=record
                info:longint;
                p,left,right:arbore;
              end;
  var t,k:arbore;
      n,i,z:longint;
      bufin,bufout:array[1..100000] of byte;

function search(t:arbore;x:longint):arbore;
  var r:arbore;
  begin
    r:=t;
    while (r<>nil) and (r^.info<>x) do
      begin
        if x<r^.info then r:=r^.left
                     else r:=r^.right;
      end;
    search:=r;
  end;

function min(t:arbore):arbore;
  var r:arbore;
  begin
    r:=t;
    while r^.left<>nil do r:=r^.left;
    min:=r;
  end;

function max(t:arbore):arbore;
  var r:arbore;
  begin
    r:=t;
    while r^.right<>nil do r:=r^.right;
    max:=r;
  end;

function succesor(t:arbore):arbore;
  var r:arbore;
  begin
    if t^.right<>nil then succesor:=min(t^.right)
                     else begin
                            r:=t;
                            while (r^.p<>nil) and (r^.p^.right=r) do r:=r^.p;
                            succesor:=r^.p;
                          end;
  end;

function predecesor(t:arbore):arbore;
  var r:arbore;
  begin
    if t^.left<>nil then predecesor:=max(t^.left)
                     else begin
                            r:=t;
                            while (r^.p<>nil) and (r^.p^.left=r) do r:=r^.p;
                            predecesor:=r^.p;
                          end;
  end;

procedure insert(t,x:arbore);
  var r,y:arbore;
  begin
    r:=t;y:=t^.p;
    while r<>nil do
      begin
        y:=r;
        if x^.info<=r^.info then r:=r^.left
                            else r:=r^.right;
      end;
    if x^.info<=y^.info then begin
                               y^.left:=x;
                               x^.p:=y;
                             end
                        else begin
                               y^.right:=x;
                               x^.p:=y;
                             end;

  end;

procedure delete(t,x:arbore);
  var r:arbore;
  begin
    if x^.p^.right=x then if x^.left=nil then begin x^.p^.right:=x^.right;x^.right^.p:=x^.p; end
                                         else if x^.right=nil then begin x^.p^.right:=x^.left;x^.left^.p:=x^.p; end
                  else begin x^.info:=succesor(x)^.info; delete(t,succesor(x));  end
                     else if x^.left=nil then begin x^.p^.left:=x^.right;x^.right^.p:=x^.p; end
                                         else if x^.right=nil then begin x^.p^.left:=x^.left;x^.left^.p:=x^.p; end
                  else begin x^.info:=succesor(x)^.info; delete(t,succesor(x));  end;

  end;

procedure inorder(t:arbore);
  begin
    if t<>nil then begin
                     inorder(t^.left);
                     write(' ',t^.info);
                     inorder(t^.right);
                   end;
  end;

begin
  assign(input,'algsort.in');
  reset(input);
  settextbuf(input,bufin);
  assign(output,'algsort.out');
  rewrite(output);
  settextbuf(output,bufout);
  readln(n);
  read(z);
  new(t);
  t^.info:=z;
  for i:=2 to n do
    begin
      read(z);
      new(k);
      k^.info:=z;
      insert(t,k);
    end;
  inorder(t);
  close(input);
  close(output);
end.