Cod sursa(job #730562)

Utilizator Buzu_Tudor_RoCont vechi Buzu_Tudor_Ro Data 6 aprilie 2012 15:24:30
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.4 kb
Program p1_sortare_dfs;
type lista=^Celula;
     Celula = record
              info:longint;
              next:lista;
              end;
var fi,fo : text;  q,r:lista;  x,y : longint;
    a,v : array[0..500000] of lista;
    b : array[0..500002] of byte;
    i,n,n2 : longint;

Procedure dfs(k:longint);
var r:lista;
begin
    r:=a[k]; write(fo,k,' ');b[k]:=1;
    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;
                     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 begin
                     r:=a[i];
                     while r<>nil do begin
                                     write(fo,r^.info,' ');
                                     r:=r^.next;
                                     end;
                     writeln(fo);
                     end; }

    for i:=1 to n do if b[i]=0 then dfs(i);
    close(fi); close(fo);
end.