Cod sursa(job #713062)

Utilizator amaliutzzaGoia Amalia amaliutzza Data 14 martie 2012 10:24:36
Problema Componente biconexe Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 2.35 kb
type pnod=^nod;
     nod=record inf:longint; urm:pnod; end;
     much=record s, d:longint; end;

var l:array[1..100000] of pnod;
    st:array[1..200000] of much;
    lowest, niveldf:array[1..100000] of longint;
    sol:array[1..100000] of pnod;
    viz:array [1..100000] of boolean;
    i, j, n, m, x, y, muchiidf, nrcomp:longint;
    p:pnod;
    f, g:text;
    buf1, buf2:array [1.. 1 shl 17] of char;

  function min(fx, fy:longint):longint; begin if fx<fy then min:=fx else min :=fy; end;

  procedure dfs (nod, niv, tata:longint);
  var p:pnod;
  begin

    viz[nod]:=true;
    niveldf[nod]:=niv;
    lowest[nod]:=niv;

    p:=l[nod];

    while p<>nil do
      begin
        if viz[p^.inf]=false then //daca nu e muchie de intoarcere
          begin

            inc(muchiidf);
            st[muchiidf].s:=nod; st[muchiidf].d:=p^.inf;

            dfs (p^.inf, niv+1, nod);


            if niveldf[nod]<=lowest[p^.inf] then //am gasit un nod critic
              begin
                inc(nrcomp);
                while (muchiidf>0) and
                      (st[muchiidf].s<>nod) and (st[muchiidf].d<>nod) do
                  begin
                    new(p); p^.inf:=st[muchiidf].d; p^.urm:=sol[nrcomp]; sol[nrcomp]:=p;
                    dec (muchiidf);
                  end;
                new(p); p^.inf:=st[muchiidf].d; p^.urm:=sol[nrcomp]; sol[nrcomp]:=p;
                new(p); p^.inf:=st[muchiidf].s; p^.urm:=sol[nrcomp]; sol[nrcomp]:=p;
                dec (muchiidf);
              end;

            lowest[nod]:=min(lowest[nod], lowest[p^.inf]);

           end
             else
                 if p^.inf<>tata then
                   lowest[nod]:=min(lowest[nod], lowest[p^.inf]);
         p:=p^.urm;
       end;
  end;

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

 read (f, n, m);
 for i := 1 to m do
  begin
    read (f, x, y);
    new (p); p^.inf:=y; p^.urm:=l[x]; l[x]:=p;
    new (p); p^.inf:=x; p^.urm:=l[y]; l[y]:=p;
  end;

 for i := 1 to n do if viz[i]=false then dfs(i, 1, 0);

 writeln (g, nrcomp);
 for i := 1 to nrcomp do
  begin
    p:=sol[i];
    while p <> nil do
     begin
      write (g, p^.inf, ' ');
      p:=p^.urm;
     end;
    writeln (g);
  end;


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