Cod sursa(job #408452)

Utilizator hungntnktpHungntnktp hungntnktp Data 3 martie 2010 03:14:21
Problema Sortare topologica Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.42 kb
{DINH QUANG DAT TIN 07-10}
{SORTARET}
CONST
 TFI='sortaret.in';
 TFO='sortaret.out';
 MAX=50001;
TYPE
 arr1int=array[0..MAX] of longint;
 pnode = ^node;
 node = record
         v:longint;
         next:pnode;
        end;
VAR
 fi,fo:text;
 m,n,first,last:longint;
 ke:array[0..MAX] of pnode;
 deg,queue:arr1int;

PROCEDURE       add(u,v:longint);
var
 t:pnode;
begin
 new(t);
 t^.v:=v;
 t^.next:=ke[u];
 ke[u]:=t;
end;

PROCEDURE       input;
var
 i,u,v:longint;
begin
 assign(fi,tfi);reset(fi);
  read(fi,n,m);
  for i:= 1 to m do
   begin
    read(fi,u,v);
    add(u,v);
    inc(deg[v]);
   end;
 close(fi);
end;

PROCEDURE       push(u:longint);
begin
 inc(last);
 queue[last]:=u;
end;

FUNCTION        pop:longint;
begin
 pop:=queue[first];
 inc(first);
end;

PROCEDURE       init;
var
 u:longint;
begin
 last:=0;
 first:=1;
 for u:= 1 to n do
  if deg[u]=0 then push(u);
end;

PROCEDURE       bfs;
var
 u,v:longint;
 t:pnode;
begin
 while first<=last do
  begin
   u:=pop;
   t:=ke[u];
   while t<>nil do
    begin
     v:=t^.v;
     t:=t^.next;
     dec(deg[v]);
     if deg[v]=0 then push(v);
    end;
  end;
end;

PROCEDURE       process;
begin
 bfs;
end;

PROCEDURE       output;
var
 i:longint;
begin
 assign(fo,tfo);rewrite(fo);
  for i:= 1 to n do write(fo,queue[i],' ');
 close(fo);
end;

BEGIN
 input;
 init;
 process;
 output;
END.