Cod sursa(job #946463)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 4 mai 2013 15:22:51
Problema Hashuri Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 7.52 kb
program rbtries;
  type arbore=^celula;
       celula=record
                info:longint;
                p,left,right:arbore;
                color:char;
              end;
  var t,r:arbore;
      bufin,bufout:array[1..100000] of byte;
      n,i,w:longint;
      op: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;
    if r=nil then min:=nil
             else begin
                    while r^.left<>nil do r:=r^.left;
                    min:=r;
                  end;
  end;

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

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

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

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

      end;
    if r=nil then
      if x^.info<y^.info then begin
                                x^.p:=y;
                                y^.left:=x;
                              end
                         else begin
                                x^.p:=y;
                                y^.right:=x;
                              end;


  end;



procedure leftrotate(t,x:arbore);
  var y,b:arbore;
  begin
    y:=x^.right; b:=y^.left;
    y^.p:=x^.p;
    if x^.p=nil then t:=y
      else if x^.p^.right=x then x^.p^.right:=y else x^.p^.left:=y;
    if b<> nil then b^.p:=x;
    x^.right:=b;
    y^.left:=x;
    x^.p:=y;
  end;

procedure rightrotate(t,x:arbore);
  var y,b:arbore;
  begin
    y:=x^.left; b:=y^.right;
    y^.p:=x^.p;
    if x^.p=nil then t:=y
      else if x^.p^.right=x then x^.p^.right:=y else x^.p^.left:=y;
    if b<> nil then b^.p:=x;
    x^.right:=b;
    y^.right:=x;
    x^.p:=y;
  end;

procedure rbinsert(t,x:arbore);

  begin
    insert(t,x);
    x^.color:='r';
    while (x<>t)and(x^.p^.color='r') do
      if x^.p^.p^.left=x^.p then
        begin
          if x^.p^.p^.right^.color='r' then
            begin
              x:=x^.p^.p;
              x^.left^.color:='b';
              x^.right^.color:='b';
              x^.color:='r';
            end
          else if x=x^.p^.right then
            begin
              x:=x^.p;
              leftrotate(t,x);
            end
          else
            begin
              x:=x^.p^.p;
              rightrotate(t,x);
              x^.color:='r';
              x^.p^.color:='b';
            end
        end
      else
        begin
           if x^.p^.p^.left^.color='r' then
            begin
              x:=x^.p^.p;
              x^.left^.color:='b';
              x^.right^.color:='b';
              x^.color:='r';
            end
          else if x=x^.p^.left then
            begin
              x:=x^.p;
              rightrotate(t,x);
            end
          else
            begin
              x:=x^.p^.p;
              leftrotate(t,x);
              x^.color:='r';
              x^.p^.color:='b';
            end
        end;
    t^.color:='b'
  end;

procedure rbfixup(t,x:arbore);
  var d,l,r:arbore;
  begin
    if x^.color='r' then x^.color:='b' else
      begin
        while (x<>t) and (x^.color='b') do
          begin
           if x=x^.p^.left then
           begin
            d:=x^.p^.right;
            if d^.color='r' then
              begin
                x^.p^.color:='r';
                d^.color:='b';
                leftrotate(t,x^.p);
              end
            else
              begin
                l:=x^.p^.right^.left;
                r:=x^.p^.right^.right;
                if (l^.color='b')and(r^.color='b') then
                  begin
                    d^.color:='r';
                    x:=x^.p;
                  end
                else if l^.color='r' then
                  begin
                    d^.color:='r';
                    l^.color:='b';
                    rightrotate(t,d);
                  end
                else
                  begin
                    d^.color:=x^.p^.color;
                    x^.p^.color:='b';
                    r^.color:='b';
                    leftrotate(t,x^.p);
                    x:=t;
                  end;
             end;
             end
            else
             begin

            d:=x^.p^.left;
            if d^.color='r' then
              begin
                x^.p^.color:='r';
                d^.color:='b';
                rightrotate(t,x^.p);
              end
            else
              begin
                l:=x^.p^.right^.left;
                r:=x^.p^.right^.right;
                if (l^.color='b')and(r^.color='b') then
                  begin
                    d^.color:='r';
                    x:=x^.p;
                  end
                else if r^.color='r' then
                  begin
                    d^.color:='r';
                    r^.color:='b';
                    leftrotate(t,d);
                  end
                else
                  begin
                    d^.color:=x^.p^.color;
                    x^.p^.color:='b';
                    l^.color:='b';
                    rightrotate(t,x^.p);
                    x:=t;
                  end;
             end;

              end;
          end;
      end;
  end;

procedure delete(t,z:arbore);
  var x,y:arbore;
  begin
    if (z^.left=nil)or(z^.right=nil) then y:=z else y:=succesor(z);
    if y^.left=nil then x:=y^.right else x:=y^.left;
    if x<>nil then x^.p:=y^.p;
    if y^.p=nil then t:=x else
      if y=y^.p^.right then y^.p^.right:=x
                       else y^.p^.left:=x;
    if z<>y then z^.info:=y^.info;
    if y^.color='b' then rbfixup(t,x);
    t^.color:='b';
  end;

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

      end;
  end;

begin
  assign(input,'hashuri.in');
  reset(input);
  settextbuf(input,bufin);
  assign(output,'hashuri.out');
  rewrite(output);
  settextbuf(output,bufout);
  readln(n);
  for i:=1 to n do
    begin
      readln(op,w);
      new(r);r^.info:=w;r^.color:='b';
      case op of
        1: begin new(r);r^.info:=w;r^.color:='b'; if t=nil then t:=r else rbinsert(t,r);end;
        2: if t<>nil then begin r:=search(t,w);if r<>nil then delete(t,r);  end;
        3: if search(t,w)=nil then writeln(0) else writeln(1);
        end;
    end;
  close(input);close(output);
end.