{Program Binary Tree dengan Pascal
tgl.1 Des 09
----------------------------------------------------------}
program binary_tree;
uses
wincrt;
type
PBinaryTree = ^Node;
Node = record
info : Integer;
Left : PBinaryTree;
Right: PBinaryTree;
end;
var
BinaryTree :PBinaryTree;
Pil:char;
procedure Insert(var bt :PBinaryTree; info:Integer);
var
x:PBinaryTree;
begin
if (bt=nil) then
begin
new(x);
x^.info:=info;
x^.Left:=nil;
x^.Right:=nil;
bt :=x;
end
else
if (info <=bt^.Info) then
insert(bt^.left,info)
else
Insert(bt^.Right,info)
end;
function Find(bt:PBinaryTree; Search :Integer):Boolean;
begin
if (bt=nil) then
find:=Find(bt^.Left,Search)
else
if (Search>bt^.Info) then
find:=Find(bt^.Right, Search)
else
if(search >bt^.info) then
Find:=Find(bt^.Right, Search)
else
Find:=true;
end;
function Delete(var bt: PBinaryTree; Info: Integer):Boolean;
var
x,y:PBinarytree;
begin
if not (Find(bt,info)) then
delete:=false
else
if(info
delete:=delete(bt^.left, info)
else
if (info
delete:=delete(bt^.left, info)
else
if (info
delete:=delete(bt^.right, info)
else
begin
x:=bt;
if (x^.Right <> nil) then
begin
bt:=x^.Right;
y:=bt;
while (y^.Left <> nil) do
y :=y^.Left;
y^.left:=x^.Left;
end
else
bt:=x^.left;
delete:=true;
end;
end;
function NodeCount(bt:PbinaryTree):Integer;
begin
if (bt=nil) then
nodecount:=0
else
nodecount:=1+NodeCount(bt^.left)+NodeCount(bt^.right);
end;
procedure menu;
begin
clrscr;
writeln('Ordered Binary Tree');
writeln('===================');
writeln;
writeln('1.Input data');
writeln('2.Cari Data');
writeln('3.Hapus Data');
writeln('4.Jumlah Node');
writeln('5.Tampilkan Data Secara in order');
writeln('6.Tampilkan Data Secara pre order ');
writeln('7.Tampilkan Data Secara Post Order');
writeln;
writeln('0.keluar');
writeln;
writeln('Silahkan Pilih (0-7)');
writeln;
end;
procedure inputData(var bt:PBinaryTree);
var
code,k,d:Integer;
I:string;
begin
clrscr;
writeln('Input Data Binar Tree');
writeln('=====================');
writeln;
writeln;
K:=1;
repeat
write('masukkan data ke-',k,';');
readln(i);
if(i<>'') then
begin
val(i,d,code);
if(code=0) then
insert(bt,d);
end;
inc(k)
until(i='');
end;
procedure Caridata(bt:PBinaryTree);
var
s:integer;
ulangi:char;
begin
clrscr;
writeln('Mencari Data Binary Tree');
writeln('========================');
writeln;
repeat
write('Masukkan data yang akan dicari:');
readln(s);
if (Find(bt,s)) then
writeln('Data Ditemukan')
else
writeln('Data Tidak Ada');
writeln;
write('Ulangi (Y/T)');
ulangi := ReadKey;
writeln;
until (Upcase(Ulangi) ='T');
end;
procedure HapusData(var bt:PBinaryTree);
var
s:Integer;
Ulangi:Char;
begin
clrscr;
writeln('Menghapus Data Binay Tree');
writeln('=========================');
writeln;
repeat
writeln('masukan data yang akan dihapus:');
readln(s);
if (Delete(bt,s))then
writeln('Data berhasil dihapus')
else
writeln('Data Tidak Ada');
writeln;
writeln;
write('Ulangi (Y/T)');
ulangi := ReadKey;
writeln;
until (Upcase(Ulangi) ='T');
end;
procedure jumlahNode(bt:PBinaryTree);
begin
clrscr;
writeln('Jumlah Node = ',NodeCount(bt));
write('Tekan Sembarang Tombol...');
ReadKey;
end;
procedure InOrder(bt:PBinaryTree);
begin
if (bt <> nil) then
begin
InOrder(bt^.Left);
write(bt^.Info:8);
InOrder(bt^.Right);
end;
end;
procedure PostOrder(bt:PBinaryTree);
begin
if (bt <> nil) then
begin
PostOrder(bt^.Left);
PostOrder(bt^.Right);
write(bt^.Info:8);
end;
end;
procedure PreOrder(bt:PBinaryTree);
begin
if (bt <> nil) then
begin
write(bt^.Info:8);
PreOrder(bt^.Left);
PreOrder(bt^.Right);
end;
end;
procedure cetakInOrder(bt:PBinaryTree);
begin
clrscr;
writeln('Inorder');
InOrder(bt);
writeln;
write('Tekan Sembarang tombol...');
ReadKey;
end;
procedure cetakPreOrder(bt:PBinaryTree);
begin
clrscr;
writeln('Pre Order');
Preorder(bt);
writeln;
write('Tekan Sembarang tombol...');
ReadKey;
end;
procedure cetakPostOrder(bt:PBinaryTree);
begin
clrscr;
writeln('Post Order');
PostOrder(bt);
writeln;
write('Tekan Sembarang tombol...');
ReadKey;
end;
begin
BinaryTree :=Nil;
repeat
Menu;
Pil := Readkey;
case Pil of
'1': InputData (BinaryTree);
'2': CariData (BinaryTree);
'3': HapusData (BinaryTree);
'4': JumlahNode(BinaryTree);
'5': CetakInOrder (BinaryTree);
'6': CetakPreOrder (BinaryTree);
'7': CetakPostOrder (BinaryTree);
end;
until pil='0';
end.
0 komentar:
Posting Komentar