Cod sursa(job #841863)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 25 decembrie 2012 11:47:02
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.31 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;
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;
  for i:=2 to m do
    begin
      readln(f,x,y);
      r:=p;
      while (r^.info<>x) and (r^.next<>nil) do r:=r^.next;
      if r^.info=x then
                     begin
                       new(q);
                       q^.info:=y;
                       q^.next:=r^.next;
                       r^.next:=q;
                     end
                   else
                     begin
                       new(q);
                       q^.info:=x;
                       q^.next:=nil;
                       v^.next:=q;
                       v:=q;
                       new(q);
                       q^.info:=y;
                       q^.next:=nil;
                       v^.next:=q;
                       v:=q;
                     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.