Cod sursa(job #841971)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 25 decembrie 2012 18:30:17
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.64 kb
program sortaretopologica;
  type tablou=array[1..50000,1..50000] of byte;
       lista=^celula;
       celula=record
                info:longint;
                next:lista;
              end;

  var f:text;
      p,v,r,q:lista;
      n,m,i,x,y:longint;
      a:array [1..50000] of longint;
      t:^tablou;
begin
  assign(f,'sortaret.in');
  reset(f);
  readln(f,n,m);
  for i:=1 to m do
    begin
      readln(f,x,y);
      if t^[x,y]=0 then inc(a[y]);
      t^[x,y]:=1;
    end;
  new(p);
  i:=1;
  while a[i]<>0 do inc(i);
  p^.info:=i;
  p^.next:=nil;
  v:=p;
  inc(i);
  while i<=n do
    begin
      if a[i]=0 then begin
                     new(r);
                     r^.info:=i;
                     r^.next:=nil;
                     v^.next:=r;
                     v:=r;
                   end;
      inc(i);
    end;
  close(f);
  assign(f,'sortaret.out');
  rewrite(f);
  while p<>nil do
    begin
      write(f,p^.info,' ');
      for i:=1 to n do
        if t^[p^.info,i]=1 then
                            begin
                              t^[p^.info,i]:=0;
                              dec(a[i]);
                              if a[i]=0 then
                                          begin
                                            new(r);
                                            r^.info:=i;
                                            r^.next:=nil;
                                            v^.next:=r;
                                            v:=r;
                                          end;
                            end;
      p:=p^.next;
    end;
  close(f);
end.