Cod sursa(job #271703)

Utilizator philipPhilip philip Data 5 martie 2009 20:38:29
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.57 kb
type nod=^pnod;
     pnod=record
       inf:longint;
       adr:nod;
     end;

var f,g:text;
    a,ult:array[1..50000] of nod;
    viz:array[1..50000] of boolean;
    np,l:array[1..50000] of longint;
    nou,nou2,p:nod;
    n,m,i,k,j:longint;

procedure citire;
  var x,y:longint;
  begin
    assign(f,'sortaret.in');
    reset(f);
    readln(f,n,m);
    for i:=1 to m do begin
      readln(f,x,y);
      new(nou);
      nou^.inf:=x;
      if a[y]=nil then begin
        a[y]:=nou;
        ult[y]:=a[y];
        np[y]:=1;
      end else begin
        ult[y]^.adr:=nou;
        ult[y]:=nou;
        np[y]:=np[y]+1;
      end;
    end;
  end;

procedure ordonare;
  begin
    k:=0;
    while k<n do
      for i:=1 to n do
        if (np[i]=0) and (not viz[i]) then begin
          k:=k+1;
          l[k]:=i;
          viz[i]:=true;
          for j:=1 to n do begin
            p:=a[j];
            if a[j]<>nil then
              if a[j]^.inf=i then
                begin a[j]:=a[j]^.adr; np[j]:=np[j]-1; end
          else begin  p:=a[j];
            if p<>nil then
              while (p^.adr<>nil) and (p^.adr^.inf<>i) do p:=p^.adr;
            if p<>nil then
             if p^.adr<>nil then begin
               if p=a[j] then a[j]:=a[j]^.adr
                 else p^.adr:=p^.adr^.adr; np[j]:=np[j]-1; end; end;
          end;
        end;
  end;

procedure afisare;
  begin
    assign(g,'sortaret.out');
    rewrite(g);
    for i:=1 to n do write(g,l[i],' ');
    close(g);

  end;

begin
  citire;
  ordonare;
  afisare;
end.