Cod sursa(job #147648)

Utilizator ProtomanAndrei Purice Protoman Data 3 martie 2008 12:28:06
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.21 kb
type point=^nod;
     nod=record
         nr:longint;
         ua:point;
     end;

var f1,f2:text;
    i,n,m,t,f:longint;
    np,s:array[0..50010] of shortint;
    l:array[0..50010] of point;
    lf:point;

procedure dfs(nod:longint);
var p:point;
begin
        s[nod]:=1;
        while l[nod]<>nil do
        begin
                dfs(l[nod]^.nr);
                l[nod]:=l[nod]^.ua;
        end;
        new(p);
        p^.nr:=nod;
        p^.ua:=lf;
        lf:=p;
end;

procedure clad(t,f:longint);
var p:point;
begin
        new(p);
        p^.nr:=f;
        p^.ua:=l[t];
        l[t]:=p;
end;

begin
        assign(f1,'sortaret.in');
        reset(f1);
        assign(f2,'sortaret.out');
        rewrite(f2);
        read(f1,n,m);
        for i:=1 to m do
        begin
                read(f1,t,f);
                clad(t,f);
                inc(np[f]);
        end;
        for i:=1 to n do
                if (s[i]=0)and(np[i]=0) then
                        dfs(i);
        write(f2,lf^.nr);
        lf:=lf^.ua;
        while lf<>nil do
        begin
                write(f2,' ',lf^.nr);
                lf:=lf^.ua;
        end;
        close(f1);
        close(f2);
end.