Cod sursa(job #559862)

Utilizator killerkaliKovacs Levente killerkali Data 18 martie 2011 10:26:06
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.17 kb
type vek=array[1..50000] of boolean;
     mutato=^elem;
     elem=record
       inf:longint;
       kov:mutato;
      end;
       matr=array[1..50000,1..50000] of longint;
    var i,j,k,n,m:longint;
      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.