Cod sursa(job #708649)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 7 martie 2012 00:33:09
Problema Sortare topologica Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.64 kb
Program sortaret;
 type lista=^celula;
      celula=record
              inf:longint;
              next:lista;
              end;
      tip=record
           val,pos:longint;
           end;
var a:array [1..50001] of lista;
    st:array [1..50001] of tip;
    b:array [1..50001] of byte;
    b1:array [1..1 shl 15] of char;
    v:lista;
    i,n,m,p,x,y,l:longint;
    fi,fo:text;
procedure dfs(k:longint);
 var r:lista;
begin
 r:=a[k]; inc(l);
 while r<>nil do begin
                if st[r^.inf].val<l then begin
                                     st[r^.inf].val:=l;
                                      dfs(r^.inf);
                                     end;
                   r:=r^.next;
                 end;
end;
procedure sort(l,r:longint);
 var k,i,j:longint;
      y:tip;
 begin
  i:=l; j:=r;
   k:=st[(l+r) div 2].val;
 repeat
  while st[i].val<k do inc(I);
   while st[j].val>k do dec(j);
 if i<=j then
              begin
               y:=st[i];
                st[i]:=st[j];
                  st[j]:=y;
                     inc(i); dec(j);
              end;
 until i>=j;
  if l<j then sort(l,j);
   if i<r then sort(i,r);
 end;
begin
 assign(fi,'sortaret.in');
  assign(fo,'sortaret.out');
 settextbuf(fi,b1);
 reset(fi); rewrite(fo);
  readln(fi,n,m);
 for i:=1 to m do begin
                   readln(fi,x,y);
                    new(v);
                   v^.inf:=y; v^.next:=a[x]; a[x]:=v;
                   end;
 for i:=1 to n do begin st[i].pos:=i;
  if st[i].val=0 then begin l:=0; dfs(i); end;
                  end;
 sort(1,n);
 for i:=1 to n do write(fo,st[i].pos,' ');
 close(fo);
end.