Cod sursa(job #557007)

Utilizator gabeekaDobai Gabor gabeeka Data 16 martie 2011 13:42:58
Problema Sortare topologica Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.03 kb
type vek=array[1..10000] of boolean;
     mutato=^elem;
     elem=record
       inf:integer;
       kov:mutato;
      end;
     matr=array[1..10000,1..10000] of byte;
var i,j,k,n,m:integer;
    jart:vek;
    x:matr;
    top:mutato;
    f:text;
procedure push(var top:mutato; x:integer);
 var p:mutato;
  begin
   new(p);
   p^.inf:=x;
   p^.kov:=top;
   top:=p;
  end;
procedure df(k:integer);
 var i:integer;
  begin
   jart[k]:=true;
   for i:= 1 to n do
    if (x[k,i]=1) and (not jart[i])
           then df(i);
   push(top,k);
  end;
procedure kiir(top:mutato);
 var p:mutato;
  begin
   new(p);
   p:=top;
   while p<>nil do
    begin
     write(f,p^.inf,' ');
     p:=p^.kov;
    end;
  end;
begin
 top:=nil;
 assign(f,'sortaret.in');
 reset(f);
 readln(f,n,m);
 for i:= 1 to m do
  begin
   readln(f,j,k);
   x[j,k]:=1;
  end;
 close(f);
 for i:= 1 to n do jart[i]:=false;
 for i:= 1 to n do
  if not(jart[i]) then df(i);
 assign(f,'sortaret.out');
 rewrite(f);
 kiir(top);
 close(f);
end.