Contoh Program Graf

Uses Crt;

Const
Awal = 'A';
Akhir = 'Z';

Type
THimp = Set of Char;
TEdge = Record
Ver1 : Char;
Ver2 : Char;
End;
MyObj = Object
Private
Ver : Array [1..100] of Char;
JumVer : Byte;
Edge : Array [1..100] of TEdge;
JumEdge : Byte;
Degree : Array [1..100] of Byte;
Data, Data1 : THimp;
Data2 : Array [1..100] of THimp;
Public
Procedure Input;
Procedure Cetak;
End;

Var
J : Byte;

Function Detect(Key : THimp) : Char;
Var
T : Char;
Begin
Repeat
T:=UpCase(Readkey);
Until T in Key;
Write(T);
Detect:=T;
End;

Procedure MyObj.Input;
Var
I : Byte;
Begin
Write('Jumlah Vertex : ');
Readln(JumVer);
Write('Input vertex : { ');
For I:=1 To JumVer Do
Begin
Ver[I]:=Detect([Awal..Akhir]);
If (I End;
Writeln(' }');
Writeln;
Write('Jumlah Edge : ');
Readln(JumEdge);
Write('Input Edge : { ');
For I:=1 To JumEdge Do
Begin
Write('(');
Edge[I].Ver1:=Detect([Awal..Akhir]);
Write(',');
Edge[i].Ver2:=Detect([Awal..Akhir]);
write(')');
If (I End;
Write(' }');
End;

Procedure MyObj.Cetak;
Var
I : Byte;
Begin
Writeln;
Write('( { ');
For I:=1 To JumVer Do
Begin
Write(Ver[I]);
If (I End;
Write(' } --> { ');
For I:=1 To JumEdge do
Begin
Write('(',Edge[I].Ver1,',',Edge[I].Ver2,')');
If (I End;
Write(' } )');
Writeln;
End;

Function Derajat(Simpul:Char; Graf:MyObj) : Byte;
Var
I,Der : Byte;
Begin
Der:=0;
For I:=1 To Graf.JumEdge Do
Begin
If (Simpul=Graf.Edge[I].Ver1) Then Inc(Der);
If (Simpul=Graf.Edge[I].Ver2) Then Inc(Der);
End;
Derajat:=Der;
End;

Procedure Derajat_Graph(Var Graf:MyObj);
Var
I:Byte;
Begin
For I:=1 To Graf.JumVer Do
Begin
Graf.Degree[I]:=Derajat(Graf.Ver[I],Graf);
Writeln('d(',Graf.Ver[I],') = ',Graf.Degree[I]);
End;
End;

Procedure Sorting(Var Graf:MyObj);
Var
I,K,Temp : Byte;
Dummy : Char;
Begin
Writeln('Sortir Derajat');
For I:=1 To Graf.JumVer-1 Do
For K:=I To Graf.JumVer-1 Do
Begin
If (Graf.Degree[I] Begin
Dummy:=Graf.Ver[I];
Graf.Ver[I]:=Graf.Ver[K+1];
Graf.Ver[K+1]:=Dummy;
Temp:=Graf.Degree[I];
Graf.Degree[I]:=Graf.Degree[K+1];
Graf.Degree[K+1]:=Temp;
End;
End;
For I:=1 To Graf.JumVer Do
Writeln('d(',Graf.Ver[I],') = ',Graf.Degree[I]);
End;

Procedure Bil_Kromatis(Var Graf:MyObj);
Var
I,K:Byte;
Begin
For J:=1 To Graf.JumVer Do
Graf.Data:=Graf.Data+[Graf.Ver[J]];
J:=0;
For I:=1 To Graf.JumVer Do
Begin
If (Graf.Ver[I] In Graf.Data) Then
Begin
Inc(J);
Graf.Data1:=[];
For K:=1 To Graf.JumEdge Do
Begin
If (Graf.Ver[I]=Graf.Edge[K].Ver1) or
(Graf.Ver[I]=Graf.Edge[K].Ver2) Then
Begin
Graf.Data1:=Graf.Data1+[Graf.Edge[K].Ver1]+
[Graf.Edge[K].Ver2];
End;
End;
Graf.Data2[J]:=Graf.Data-Graf.Data1+[Graf.Ver[I]];
End;
Graf.Data:=Graf.Data-Graf.Data2[J];
End;
Write('Bilangan Khromatis = ',J);
End;

Procedure Beri_Warna(Graf:MyObj);
Var
K,X : Byte;
Data2 : Array [1..10] of Thimp;
Const
Warna : Array [1..7] of String =
('Merah ','Kuning','Hijau ',
'Biru ','Ungu ','Putih ','Hitam ');
color : array [1..7] of integer =
( lightred, yellow,lightgreen, lightblue, magenta,white,darkgray);

Begin
For K:=1 to J Do
Begin
textcolor(color[k]);
Write('Warna ',Warna[K],' : ');
for X:=1 to Graf.JumVer Do
If (Graf.Ver[X] in Graf.Data2[K]) Then
begin
textcolor(lightgray);
Write(Graf.Ver[X],' ');
Writeln;
end;
End;
End;

Var
Aplikasi : MyObj;

Begin
Clrscr;
Aplikasi.Input;
Writeln;
Aplikasi.Cetak;
Writeln;
Derajat_Graph(Aplikasi);
Writeln;
Sorting(Aplikasi);
Writeln;
Bil_Kromatis(Aplikasi);
Writeln;
Beri_Warna(Aplikasi);
Readln;
End.