Cod sursa(job #271593)

Utilizator philipPhilip philip Data 5 martie 2009 16:29:18
Problema Componente tare conexe Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.16 kb
type nod=^pnod;
     pnod=record
       inf:longint;
       adr:nod;
     end;

var f,g:text;
    a,a2,ult2,ult:array[1..100000] of nod;
    viz,v:array[1..100000] of boolean;
    timp,ord:array[1..100000] of longint;
    nou,nou2,p:nod;
    t,n,m,i,j,k,nr:longint;

procedure citire;
  var x,y:longint;
  begin
    assign(f,'dfs.in');
    reset(f);
    readln(f,n,m);
    for i:=1 to m do begin
      readln(f,x,y);
      new(nou);
      nou^.inf:=y;
      new(nou2);
      nou2^.inf:=x;
      if a2[y]=nil then begin
        a2[y]:=nou2;
        ult2[y]:=a2[y];
      end else begin
        ult2[y]^.adr:=nou2;
        ult2[y]:=nou2;
      end;
      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;
    m:=0;
  end;

procedure dfmin(k:longint);
  var p:nod;
  begin
    viz[k]:=true;
    if a[k]<>nil then begin
      p:=a[k];
      while p<>nil do begin
        if not viz[p^.inf] then begin
          dfmin(p^.inf);
        end;
        p:=p^.adr;
      end;
    end;
    t:=t+1;
    timp[k]:=t;
  end;

procedure df(k:longint);
  var p:nod;
  begin
    viz[k]:=true;
    j:=j+1;
    m:=m+1;
    timp[j]:=k;
    if a2[k]<>nil then begin
      p:=a2[k];
      while p<>nil do begin
        if not viz[p^.inf] then begin
          df(p^.inf);
        end;
        p:=p^.adr;
      end;
    end;
  end;

procedure tareconexe;
  begin
    nr:=0; t:=0;
    for i:=1 to n do
      if not viz[i] then dfmin(i);
    for i:=1 to n do begin
      viz[i]:=false;
      k:=timp[i];
      ord[n-k+1]:=i;
    end;
    for i:=1 to n do begin
      k:=ord[i];
      if not viz[k] then begin
        nr:=nr+1;
        df(k);
        ord[nr]:=m;
        m:=0;
      end;
    end;
  end;

procedure afisare;
  begin
    assign(g,'dfs.out');
    rewrite(g);
    writeln(g,nr);
    k:=0;
    for i:=1 to nr do begin
      for j:=1 to ord[i] do begin
        inc(k);
        write(g,timp[k],' ');
      end;
      writeln(g);
    end;
    close(g);
  end;

begin
  citire;
  tareconexe;
  afisare;
end.