Program Konversi_Infix_Postfix_Prefix;
uses wincrt;
const Gr='------------------';
Operator1 = ['+','-','*','/','^'];
Operand = ['A'..'Z'];
type tree=^simpul;
stack=^data;
simpul=record
info:char;
kiri,kanan:tree;
end;
data=record
Item
: Tree;
next:stack;
end;
var Pohon:tree;
Infix:string;
betul:boolean;
I:integer;
lagi,Gg:char;
procedure tampilan;
var P:char;
begin
gotoxy(11,5);
writeln('-------------------------------------------------------');
writeln('| MENGUBAH
NOTASI INFIX MENJADI PREFIX DAN POSTFIX
|');
writeln('|
dengan menggunakan bantuan binary tree |');
writeln('| Operator
yang diterima adalah ^,*,/,+ dan -
|');
writeln('|
|');
writeln('| Tekan
<RETURN> untuk mulai proses ...
|');
gotoxy(11,whereY);
writeln('-------------------------------------------------------');
P:=readkey;
clrscr;
end;
{alokasi node}
function P_simpul(hrf:char):tree;
var baru:tree;
begin
new(baru);
baru^.info:=hrf;
baru^.kanan:=nil;
baru^.kiri:=nil;
P_simpul:=baru;
end;
{alokasi elemen stack}
function T_simpul(hrf:tree):stack;
var baru:stack;
begin
new(baru);
baru^.item:=hrf;
baru^.next:=nil;
T_simpul:=baru;
end;
{push elemen ke stack}
procedure push(var S:stack; T:tree);
var B:stack;
begin
B:=T_simpul(T);
if
S=nil then
S:=B
{tump kosong}
else
begin
if S=nil then
S:=B
end
end;
{pop elemen}
procedure pop(var S:stack; var T:tree);
var bantu:stack;
begin
if S
<> nil then
begin
bantu:=S;
T:=S^.item;
S:=S^.next;
dispose(bantu);
end
end;
{menentukan valensi/keutamaan operator}
function valensi(dt:char):integer;
begin
case dt
of
'^' :
valensi:=3;
'*','/'
: valensi :=2;
'+','-'
: valensi :=1;
'(' :
valensi :=0;
end
end;
procedure cetak_stack(S:stack);
begin
while S
<> nil do
begin
write(S^.item^.info,' ');
S:=S^.next;
end;
writeln;
end;
procedure buat_pohon(var pohon:tree; var betul:boolean;
Ung:string);
var I :integer;
Pd,Gg :char;
S_phn, T1,T2,St:tree;
Opr,Opn:stack;
function gabung:tree;
begin
pop(Opn,T1);
{cabang kanan}
pop(opn,T2);
{cabang kiri}
pop(opr,St);
{root}
St^.kanan:=T1;
St^.kiri:=T2;
gabung:=St;
end;
{program procedure}
begin
betul:=true;
Opr:=nil;
Opn:=nil;
write('PROSES
PEMBENTUKAN PELACAKAN POHON BINER');
writeln;
writeln(Gr,Gr,Gr);
writeln('Karakter
dibaca Tumpukan Operator Tumpukan Operand');
write('
':22,chr(218),Gg,Gg,' Ujung ');
writeln('tumpukan',Gg,Gg,chr(191));
writeln('
':22,chr(25),' ':21,chr(25));
writeln(Gr,Gr,Gr);
{start
porcess}
for I:=1 to length(Ung) do
begin
Pd:=upcase(Ung[I]);
gotoxy(8,wherey);
write(Pd);
if
Pd <> ' ' then
begin
S_phn:=P_simpul(Pd);
if
Pd='(' then
push(Opr,S_phn)
else
if
Pd=')' then
begin
while
Opr^.item^.info <> '(' do
push(Opn,gabung);
pop(Opr,T1);
end
else
if
Pd in Operator1 then
begin
while (Opr <> nil) and (valensi(Pd) <= valensi(Opr^.item^.info))
do
push(Opn,gabung);
push(Opr,S_phn);
end
else
if
Pd in Operand then
push(Opn,S_phn)
else
begin
betul:=false;
exit;
end;
gotoxy(23,wherey);
cetak_stack(Opr);
gotoxy(45,wherey-1);
cetak_stack(Opn);
end
end;
writeln(Gr,Gr,Gr);
while
Opr <> nil do
push(Opn,gabung);
Pohon:=Opn^.item;
dispose(Opn);
end;
procedure cetak_prefix(phn:tree);
begin
if phn
<> nil then
begin
write(phn^.info,' ');
cetak_prefix(phn^.kiri);
cetak_prefix(phn^.kanan);
end;
end;
procedure cetak_infix(phn:tree);
begin
if phn
<> nil then
begin
cetak_infix(phn^.kiri);
write(phn^.info,'
');
cetak_infix(phn^.kanan);
end;
end;
procedure cetak_postfix(phn:tree);
begin
if phn
<> nil then
begin
cetak_postfix(phn^.kiri);
cetak_postfix(phn^.kanan);
write(phn^.info,'
');
end;
end;
BEGIN
clrscr;
lagi:='Y';
Gg:=chr(196);
repeat
tampilan;
write('Masukkan
ungkapan dalam notasi INFIX: ');
readln(Infix);
clrscr;
write('Notasi
Infix: ');
for
I:=1 to length(Infix) do
if
Infix[I] <> ' ' then
write(upcase(Infix[I]),'
');
writeln;
writeln;
buat_pohon(pohon,
betul, Infix);
if
betul then
begin
writeln;
write('Notasi
Prefix : ');
cetak_prefix(pohon);
writeln; writeln;
write('Notasi
Infix : ');
cetak_infix(pohon);
writeln; writeln;
write('Notasi
Postfix : ');
cetak_postfix(pohon);
writeln; writeln;
end
else
begin
write('<',chr(205),chr(205),chr(205));
writeln(chr(205),chr(184));
write('
':15,chr(192),Gg,Gg,Gg);
write('
karakter tidak sah ');
writeln('("INVALID
CHARACTER")');
writeln(Gr,Gr,Gr);
writeln; writeln;
write('Maaf
tidak bisa');
writeln('Teruskan
lagi .....?');
end;
writeln;
write('akan
mencoba lagi ? [Y/T] : ');
lagi:=upcase(readkey);
clrscr;
until lagi <> 'Y';
end.
0 komentar:
Posting Komentar