program PewarnaanGraf;
uses wincrt;
var m, n, i, j, DEGREE, STOP, DEGREEMAX, WARNA: integer;
p: array [0..10,0..10] of integer;
q: array [0..100] of integer;
v: array [0..100] of integer;
CEK: array [0..100] of integer;
label 5, 10, 15, 20, 25;
begin
begin
{A. PROSES PENGINPUTAN DATA}
{A.1. PENENTUAN BANYAKNYA VERTEX}
5: writeln('Program Algoritma "Pewarnaan Graf" Maksimum 10 Titik.');
writeln('NB: Maksimal bobot 1000');
writeln('Masukkan jumlah vertex yang anda inginkan.');
readln(m);
if m < 2 then goto 5;
if m > 10 then goto 5;
{A.2. PENENTUAN ADA TIDAKNYA HUBUNGAN}
writeln;
writeln('1: Ada edge yang menghubungkan. 0: Tidak ada edge yang menghubungkan.');
for i:= 1 to m-1 do
begin
for j:= i+1 to m do
begin
10:
write('V',i,'V',j,' = ');readln(p[i,j]);p[j,i]:= p[i,j];
if p[i,j] > 1 then goto 10;
if p[i,j] < 0 then goto 10;
end;
end;
{A.3. PENGECEKAN TITIK TERASING}
for i:= 1 to m do
begin
for j:= 1 to m do
begin
if j = i then goto 15;
if p[i,j] = 0 then
begin
STOP:= STOP +1;
end;
if STOP = m-1 then
begin
writeln('Terdapat titik terasing.');
STOP:= 0;
goto 5;
15: end;
end;
STOP:= 0;
end;
end;
{B. PROSES PEWARNAAN GRAF}
begin
{Variasi}
writeln;
write(' ');
for j:= 1 to m do
begin
write(' V',j);
end;
{B.1. PENGHITUNGAN DEGREE TIAP TITIK}
writeln;
for i:= 1 to m do
begin
DEGREE:= 0;
write('V',i);
for j:= 1 to m do
begin
write(' ',p[i,j]);
if j = i then goto 20;
if p[i,j] <> 0 then DEGREE:= DEGREE+1;
20:
end;
q[i]:= DEGREE;
write(' Degree V',i,' = ',q[i]);
writeln;
end;
{B.2. PEWARNAAN MULAI TITIK BERDEGREE TINGGI KE RENDAH}
{B.2.1. PENGECEKAN DEGREE}
writeln;
25:DEGREEMAX:= 0;
for i:= 1 to m do
begin
if v[i] = 0 then
begin
if DEGREEMAX < q[i] then
begin
DEGREEMAX:= q[i];
n:= i;
end;
end;
end;
{B.2.2. PEWARNAAN TITIK}
if v[n] = 0 then
begin
v[n]:= 1;
for j:= 1 to m do
begin
if p[n,j] <> 0 then
begin
if v[j] <> 0 then
begin
if v[n] <> v[j] then CEK[j]:= 1;
if v[n] = v[j] then v[n]:= v[n]+1;
end;
end;
end;
for i:= 1 to m do
begin
if CEK[i] = 1 then
begin
if v[n] = v[i] then v[n]:= v[n]+1;
end;
CEK[i]:= 0;
end;
end;
{B.2.3. PENCETAKAN WARNA}
writeln('Warna untuk V',n,' adalah ',v[n]);
STOP:= STOP+1;
if STOP <= m-1 then goto 25;
end;
{C. HASIL AKHIR}
for j:= 1 to m do
begin
if WARNA < v[j] then WARNA:= v[j];
end;
writeln('Sehingga paling sedikit dibutuhkan ',WARNA,' warna.');
end.
Preview Program:
Preview Program:
Tidak ada komentar:
Posting Komentar