Cod sursa(job #1122273)

Utilizator EuBossuletMuntea Andrei EuBossulet Data 25 februarie 2014 17:19:14
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.23 kb
Program topologic;
type lista=^list;
     list=record
        info:longint;
        leg:lista;
     end;
var v:array[1..50000] of lista;
    poz:array[1..50000] of byte;
    n,m,i,x,y,aux:longint;
    p:lista;
    f,q:text;
procedure push(var p:lista; x:longint);
var q,h:lista;
begin
        if p=nil then begin
                new(q);
                q^.leg:=nil;
                q^.info:=x;
                p:=q;
        end
        else begin
                q:=p;
                while q^.leg<>nil do q:=q^.leg;
                new(h);
                h^.leg:=nil;
                h^.info:=x;
                q^.leg:=h;
        end;
end;
procedure parcurgere(p:lista);
begin
        while p<>nil do
        begin
                if poz[p^.info]=0 then begin write(q,p^.info,' '); poz[p^.info]:=1; parcurgere(v[p^.info]); end;
                p:=p^.leg;
        end;
end;
begin
assign(f,'sortaret.in');
reset(f);
assign(q,'sortaret.out');
rewrite(q);
readln(f,n,m);
read(f,aux,y);
push(v[aux],y);
for i:=2 to m do begin read(f,x,y); push(v[x],y); if aux=y then aux:=x; end;
poz[aux]:=1;
write(q,aux,' ');
parcurgere(v[aux]);
for i:=1 to n do if poz[i]=0 then parcurgere(v[i]);
close(f);
close(q);
end.