Cod sursa(job #735548)

Utilizator Buzu_Tudor_RoCont vechi Buzu_Tudor_Ro Data 16 aprilie 2012 19:10:10
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.38 kb
Program Topologic_sortare;
type lista=^celula;
     celula=record
            info:longint;
            next:lista;
            end;
var fi,fo : text;  q:lista; x,y : longint;
    a,v : array[0..500000] of lista;
    b,d : array[0..500000] of longint;
    i,n,n2 : longint;

Procedure dfs(k:longint);
var r:lista;
begin
    r:=a[k];     b[k]:=1; write(fo,k,' ');
    while r<>nil do begin
                    if b[r^.info]=0 then dfs(r^.info);
                    r:=r^.next;
                    end;
end;

begin
    assign(fi,'sortaret.in'); reset(fi); readln(fi,n,n2);
    assign(fo,'sortaret.out'); rewrite(fo);
    for i:=1 to n do begin
                     new(v[i]); new(a[i]);
                     v[i]^.info:=i;
                     a[i]:=v[i];
                     b[i]:=0;
                     end;

    for i:=1 to n2 do begin
                      new(q);
                      readln(fi,x,y);
                      q^.info:=y;
                      q^.next:=nil;
                      d[x]:=1;
                      if v[x]=nil then v[x]:=q
                                  else begin
                                       v[x]^.next:=q;
                                       v[x]:=q;
                                       end;
                      end;


    for i:=1 to n do if (b[i]=0) and (d[i]=1) then dfs(i);

    close(fi); close(fo);
end.