Cod sursa(job #1608933)

Utilizator florescuDorel Andrei florescu Data 22 februarie 2016 14:26:12
Problema Componente tare conexe Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.29 kb
type multime=set of byte;
     matrice=array[1..100,1..100] of integer;
var a:matrice;
    s,p,c:array[1..100] of multime;
    n,nc,m:integer;
    l:multime;

procedure citire_matrice;
var i,j,k,x,y:integer;
    f:text;
begin
assign(f,'ctc.in'); reset(f);
readln(f,n,m);
for k:=1 to m do
begin
readln(f,x,y);
a[x,y]:=1;
end;
end;

procedure war;
var i,j,k:integer;
begin
for k:=1 to n do
 for i:=1 to n do
  for j:=1 to n do
  if (a[i,j]=0)and(i<>k)and(k<>j) then a[i,j]:=a[i,k]*a[k,j];
end;

procedure det_S(i:integer);
var k:integer;
begin
s[i]:=[];
for k:=1 to n do
if a[i,k]=1 then s[i]:=s[i]+[k];
end;

procedure det_p(i:integer);
var k:integer;
begin
p[i]:=[];
for k:=1 to n do
if a[k,i]=1 then p[i]:=p[i]+[k];
end;

procedure determina;
var i,k:integer;
begin
l:=[];
nc:=0;
for i:=1 to n do
if not(i in l) then
     begin
     nc:=nc+1;
     det_s(i);
     det_p(i);
     c[i]:=(s[i]*p[i])+[i];
     l:=l+c[i];
     end;
writeln(nc);
l:=[];
nc:=0;
for i:=1 to n do
if not(i in l) then

      begin
      nc:=nc+1;
      det_s(i);
      det_p(i);
      c[i]:=(s[i]*p[i])+[i];
      l:=l+c[i];
      for k:=1 to n do
     if k in C[i] then write(k,' ');
     writeln;
     end;
end;




BEGIN
citire_matrice;
war;
determina;
end.