Cod sursa(job #495466)

Utilizator PlayLikeNeverB4George Marcus PlayLikeNeverB4 Data 25 octombrie 2010 13:48:07
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.13 kb
program sortare_topologica;
const maxn=50001;
      maxm=100001;
type inod=0..maxn;
     arc=0..maxm;
     pnod=^nod;
     nod=record
     inf:inod;
     next:pnod;
     end;
var f,g:text; bufin,bufout:array[1..100000] of byte;
    n:inod; m:arc; A:array[inod] of pnod; i:longint;
    Gi,c:array[inod] of inod;

procedure citire;
var q:pnod; x,y:inod;
begin
Readln(f,n,m);
For i:=1 to n do Gi[i]:=0;
For i:=1 to m do
 begin
 Readln(f,x,y);
 new(q);
 q^.inf:=y;
 q^.next:=A[x];
 A[x]:=q;
 inc(Gi[y]);
 end;
end;

procedure sortare_top;
var pi,ps:inod; x:pnod;
begin
pi:=0; ps:=1;
For i:=1 to n do
 If Gi[i]=0 then
  begin
  inc(pi);
  c[pi]:=i;
  end;
While ps<=pi do
 begin
 x:=A[ps];
 While x<>nil do
  begin
  dec(Gi[x^.inf]);
  If Gi[x^.inf]=0 then
   begin
   inc(pi);
   c[pi]:=x^.inf;
   end;
  x:=x^.next;
  end;
 inc(ps);
 end;
end;

procedure afisare;
begin
For i:=1 to n do Write(g,c[i],' ');
end;

begin
Assign(f,'sortaret.in'); Reset(f);
Assign(g,'sortaret.out');Rewrite(g);
settextbuf(f,bufin); settextbuf(g,bufout);
citire; Close(f);
sortare_top;
afisare; Close(g);
end.