Cod sursa(job #408462)

Utilizator saodem74hieu tran saodem74 Data 3 martie 2010 03:28:42
Problema Sortare topologica Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.29 kb
const tfi='sortaret.in';
      tfo='sortaret.out';
      maxm=100100;
type  ds=record
            u,v:longint;
          end;
var   fi,fo:text;
      last,first,n,m:longint;
      q,bvao,st,ke:array[0..maxm] of longint;
      li:array[0..maxm] of ds;


procedure enter;
var i,j:longint;
begin
  read(fi,n,m);
  for i:=1 to m do
   with li[i] do
    begin
     read(fi,u,v);
     inc(st[v]);
     inc(bvao[u]);
    end;

   inc(st[1]);
   for i:=2 to n+1 do st[i]:=st[i]+st[i-1];

   for i:=1 to m do
   with li[i] do
    begin
     dec(st[v]);
     ke[st[v]]:=u;
    end;
end;

procedure push(u:longint);
begin
  inc(last);
  q[last]:=u;
end;

function pop:longint;
begin
  inc(first);
  pop:=q[first];
end;

procedure process;
var i,j:longint;
begin
  last:=0; first:=0;
  for  i:=1 to n do
   if bvao[i] = 0 then push(i);
  repeat
    i:=pop;
    for j:=st[i] to st[i+1]-1 do
      if (bvao[ke[j]]<>0) then
       begin
        dec(bvao[ke[j]]);
        if bvao[ke[j]]=0 then push(ke[j]);
       end;
  until first=last;
end;

procedure print;
var i:longint;
begin
  for i:=n downto 1 do write(fo,q[i],' ');
end;

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