Cod sursa(job #735900)

Utilizator Buzu_Tudor_RoCont vechi Buzu_Tudor_Ro Data 17 aprilie 2012 14:48:38
Problema Sortare topologica Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.97 kb
Program Topologic_sortare;
type lista=^celula;
     celula=record
            info:longint;
            next:lista;
            end;
var fi,fo : text;  q:lista; x,y,nivel : longint;
    a : array[0..50005] of lista;
    b,d : array[0..50005] of longint;
    i,n,n2 : longint;

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

Procedure swap(var a,b:longint);
var aux:longint;
begin
    aux:=a; a:=b; b:=aux;
end;

Procedure quick(left,right:longint);
var mijl,i,j:longint;
begin
    mijl:=b[(left+right) div 2];
    i:=left;
    j:=right;

    while i<j do begin
                 while b[i]<mijl do i:=i+1;
                 while b[j]>mijl do j:=j-1;
                 if i<=j then begin
                              swap(b[i],b[j]);
                              swap(d[i],d[j]);
                              i:=i+1;
                              j:=j-1;
                              end;
    end;

    if i<right then quick(i,right);
    if left<j then quick(left,j);

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 a[i]:=nil; b[i]:=0; d[i]:=i; end;

    for i:=1 to n2 do begin
                      readln(fi,x,y);
                      new(q);
                      q^.info:=y; q^.next:=a[x]; a[x]:=q;
                      end;


    for i:=1 to n do if (b[i]=0) then begin
                                      nivel:=0;
                                      dfs(i);
                                      end;

    quick(1,n);
    for i:=1 to n do write(fo,d[i],' ');

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