Cod sursa(job #384370)

Utilizator philipPhilip philip Data 19 ianuarie 2010 22:40:01
Problema Componente biconexe Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.26 kb
type pmuchie=^muchie;
     muchie=record
       inf:longint;
       adr:pmuchie;
     end;

var n,m,i,x,y,aux,k:longint;
    nou,comp,noduri,nou2:pmuchie;
    v:array[0..100005] of pmuchie;
    viz,bagat:array[0..100005] of boolean;
    niv:array[0..100005] of longint;
    c:array[0..100005] of pmuchie;


procedure baga(x:longint);
  begin
    if bagat[x] then exit;
    bagat[x]:=true;
    new(nou2);
    nou2^.inf:=x;
    nou2^.adr:=c[k];
    c[k]:=nou2;
  end;

procedure scriecomp(x:longint);
  begin
    k:=k+1;
    while noduri^.inf<>x do begin
      baga(noduri^.inf);
      noduri:=noduri^.adr;
    end;
    baga(noduri^.inf);
    comp:=c[k];
    while comp<>nil do begin
      bagat[comp^.inf]:=false;
      comp:=comp^.adr;
    end;
  end;


procedure adauga(x:longint);
  begin
     new(nou2);
     nou2^.inf:=x;
     nou2^.adr:=noduri;
     noduri:=nou2;
  end;


procedure dfs(nod,tata,nivel:longint; var nivmin:longint);
  var p,p2:pmuchie;
      aux:longint;
      ok:boolean;
  begin
    if viz[nod] then nivmin:=niv[nod] else begin
      viz[nod]:=true;
      ok:=false;
      adauga(nod);
      p:=v[nod];
      p2:=p;
      nivmin:=nivel;
      niv[nod]:=nivel;
      while p<>nil do begin
        if p^.inf<>tata then begin
          if viz[p^.inf] then
            dfs(p^.inf,nod,nivel+1,aux)
          else begin
            if ok then adauga(nod);
            dfs(p^.inf,nod,nivel+1,aux);
            if (aux>=nivel) then scriecomp(nod);
            ok:=true;
          end;
          if aux<nivmin then nivmin:=aux;
        end;
 //       if p2=v[nod] then v[nod]:=p^.adr
   //       else p2
        p2:=p;
        p:=p^.adr;
      end;
    end;
  end;


begin
  assign(input,'biconex.in');
  reset(input);
  assign(output,'biconex.out');
  rewrite(output);
  k:=0;

  readln(n,m);
  for i:=1 to m do begin
    readln(x,y);
    new(nou);
    nou^.inf:=y;
    nou^.adr:=v[x];
    v[x]:=nou;
    new(nou);
    nou^.inf:=x;
    nou^.adr:=v[y];
    v[y]:=nou;
  end;

  dfs(1,0,1,aux);
  writeln(k);
  for i:=1 to k do begin
    while c[i]<>nil do begin
      write(c[i]^.inf,' ');
      c[i]:=c[i]^.adr;
    end;
    writeln;
  end;

  close(input);
  close(output);
end.