Nu aveti permisiuni pentru a descarca fisierul grader_test19.ok
Cod sursa(job #153535)
Utilizator | Data | 10 martie 2008 16:38:02 | |
---|---|---|---|
Problema | Sortare topologica | Scor | 100 |
Compilator | fpc | Status | done |
Runda | Arhiva educationala | Marime | 1.65 kb |
program Sortare_topologica;
type nod=^ref;
ref=record
info:word;
urm:nod;
end;
var prim,c:array[1..50001]of nod;
q:array[1..50001]of word;
deg:array[1..50001]of Longint;
n,m,nr:longint;
f:text;
procedure add(what,where:word);
var p:nod;
begin
new(p);
p^.info:=what;
p^.urm:=nil;
if prim[where]=nil then begin
prim[where]:=p;
c[where]:=p;
end
else begin
c[where]^.urm:=p;
c[where]:=p;
end;
end;
procedure citeste;
var i,j,k:Longint;
begin
assign(f,'sortaret.in');reset(f);
readln(f,n,m);
for i:=1 to n do begin
prim[i]:=nil;
deg[i]:=0;
end;
for i:=1 to m do begin
readln(f,j,k);
add(k,j);
inc(deg[k]);
end;
close(f);
end;
procedure sort_topo;
var i:word;
p:nod;
begin
nr:=0;
for i:=1 to n do
if deg[i]=0 then begin
inc(nr);
q[nr]:=i;
end;
for i:=1 to n do
begin
p:=prim[q[i]];
while (p<>nil) do begin
dec(deg[p^.info]);
if deg[p^.info]=0 then begin
inc(nr);
q[nr]:=p^.info;
end;
p:=p^.urm;
end;
end;
assign(f,'sortaret.out');rewrite(f);
for i:=1 to n do write(f,q[i],' ');
close(f);
end;
begin
citeste;
sort_topo;
end.