Cod sursa(job #708642)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 7 martie 2012 00:14:07
Problema Sortare topologica Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.25 kb
Program sortaret;
 type lista=^celula;
      celula=record
              inf:longint;
              next:lista;
              end;
var a,st:array [1..50001] of lista;
    b:array [1..50001] of byte;
    b1:array [1..1 shl 15] of char;
    v:lista;
    i,n,m,p,x,y,l:longint;
    fi,fo:text;
procedure dfs(k:longint);
 var r:lista;
begin
 r:=a[k]; b[k]:=1;
 while r<>nil do begin
                if b[r^.inf]=0 then begin
                                     new(v);
                                      v^.inf:=r^.inf; v^.next:=st[l]; st[l]:=v;
                                     dfs(r^.inf);
                                     end;
                   r:=r^.next;
                 end;
end;
procedure scrie(k:lista);
 begin
  if k^.next<>nil then scrie(k^.next);
   write(fo,k^.inf,' ');
end;
begin
 assign(fi,'sortaret.in');
  assign(fo,'sortaret.out');
 settextbuf(fi,b1);
 reset(fi); rewrite(fo);
  readln(fi,n,m);
 for i:=1 to m do begin
                   readln(fi,x,y);
                    new(v);
                   v^.inf:=y; v^.next:=a[x]; a[x]:=v;
                   end;
 for i:=1 to n do
  if b[i]=0 then begin inc(l); new(v); v^.inf:=i; st[l]:=v; dfs(i); end;
 for i:=l downto 1 do scrie(st[i]);
 close(fo);
end.