Cod sursa(job #153842)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 10 martie 2008 19:23:11
Problema Sortare topologica Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.81 kb
{sortare antropologica}
var v,t,c1,c2,z,o,h:array[1..100000]of longint;
    n,i,j,k,p,m:longint;
    f:text;
procedure merge(p,r:longint);
var q,c,d,e,w:longint;
begin
   q:=(p+r)DIV 2;
   if p<q then merge(p,q);
   if q+1<r then merge(q+1,r);
   for w:=p to r do
   begin
   z[w]:=c1[w];
   o[w]:=c2[w];
   end;
   e:=p;
   c:=p;
   d:=q+1;
   while(c<=q)and(d<=r)do
   if o[c]<o[d] then begin c2[e]:=o[c];
                           c1[e]:=z[c];
                           c:=c+1;
                           e:=e+1;
                     end
                else begin c2[e]:=o[d];
                           c1[e]:=z[d];
                           d:=d+1;
                           e:=e+1;
                     end;
   while(c<=q)do
   begin
   c2[e]:=o[c];
   c1[e]:=z[c];
   c:=c+1;
   e:=e+1;
   end;
   while(d<=r)do
   begin
   c2[e]:=o[d];
   c1[e]:=z[d];
   d:=d+1;
   e:=e+1;
   end;
end;
begin
   assign(f,'sortaret.in');
   reset(f);
   read(f,n,m);
   for i:=1 to m do
   begin
   read(f,c1[i],c2[i]);
   h[c1[i]]:=h[c1[i]]+1;
   end;
   close(f);
   merge(1,m);
   p:=n+1;
   for i:=1 to m do
   o[i]:=0;
   for i:=1 to m do
   if c2[i]<>c2[i-1] then begin v[c2[i]]:=i;
                                t[c2[i]]:=1;
                          end
                     else t[c2[i]]:=t[c2[i]]+1;
   for i:=n downto 1 do
   if h[i]=0 then begin p:=p-1;
                        o[p]:=i;
                  end;
   for i:=n downto 1 do
   begin
   for j:=v[o[i]] to v[o[i]]+t[o[i]]-1 do
   begin
   h[c1[j]]:=h[c1[j]]-1;
   if h[c1[j]]=0 then begin p:=p-1;
                            o[p]:=c1[j];
                      end;
   end;
   end;
   assign(f,'sortaret.out');
   rewrite(f);
   for i:=1 to n do
   write(f,o[i],' ');
   writeln(f);
   close(f);
end.