Cod sursa(job #1374760)

Utilizator mirelabocsabocsa mirela mirelabocsa Data 5 martie 2015 10:41:03
Problema Sortare topologica Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.96 kb
program mire;
var a:array of array of longint;
    v:array of longint;
    viz:array of 0..1;
    n,m,nr,i,j:longint;
    f,g:text;
procedure citire;
var i,x,y:longint;
begin
  assign(f,'sortaret.in'); reset(f);
    readln(f,n,m);
    setlength(v,n+1);
    setlength(viz,n+1);
    setlength(a,n+1,1);
    for i:=1 to m do
      begin
         readln(f,x,y);
         inc(a[x,0]);
         setlength(a[x],a[x,0]+1);
         a[x,a[x,0]]:=y;
      end;
  close(f);
end;
procedure sort(nod:longint);
var i:longint;
begin
  viz[nod]:=1;
  for i:=1 to a[nod,0] do
    if viz[a[nod,i]]=0 then
      sort(a[nod,i]);
    inc(nr);
    v[nr]:=nod;
end;
begin
  citire;
  nr:=0;
  for i:=1 to n do
  begin
    for j:=0 to a[i,0] do
      write(a[i,j],' ');
      writeln;
   end;
  for i:=1 to n do
    if viz[i]=0 then
      sort(i);
    assign(g,'sortaret.out'); rewrite(g);
      for i:=nr downto 1 do
        write(g,v[i],' ');
    close(g);
end.