Cod sursa(job #592395)

Utilizator elffikkVasile Ermicioi elffikk Data 28 mai 2011 11:34:40
Problema Sortare topologica Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 0.99 kb
var v:array[1..2, 1..100000]of longint;
    visited:array[1..50000] of boolean;
    dep:array[1..50000] of longint;
    a:array[1..50000] of longint;
    n,m,na:longint;

procedure init;
var i:longint; f:text;
begin
  fillchar(a, sizeof(a),0);
  fillchar(dep, sizeof(dep),0);
  assign(f, 'sortaret.in');
  reset(f);
  readln(f,n,m);
  for i:=1 to n do visited[i]:=false;
  for i:=1 to m do
    readln(f, v[1,i], v[2,i]);
  close(f);
end;

procedure sort;
var i,j:longint;
begin
  for j:=1 to m do
    inc(dep[v[2,j]]);
  na:=0;
  while na<n do
  begin
    for i:=1 to n do
      if not visited[i] and (dep[i]=0)
      then begin
        for j:=1 to m do
          if v[1,j]=i then dec(dep[v[2,j]]);
        inc(na);
        a[na]:=i;
        visited[i]:=true;
      end;
  end;
end;

procedure rez;
var i:longint; f:text;
begin
  assign(f,'sortaret.out');
  rewrite(f);
  for i:=1 to na do write(f,a[i],' ');
  close(f);
end;

begin
  init;
  sort;
  rez;
end.