Cod sursa(job #408442)

Utilizator saodem74hieu tran saodem74 Data 3 martie 2010 02:52:37
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.33 kb
const
  tfi = 'sortaret.in';
  tfo = 'sortaret.out';
  maxn  = 50001;
var
  fi,fo : text;
  n,m,dem : longint;
  free  : array[0..maxn] of boolean;
  f,h : array[0..maxn] of longint;
  ds  : array[1..2,0..maxn*2] of longint;
  ke  : array[0..maxn*10] of longint;
{-------}
procedure nhap;
var
  i,u,v : longint;
begin
  assign(fi,tfi); reset(fi);
  read(fi,n,m);
  for i := 1 to m do
    begin
      read(fi,u,v);
      inc(h[u]);
      ds[1][i] := u; ds[2][i] := v;
    end;
  close(fi);
end;
{-------}
procedure ktao;
var
  i,u,v : longint;
begin
  for i := 1 to n + 1 do h[i] := h[i-1] + h[i];
  for i := 1 to m do
    begin
      u := ds[1][i]; v := ds[2][i];
      ke[h[u]] := v;
      dec(h[u]);
    end;
  fillchar(free,sizeof(free),true);
  dem := n;
end;
{-------}
procedure DFS(u : longint);
var
  i,v : longint;
begin
  free[u] := false;
  for i := h[u] + 1 to h[u+1] do
    begin
      v := ke[i];
      if free[v] then DFS(v);
    end;
  f[u] := dem;
  dec(dem);
end;
{-------}
procedure xuly;
var
  i : longint;
begin
  for i := 1 to n do
    if free[i] then DFS(i);
end;
{-------}
procedure inkq;
var
  i : longint;
begin
  assign(fo,tfo); rewrite(fo);
  for i := 1 to n do write(fo,f[i],' ');
  close(fo);
end;
{-------}
BEGIN
  nhap;
  ktao;
  xuly;
  inkq;
END.