Cod sursa(job #1535945)

Utilizator ili226Vlad Ilie ili226 Data 25 noiembrie 2015 14:11:35
Problema Componente tare conexe Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.52 kb
type nd=^nod;
     nod=record
          val:longint;
          next:nd
         end;
     graf=array[1..100000]of nd;
     sir=array[1..100000]of boolean;
var f:text;
    j,n,m,i,x,y,k:longint;
    ctc,g,gt:graf;
    ver,plus,minus:sir;

procedure adauga(var g:graf;x,y:longint);
var p:nd;
begin
new(p);
p^.val:=y;
p^.next:=g[x];
g[x]:=p;
end;

procedure df(g:graf;var vec:sir;x:longint);
var p:nd;
begin
p:=g[x];vec[x]:=true;
while p<>nil do
 begin
  if (not(ver[p^.val]))and(not vec[p^.val])then
   df(g,vec,p^.val);
  p:=p^.next
 end;
end;

procedure ia_comp(var c:graf;k,x:longint);
var p,pp:nd;
begin
if (plus[x])and(minus[x])then
 begin
  ver[x]:=true;
  new(pp);
  pp^.val:=x;
  pp^.next:=c[k];
  c[k]:=pp;
  p:=g[x];
  while p<>nil do
   begin
    if not(ver[p^.val])then
     ia_comp(c,k,p^.val);
    p:=p^.next
   end;
 end
end;
procedure tipareste(p:nd);
begin
 if p<>nil then
  begin
   write(f,p^.val,' ');
   tipareste(p^.next)
  end
           else
  writeln(f);
end;

begin
 assign(f,'ctc.in');
 reset(f);
 readln(f,n,m);
 for i:=1 to m do
  begin
   readln(f,x,y);
   adauga(g,x,y);
   adauga(gt,y,x);
  end;
 close(f);k:=0;
 for i:=1 to n do
  if not(ver[i]) then
   begin
    inc(k);
    for j:=1 to n do
     begin
      plus[j]:=false;
      minus[j]:=false
     end;
    df(g,plus,i);
    df(gt,minus,i);
    ia_comp(ctc,k,i);
   end;
 assign(f,'ctc.out');
 rewrite(f);
 writeln(f,k);
 for i:=1 to k do
  tipareste(ctc[i]);
 close(f);
end.