Cod sursa(job #476400)

Utilizator StigmaSimina Pitur Stigma Data 10 august 2010 21:05:12
Problema Sortare topologica Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.27 kb
program sortare_topologica;
const max=50100;

type point=^nod;
     nod=record
         crt:longint;
         next:point;
         end;

var n,m,i,x,y:longint;
    fin,fout:text;
    s,f,l,aux:point;
    ext:array[1..max] of longint;
    a:array[1..max] of point;


procedure push(x,y:longint);
var p:point;
begin
new(p);
p^.crt:=x;
p^.next:=a[y];
a[y]:=p;
end;


procedure add(x:longint);
var p:point;
begin
new(p);
p^.crt:=x;
if s=nil then
begin s:=p; f:=s; end
else begin f^.next:=p; f:=p; end;
end;

procedure add_l(x:longint);
var p:point;
begin
new(p);
p^.crt:=x;
if l=nil then
l:=p
else begin p^.next:=l; l:=p; end;
end;


begin
assign(fin,'sortaret.in'); reset(fin);
assign(fout,'sortaret.out'); rewrite(fout);

readln(fin,n,m);
for i:=1 to m do
begin
readln(fin,x,y);
push(x,y);
ext[x]:=ext[x]+1;
end;

for x:=1 to n do
if ext[x]=0 then
add(x);

while not(s=nil) do
begin
x:=s^.crt;
s:=s^.next;
add_l(x);

while not(a[x]=nil) do
 begin
  ext[a[x]^.crt]:=ext[a[x]^.crt]-1;
  if ext[a[x]^.crt]=0 then add(a[x]^.crt);
  m:=m-1;
  new(aux);
  aux:=a[x];
  a[x]:=a[x]^.next;
  dispose(aux);
  end;

end;

while NOT(l=nil) do
begin
write(fout,l^.crt,' '); l:=l^.next;
end;

close(fin);close(fout);
end.