Cod sursa(job #280601)

Utilizator gabyromaRomanescu Gabriela gabyroma Data 13 martie 2009 14:41:52
Problema Componente tare conexe Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.57 kb
program componente_tare_conexe;
type point=^nod;
     nod=record
       inf:longint;
       leg:point;
     end;

var prim,primt:array[1..100000] of point;
    n,m,nr,nrc:longint;
    c:array[1..100000] of longint;
    sel:array[1..100000] of boolean;
    f,g,h:text;

procedure citire;
var i,j,x,y:longint; p:point;
begin
readln(f,n,m);
fillchar(sel,n,false);
for i:=1 to n do begin
  prim[i]:=nil;
  primt[i]:=nil;
  end;
for i:=1 to m do begin
  readln(f,x,y);
  new(p);
  p^.inf:=y;
  p^.leg:=prim[x];
  prim[x]:=p;
  new(p);
  p^.inf:=x;
  p^.leg:=primt[y];
  primt[y]:=p;
  end;
end;

procedure df(x:integer);
var p:point;
begin
sel[x]:=true;
inc(nrc);
c[nrc]:=x;
p:=prim[x];
while p<>nil do begin
 if not sel[p^.inf] then df(p^.inf);
 p:=p^.leg;
 end;
end;

procedure dft(x:integer);
var p:point;
begin
write(g,x,' ');
sel[x]:=true;
p:=primt[x];
while p<>nil do begin
 if not sel[p^.inf] then dft(p^.inf);
 p:=p^.leg;
 end;
end;


procedure det;
var i:longint;
begin
for i:=1 to n do
  if not sel[i] then df(i);
fillchar(sel,n,false);
nr:=0;
for i:=1 to n do
  if not sel[c[i]] then begin
    inc(nr);
    dft(c[i]);
    writeln(g);
    end;
end;

procedure scriere;
var x:char;
begin
writeln(h,nr);
reset(g);
while not eof(g) do begin
  while not eoln(g) do begin
    read(g,x);
    write(h,x);
    end;
  readln(g);
  writeln(h);
  end;
end;

begin
assign(f,'ctc.in');
assign(g,'c.out');
assign(h,'ctc.out');
reset(f);
rewrite(g);
rewrite(h);
citire;
det;
close(g);
scriere;
close(h);
end.