Cod sursa(job #579700)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 12 aprilie 2011 13:22:16
Problema Componente tare conexe Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.19 kb
type muchie=^nod;
     nod=record n:longint; a:muchie; end;

var v, t:array [1.. 100000] of muchie;  {v-graful t-graful transpus}
    s1:array [1.. 100000] of longint;   {stiva cu timpii de parcurgere DFS}
    s2:array[1..100000] of muchie;      {stiva finala si raspunsul}
    chk:array[1..100000] of boolean;    {pentru DFS}
    buf1, buf2:array [1.. 1 shl 17] of char; {Reduce timpul de citire}
    n, m, i, x, y, s1t, s2t:longint;    {s1t - lungimea curenta pentru s1}
    p:muchie;                           {s2t - numarul te componente conexe}
    f, g:text;

//parcurgerea in latime si formarea stivei cu timpii finali
procedure dfs(a:muchie; c:longint);
  begin
  chk[c]:=true;
  while a <> nil do
    begin
    if chk[a^.n] = false then dfs(v[a^.n], a^.n);
    a:=a^.a;
    end;
  inc(s1t); s1[s1t]:=c;
  end;

// Parcurgerea pe graful transpus
procedure dfst(a:muchie; c:longint);
  begin
  chk[c]:=false;
  while a <> nil do
    begin
    if chk[a^.n] = true then
      begin
      new(p); p^.n:=a^.n; p^.a:=s2[s2t]; s2[s2t]:=p;
      dfst(t[a^.n], a^.n);
      end;
    a:=a^.a;
    end;
  end;

begin
assign (f, 'ctc.in'); settextbuf (f, buf1); reset (f);
assign (g, 'ctc.out'); settextbuf(f, buf2); rewrite (g);

readln (f, n, m);
for i := 1 to m do
  begin
  read (f, x, y);
  if v[x]= nil then begin new(v[x]); v[x]^.a:=nil; v[x]^.n:=y; end
               else begin new (p); p^.n:=y; p^.a:=v[x]; v[x]:=p; end;

  if t[y]= nil then begin new(t[y]); t[y]^.a:=nil; t[y]^.n:=x; end
               else begin new (p); p^.n:=x; p^.a:=t[y]; t[y]:=p; end;
  end;

// Prima parcurgere
for i := 1 to n do
  begin
  if chk[i] = false then dfs(v[i], i);
  end;

// Parcurgerea pe graful transpus si retinerea componentelor tare conexe
// ca liste de adiacenta pentru a salva memorie
for i := n downto 1 do
  begin
  if chk[s1[i]]=true then
    begin
    inc(s2t); new(s2[s2t]); s2[s2t]^.n:=s1[i]; s2[s2t]^.a:=nil;
    dfst(t[s1[i]], s1[i]);
    end;
  end;

// Afisarea
writeln (g, s2t);
for i := 1 to s2t do
  begin
  p:=s2[i];
  while p<> nil do
    begin
    write (g, p^.n, ' ');
    p:=p^.a;
    end;
  writeln (g);
  end;

close (f); close (g);
end.