Cod sursa(job #271854)

Utilizator philipPhilip philip Data 5 martie 2009 23:49:51
Problema Sortare topologica Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.68 kb
type nod=^pnod;  
     pnod=record  
         inf:longint;  
       adr:nod;  
       end;  
    
  var f,g:text;  
      a,ult:array[1..100000] of nod;  
      viz:array[1..100000] of boolean;  
      timp:array[1..100000] of longint;  
      nou,nou2,p,c,adresa:nod;  
      n,m,i,nr,t: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:=y;  
        if a[x]=nil then begin  
          a[x]:=nou;  
          ult[x]:=a[x];  
        end else begin  
          ult[x]^.adr:=nou;  
          ult[x]:=nou;  
       end;  
      end;  
    end;  
    
  procedure push(i:longint);  
   begin  
      new(c);  
      c^.inf:=i;  
      c^.adr:=adresa;  
     adresa:=c;  
    end;  
    
  procedure dfs(i:longint);  
    var p:nod;  
    begin  
      viz[i]:=true;  
      if a[i]<>nil then begin  
        p:=a[i];  
        while p<>nil do begin  
          if viz[p^.inf]=false then dfs(p^.inf);  
          p:=p^.adr;  
        end;  
      end;  
     push(i);  
    end;  
    
  procedure conexe;  
    begin  
      for i:=1 to n do  
        if not viz[i] then begin  
          nr:=nr+1;  
          dfs(i);  
        end;  
    end;  
    
  procedure afisare;  
    begin  
      assign(g,'sortaret.out');  
      rewrite(g);  
      p:=adresa;  
      while p<>nil do begin  
        write(g,p^.inf,' ');  
        p:=p^.adr;  
      end;  
      close(g);  
    end;  
    
  begin  
    citire;  
    conexe;  
    afisare;  
 end.