Cod sursa(job #841871)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 25 decembrie 2012 12:07:58
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.15 kb
program sortaretopologica;
  type 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 byte;
begin
  assign(f,'sortaret.in');
  reset(f);
  readln(f,n,m);
  readln(f,x,y);
  new(p);
  p^.info:=x;
  new(v);
  p^.next:=v;
  v^.info:=y;
  v^.next:=nil;
  a[x]:=1;a[y]:=1;
  for i:=2 to m do
    begin
      readln(f,x,y);
      if a[x]<>1 then
                     begin
                       new(q);
                       q^.info:=x;
                       q^.next:=nil;
                       v^.next:=q;
                       v:=q;a[x]:=1;
                     end;

      if a[y]<>1 then
                   begin
                     new(q);
                     q^.info:=y;
                     q^.next:=nil;
                     v^.next:=q;
                     v:=q;a[y]:=1;
                   end

    end;
  close(f);
  assign(f,'sortaret.out');
  rewrite(f);
  r:=p;
  while r<>nil do
    begin
      write(f,r^.info,' ');
      r:=r^.next;
    end;
  close(f);
end.