Cod sursa(job #271847)

Utilizator philipPhilip philip Data 5 martie 2009 23:44:50
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.57 kb
 type nod=^pnod;  
      pnod=record  
        inflongint;  
        adrnod;  
      end;  
   
 var f,gtext;  
     a,ultarray[1..100000] of nod;  
     vizarray[1..100000] of boolean;  
     timparray[1..100000] of longint;  
     nou,nou2,p,c,adresanod;  
     n,m,i,nr,tlongint;  
   
 procedure citire;  
   var x,ylongint;  
   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(ilongint);  
   begin  
     new(c);  
     c^.inf=i;  
     c^.adr=adresa;  
     adresa=c;  
   end;  
   
 procedure dfs(ilongint);  
   var pnod;  
   begin  
     viz[i]=true;  
     if a[i]nil then begin  
       p=a[i];  
       while pnil 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 pnil do begin  
       write(g,p^.inf,' ');  
       p=p^.adr;  
     end;  
     close(g);  
   end;  
   
 begin  
   citire;  
   conexe;  
   afisare;  
 end.