Cod sursa(job #543470)

Utilizator david93Demeny David david93 Data 28 februarie 2011 08:45:34
Problema Sortare topologica Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.03 kb
uses crt;
type
mut=^elem;
elem=record
a:integer;
k:mut;
end;
op2=array[1..5000]of mut;
kl=array[1..5000] of boolean;
op=array[1..5000]of integer;
var
 i,m,n,a,b,c,d:integer;
 f,g:text;
 j:kl;
 v:op2;
 v2:op;
 p:mut;
procedure lep(a:integer);
var i:integer;
 p:mut;
begin
 j[a]:=true;
 p:=v[a];
 while p<>nil do
    begin
     if not(j[p^.a])
      then lep(p^.a);
     p:=p^.k;
    end;
 inc(d);
 v2[d]:=a;
end;
begin
 assign(f,'sortaret.in');
 reset(f);
 assign(g,'sortaret.out');
 rewrite(g);
 readln(f,n,m);
 for i:=1 to m do
   begin
     readln(f,a,b);
     if v[a]<>nil
      then
       begin
        new(p);
        p^.k:=v[a]^.k;
        v[a]^.k:=p;
        p^.a:=b;
       end
      else
       begin
        new(v[a]);
        v[a]^.a:=b;
        v[a]^.k:=nil;
       end;
   end;
 d:=0;
 for i:=1 to n do
  j[i]:=false;
 for i:=1 to n do
   if not(j[i])
    then
     begin
      lep(i);
     end;
 for i:=n downto 1   do
  write(g,v2[i],' ');
 close(f);
 close(g);
end.