Cod sursa(job #271767)

Utilizator philipPhilip philip Data 5 martie 2009 22:17:39
Problema Sortare topologica Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 2.41 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,in1,in2,jn:nod;
    n,m,i,k,j:longint;

procedure citire;
  var x,y:longint;
      ok:boolean;
  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
        p:=a[y];
        ok:=true;
        while p<>nil do begin
          if p^.inf=x then ok:=false;
          p:=p^.adr;
        end;
        if ok then begin
        ult[y]^.adr:=nou;
        ult[y]:=nou;
        np[y]:=np[y]+1; end;
      end;
    end;
  end;

procedure ordonare;
  begin
    k:=0;

    new(in1);
      in1^.inf:=1;
      new(in2);
      in2:=in1;
      for i:=2 to n do begin
        new(jn);
        jn^.inf:=i;
        in2^.adr:=jn;
        in2:=in2^.adr;
      end;

    while k<n do begin
      in2:=in1;
      while in2<>nil do begin
        i:=in2^.inf;
        if (np[i]=0) and (not viz[i]) then begin
          k:=k+1;
          l[k]:=i;
          viz[i]:=true;
          writeln(l[k]);
          jn:=in1;
          while jn<>nil do begin
            j:=jn^.inf;
            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]) and (a[j]^.inf=i) then begin a[j]:=a[j]^.adr; np[j]:=np[j]-1; end
                 else p^.adr:=p^.adr^.adr; np[j]:=np[j]-1; end; end;
            jn:=jn^.adr;
          end;
          if in2=in1 then in1:=in1^.adr
            else begin
              jn:=in1;
              while jn^.adr<>in2 do jn:=jn^.adr;
              jn^.adr:=in2^.adr;
              in2:=jn;
            end;
        end;
        in2:=in2^.adr;
      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.