Cod sursa(job #1598045)

Utilizator VandheerManPopescu Alin VandheerMan Data 12 februarie 2016 16:19:28
Problema Sortare topologica Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.48 kb
type
 ref=^coada;
 coada=record
        inf:integer;
        adru:ref;
        end;
 vec=array[1..50000]of ref;
 vec1=array[1..50001] of longint;

var
g:vec; deg,q:vec1; v:vec;
c:ref;
a,b,n,m,i,con,x:integer;
f:text;

begin
 assign(f,'sortaret.in');
 reset(f);
 read(f,n,m);
 while (not(eof(f))) do
        begin
         read(f,a,b);
         inc(deg[b]);
         if (assigned(g[a])=false) then
                begin
                 new(c);
                 c^.inf:=b;
                 g[a]:=c;  v[a]:=c;
                end
         else
          begin
           new(c);
           c^.inf:=b;
           v[a]^.adru:=c;
           v[a]:=c;
           end;
        end;
 close(f);
 con:=0;
 for i:=1 to n do if (deg[i]=0) then
        begin
         con:=con+1;
         q[con]:=i;
        end;
 for i:=1 to n do
        begin
          x:=q[i];
          c:=g[x];
          while (c<>nil) do
          begin
           deg[c^.inf]:=deg[c^.inf]-1;
           if (deg[c^.inf]=0) then
           begin
            inc(con);
            q[con]:=c^.inf;
           end;
           c:=c^.adru;
          end;
        end;
   for i:=1 to n do
        begin
         c:=g[i];
          while(c<>nil) do
                begin
                 write(c^.inf,' ');
                 c:=c^.adru;
                 end;
          writeln(' z',i);
         end;
assign(f,'sortaret.out');
rewrite(f);
for i:=1 to n do write(f,q[i],' ');
close(f);
end.