Cod sursa(job #161440)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 18 martie 2008 08:41:21
Problema Sortare topologica Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.53 kb
program sort;
type pnod = ^nod;
      nod = record
                info : integer;
                urm : pnod;
                end;
     vect = record
            sir,ultim : pnod;
            cont : longint;
            nr : shortint;
            end;
var A : array [1..50000] of vect;
    n,i,x,y : word;
    j,m : longint;
    f,g : text;
    ok : boolean;
procedure add(x,y:integer);
var urm : pnod;
begin
if A[x].nr = 0 then begin
                    new(A[x].sir);
                    A[x].sir^.info := y;
                    A[x].sir^.urm := nil;
                    A[x].ultim := A[x].sir;
                    inc(A[x].nr);
                    inc(A[y].cont);
                    end
else begin
        new(urm);
        urm^.info := y;
        urm^.urm := nil;
        A[x].ultim^.urm := urm;
        A[x].ultim := urm;
        inc(A[y].cont);
        end;



end;


procedure actualizare(x:integer);
var l : word;
begin

A[x].cont := -1;

while A[x].sir <> nil do begin
dec(A[A[x].sir^.info].cont);
A[x].sir := A[x].sir^.urm;
end;


write(g,x,' ');


end;

begin
assign(f,'sortaret.in');
reset(f);
assign(g,'sortaret.out');
rewrite(g);


readln(f,n,m);

for i := 1 to n do begin
A[i].nr := 0;
A[i].cont := 0;
end;


for j := 1 to m do begin
readln(f,x,y);
add(x,y);
end;



repeat
ok := true;
for i := 1 to n do
if A[i].cont=0 then begin
                actualizare(i);
                ok := false;
                end;

until ok;

close(f);
close(g);

end.