Algoritma Program Pascal untuk Minimum Spanning Tree Metode Kruskal pada Matematika Diskrit
program minimum_spanning_tree;
uses wincrt;
var
i, j, k, n, y, z, cek, jarak: integer;
v, vb : array [1..20,1..20] of integer;
urutan, lewat : array [1..20] of integer;
label 1, 2, 3;
Begin
1:
{Input}
writeln('Program Minimum Spanning Tree');
write('Masukkan besar matriks adjacency (n x n): ');readln(n);
for i:= 1 to n do
begin
for j:= i to n do
begin
if j <> i then
begin
write('V',i,'V',j,' = ');readln(v[i,j]);
v[j,i]:= v[i,j];
vb[i,j]:= v[i,j];
vb[j,i]:= v[j,i];
end;
end;
end;
2:
{Cetak Matriks Adjacency}
write(' ');
for i:= 1 to n do
begin
write(' V',i);
end;
writeln;
for i:= 1 to n do
begin
write('V',i,'|');
for j:= 1 to n do
begin
if v[i,j-1] < 10 then write(' ',v[i,j]);
if v[i,j-1] >= 10 then write(' ',v[i,j]);
end;
writeln(' |');
end;
if cek = 0 then
begin
writeln;
writeln('Benarkan ini matriks adjacency yang anda inginkan?');
writeln('1. Ya 2. Tidak');readln(k);
end;
if cek = 0 then
begin
{Jik dipilih ya, maka proses cetak matriks diulangi}
if k = 1 then
begin
cek:= 1;
clrscr;
goto 2;
end;
{Jika dipilih tidak, maka proses input akan diulangi}
if k = 2 then
begin
for i:= 1 to n do
begin
for j:= 1 to n do
begin
v[i,j]:= 0;
end;
end;
clrscr;
goto 1;
end;
end;
{Pencarian urutan}
cek:= 1;
repeat
k:= 10000;
for i:= 1 to n do
begin
for j:= i to n do
begin
if j <> i then
begin
if vb[i,j] <> 0 then
begin
if v[i,j] < k then
begin
k:= vb[i,j];
y:= i;
z:= j;
end;
end;
end;
end;
end;
vb[y,z]:= 0;
urutan[cek]:= k;
cek:= cek + 1;
until cek > 2*n;
{Cetak urutan}
writeln;
writeln('Ukuran dari terkecil adalah');
for i:= 1 to 20 do
begin
if urutan[i] <> 0 then write(' ',urutan[i]);
end;
writeln;
{Cetak minimum spanning tree}
writeln;
writeln('Jadi minimum spanning tree dari graf tersebut adalah ');
z:= 1;
cek:= 1;
repeat
write('V',z);
k:= 10000;
for i:= 1 to n do
begin
if lewat[i] <> 1 then
begin
if z <> i then
begin
if v[z,i] <> 0 then
begin
if v[z,i] < k then
begin
k:= v[z,i];
j:= i;
end;
end;
end;
end;
end;
lewat[z]:= 1;
cek:= cek + 1;
jarak:= jarak + k;
z:= j;
until cek = n;
write('V',z,' = ',jarak);
End.
Preview Program:
Tidak ada komentar:
Posting Komentar