Cod sursa(job #148229)

Utilizator eugen.nodeaEugen Nodea eugen.nodea Data 3 martie 2008 23:54:35
Problema Parcurgere DFS - componente conexe Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 2.26 kb
{$M 65520,0,655360}
Const nmax=10000;
Type lista=^elem;
     elem=Record
                v:longint;
                urm:lista;
          end;
    list=Array[1..nmax] Of lista;
Var
	min,i,j,n,m,x,y,nc,p:longint;
	f:text;
        L:list;
        viz:array[1..nmax] of 0..1;
        ok:boolean;
Procedure adaug(x,y:longint);
var p,q:lista;
begin
     If L[x]=nil then begin
                           new(p);
                           p^.v:=y;
                           p^.urm:=Nil;
                           L[x]:=p;
                      end
                  else begin
                           p:=L[x];
                           new(q);
                           q^.v:=y;
                           q^.urm:=p;
                           L[x]:=q;
                       end;
     If L[y]=nil then begin
                           new(p);
                           p^.v:=x;
                           p^.urm:=Nil;
                           L[y]:=p;
                      end
                  else begin
                           p:=L[y];
                           new(q);
                           q^.v:=x;
                           q^.urm:=p;
                           L[y]:=q;
                       end;
end;
Procedure dfs(k:longint);
var
   i:longint;
   p:lista;
begin
     Viz[k]:=1;
     For i:=1 to n do
         if (Viz[i]=0) then begin
                               p:=L[i];
                               while (p<>Nil) and (p^.v<>k) do
                                     p:=p^.urm;
                               if p<>Nil then dfs(i);
                          end;
end;
BEGIN
  Assign(f,'dfs.in'); Reset(f);
  Readln(f,n,m);
  For i:=1 to n do
       L[i]:=Nil;
  For i:=1 to m do
      begin
	Readln(f,x,y);
        adaug(x,y);
      end;
  Close(f);
  nc:=1;
  i:=1; min:=1;
  repeat
        dfs(i);
        ok:=True;
        for j:=min to n do
            if Viz[j]=0 then begin
                                i:=j;
                                min:=j;
                                nc:=nc+1;
                                ok:=False;
                                break;
                           end;
  until ok;
  Assign(f,'dfs.out'); Rewrite(f);
  write(f,nc);
  close(f);
END.