Cod sursa(job #247641)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 23 ianuarie 2009 16:37:13
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.33 kb
// Arhiva Educationala - Sortare Topologica

type    adresa          = ^nod;
        nod             = record inf : word; adr : adresa; end;

var     n,m,x,y,i, count: longint;
        f               : text;
        q               : adresa;
        p               : array [1..50000] of adresa;
        grad, uz, a     : array [1..50000] of word;

procedure       df      (k:word);
var             q       : adresa;
begin
q       := p[k];
while   (q <> nil)      do
        begin
        if (uz[q^.inf] > 0)  then
                begin
                dec     (uz[q^.inf]);
                if      (uz[q^.inf] = 0)     then
                        begin
                        df      (q^.inf) ;
                        end;
                end;
        q       := q^.adr
        end;
inc     (count);
a[count]:= k;
end;

begin
assign  (f,'sortaret.in');
reset   (f);
readln  (f, n, m);
count   := 0;
for i := 1  to m do
        begin
        readln  (f, x, y);
        new     (q);
        q^.inf  := y;
        q^.adr  := p[x];
        p[x]    := q;
        inc     (grad[y]);
        inc     (uz[y]);
        end;
close   (f);

for i := 1 to n do
    if (grad[i]=0) then
        df(i);
assign  (f, 'sortaret.out');
rewrite (f);
for i:= n downto 1 do
        write(f, a[i],' ');
close   (f);
end.