Cài đặt thuật toán xác định các thành phần liên thông bằng Pascal

CÀI ĐẶT THUẬT TOÁN TÌM CHU THÀNH PHẦN
LIÊN THÔNG BẰNG CHƯƠNG TRÌNH PASCAL
Thành phần liên thông.
Chương trình xác định các thành phần liên thông.
Dữ liệu được lấy từ tệp TPLT.INP là ma trận :
n m
x
1
y
1
x
2
y
2
. .
. .
. .
x
m
y
m
Trong đó, n số đỉnh, m là
số cạnh
Sau khi lấy dữ liệu, chương trình sẽ xác định các thành
phần liên thông và lưu vào tệp TPLT.OUT có cấu trúc:

k
x
1
x
2

…
y
1
y
2
…
… …. …
z
1
z
2
…
Trong đó, k số tplt.
x
1,
x
2…
là các đỉnh tplt
thứ 1
y
1,
y
2…
là các đỉnh tplt
thứ 2
…
z
1,
z
2…

là các đỉnh tplt
thứ k
Chương trình: (TPLT.PAS)
program lien_thong;
const maxv =100;
type link =^node;
node= record
v:integer;
next:link;
end;
var m,n,v,u,d,d1:integer;
ke:array[1..maxv] of link;
t:link;
a:array[1..maxv] of boolean;
f,f1:text;
PROCEDURE input;
var i,x,y:integer;
begin
assign(f1,'tplt.inp');reset(f1);
while not eof(f1) do
begin
readln(f1,n,m);
for i:=1 to n do
ke[i]:=nil;
for i:=1 to m do
begin
readln(f1,x,y);
new(t);t^.v:=x; t^.next:=ke[y];
ke[y]:=t;
new(t);t^.v:=y; t^.next:=ke[x];

ke[y]:=t;
end;
end;
close(f1);
End;
procedure tplt;
var i:integer;
Begin
d1:=0;
for i:=1 to n do
begin
t:=ke[i]; a[i]:=false; d:=0;
while (t<>nil) do
begin
inc(d);
if (a[t^.v]=false)and(d<>0) then
a[t^.v]:=true;
t:=t^.next;
end;
if d=0 then
inc(d1);
end;
End;
PROCEDURE output;
var i,d:integer;
begin
assign(f,'tplt.out'); rewrite(f);
write(f,' ',d1);
for i:=1 to n do
begin

t:=ke[i];
a[i]:=false; d:=0;
while (t<>nil) do
begin
inc(d);
if (a[t^.v]=false) and (d<>0) then
begin
a[t^.v]:=true;
write(f,' ',t^.v);
end;
t:=t^.next;
end;
if d=0 then
begin
writeln(f);
write(f,' ',i);
end;
end;
close(f);
End;
BEGIN
input;
tplt;
output;
END.
File vào ví dụ: (TPLT.INP)
5 4
1 2
2 3
1 3

4 5
File ra tương ứng: (TPLT.OUT)
2
1 2 3
4 5