Cod sursa(job #328451)

Utilizator levap1506Gutu Pavel levap1506 Data 2 iulie 2009 10:13:35
Problema Potrivirea sirurilor Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.3 kb
program topsort;
 type list=^cell;
    cell=record
     v:word;
     next:list;
     end;
 var a,b:text;
  i,j,k,xi,n,m:longint;
  r:list;
  z,x:array[1..50000] of longint;
  rec:array[1..50000] of list;
  procedure proceed(r:list);
   begin
     repeat
      dec(z[r^.v]);
      if z[r^.v]=0 then begin inc(xi); x[xi]:=r^.v; if rec[r^.v]<>nil then proceed(rec[r^.v]); end;
      r:=r^.next;
     until r=nil;
   end;
  procedure insert(i,j:word);
   var r:list;
   begin
    r:=rec[j];
    if r=nil then
    begin
     new(rec[j]);
     r:=rec[j];
     r^.v:=i;
     r^.next:=nil;
     exit;
    end else
     while r^.next<>nil do
      r:=r^.next;
    new(r^.next);
    r:=r^.next;
    r^.v:=i;
    r^.next:=nil;
   end;
  begin
   assign(a,'sortaret.in');
   assign(b,'sortaret.out');
   reset(a);
   rewrite(b);
   Readln(a,n,m);
        for i:=1 to n do
      rec[i]:=nil;
   for i:=1 to m do
    begin
     Readln(a,j,k);
     inc(z[k]);
     insert(k,j);
    end;
    for i:=1 to n do
     if z[i]=0 then
       begin
         inc(xi);
         x[xi]:=i;
       end;

   for i:=1 to n do
   if rec[x[i]]=nil then continue else
    begin
      r:=rec[x[i]];
      proceed(r);

    end;
   for i:=1 to xi do
    Write(b,x[i],' ');
    close(B);

  end.