Cod sursa(job #347727)

Utilizator florin_marius90Florin Marius Popescu florin_marius90 Data 13 septembrie 2009 11:56:35
Problema Sortare topologica Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.97 kb
type nod=^node;
     node= record
           x:longint;
           next:nod;
           end;
var d:array[1..50000] of nod;
    grad:array[1..50000] of longint;
    sol:array[1..50000] of longint;
    i,m,w,n,a,b,t:longint;
    z,p:nod;
    f,g:text;
begin
assign(f,'sortaret.in'); reset(f);
assign(g,'sortaret.out'); rewrite(g);
read(f,n,m);
for i:=1 to m do
 begin
 readln(f,a,b);
 grad[b]:=grad[b]+1;
 new(p);
 p^.x:=b;
 p^.next:=d[a];
 d[a]:=p;
 {new(p);
 p^.x:=a;
 p^.next:=d[b];
 d[b]:=p;}

 end;                t:=0;
 for i:=1 to n do
  if grad[i]=0 then begin
                    t:=t+1;
                    sol[t]:=i;
                    end;  i:=1;
 while i<=t do
  begin
  w:=sol[i]; z:=d[w];
  while z<>nil do
   begin

   grad[z^.x]:=grad[z^.x]-1;
   if grad[z^.x]=0 then begin t:=t+1; sol[t]:=z^.x; end
   ; z:=z^.next;
   end;
   i:=i+1;
   end;
 for i:=1 to t do
  write(g,sol[i],' ');
  close(f); close(g);
  end.