Cod sursa(job #271836)

Utilizator philipPhilip philip Data 5 martie 2009 23:34:25
Problema Sortare topologica Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.37 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.