Cod sursa(job #701573)

Utilizator pongraczlajosLajos Pongracz pongraczlajos Data 1 martie 2012 16:35:54
Problema Sortare topologica Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.97 kb
type lista=^elem;
     elem=record
      cs:longint;
      kov:lista;
     end;

var q:array[1..50001] of longint;
    x:array[1..50001] of lista;
    befok:array[1..50001] of longint;
    p:lista;
    n,m,i,qn,a,b:longint;
    f:text;

procedure betesz(var s:lista; cs:longint);
var uj,p:lista;
begin
 new(uj);
 uj^.cs:=cs;
 uj^.kov:=nil;
 if s=nil then s:=uj
 else begin
  p:=s;
  while p^.kov<>nil do
   p:=p^.kov;
  p^.kov:=uj;
 end;
end;

begin
assign(f,'sortaret.in');
reset(f);
readln(f,n,m);
for i:=1 to m do begin
 readln(f,a,b);
 betesz(x[a],b);
 inc(befok[b]);
end;
close(f);

qn:=0;
for i:=1 to n do
 if (befok[i]=0) then begin
  inc(qn);
  q[qn]:=i;
 end;

for i:=1 to n do begin
 p:=x[q[i]];
 while p<>nil do begin
  dec(befok[p^.cs]);
  if (befok[p^.cs]=0) then begin
   inc(qn);
   q[qn]:=p^.cs;
  end;
  p:=p^.kov;
 end;
end;

assign(f,'sortaret.out');
rewrite(f);
for i:=1 to n do
 write(f,q[i],' ');
close(f);
end.