Cod sursa(job #408725)

Utilizator saodem74hieu tran saodem74 Data 3 martie 2010 10:40:26
Problema Hashuri Scor 70
Compilator fpc Status done
Runda Arhiva educationala Marime 1.54 kb
{$Q-,R-,S-}
{$Inline on}
const tfi='hashuri.in';
      tfo='hashuri.out';
      maxn=1000001;
type  li=record u,v:longint;
        end;
var   fi,fo:text;
      cnt,n:longint;
      ds:array[0..maxn] of li;
      t,vt:array[0..maxn] of longint;

procedure enter;
var i:longint;
begin
  read(fi,n);
  for i:=1 to n do
   with ds[i] do read(fi,u,v);
  for i:=1 to n do vt[i]:=i;
end;

procedure swap(var u,v:longint);    inline;
var tg:longint;
begin
  tg:=u; u:=v; v:=tg;
end;

procedure sort(l,r:longint); inline;
var mid,i,j:longint;
begin
  if l>=r then exit;
  i:=l; j:=r;
  mid:=ds[l+random(r-l+1)].v;
  repeat
    while ds[i].v<mid do inc(i);
    while ds[j].v>mid do dec(j);
    if i<=j then
     begin
      swap(vt[i],vt[j]);
      swap(ds[i].v,ds[j].v);
      inc(i);
      dec(j);
     end;
  until i>j;
  sort(i,r);
  sort(l,j);
end;

procedure process;
var x,i,J:longint;
begin
  randomize;
  sort(1,N);
  i:=1; cnt:=0;
  while i<=n do
   begin
    j:=i;
    x:=ds[i].v;
    inc(cnt);
    while (j<=n) and (ds[j].v=x) do
     begin
        t[vt[j]]:=cnt;
        inc(j);
     end;
    i:=j;
   end;
   for i:=1 to n do ds[i].v:=t[i];

end;

procedure tinh;
var i,j:longint;
begin
  for i:=1 to cnt+1 do t[i]:=0;

  for i:=1 to n do
  with ds[i] do
   begin
    if u=1 then t[v]:=1
    else
    if u=2 then t[v]:=0
    else writeln(fo,t[v]);
   end;
end;

begin
  assign(fi,tfi); reset(fi);
  assign(fo,tfo); rewrite(fo);
  enter;
  process;
  tinh;
  close(fi); close(fo);
end.