Contoh Program Stack

{*********************************************
* Program 3.4. (PROG3-4.PAS) *
* Konversi notasi persamaan matematis dari *
* notasi infix menjadi notasi postfix (RPN) *
*********************************************}
program KONVERSI_INFIX_KE_POSTFIX;

uses crt;

const Max_Elemen = 255;

type S255 = string[Max_Elemen];
Tumpukan = record
Rinci : S255;
Atas : 0..Max_Elemen
end;

var Infix : S255; {* notasi infix *}
Lagi : char;

{********************************************
* Fungsi untuk menentukan valensi operator *
********************************************}
function VALENSI (Tanda_Op : char) : integer;

begin
case Tanda_Op of
'$' : VALENSI := 3; {* pangkat *}
'*', '/' : VALENSI := 2; {* kali atau bagi *}
'+', '-' : VALENSI := 1; {* plus atau minus *}
'(' : VALENSI := 0 {* kurung buka *}
end
end; {* fungsi VALENSI *}

{************************************************
* Prosedur memasukkan elemen ke dalam tumpukan *
************************************************}
procedure PUSH (var T : Tumpukan; Elemen : char);

begin
T.Atas := T.Atas + 1;
T.Rinci[T.Atas] := Elemen
end; { *** prosedur PUSH *** }
{***********************************************
* Fungsi untuk mengambil elemen dari tumpukan *
*********************************************** }
function POP (var T : Tumpukan) : char;

begin
POP := T.Rinci[T.Atas];
T.Atas := T.ATas - 1
end; { *** fungsi POP *** }

{*************************************
* Prosedur untuk melalukan konversi *
* dan mencetak hasil *
*************************************}
procedure KONVERSI_CETAK (Infix : S255);

var I : integer;
Operator : set of char;
Temp, Kar : char;
T : Tumpukan;
Test : boolean;

begin
{* Himpunan operator yang diijinkan *}
Operator := ['$']+['*']+['/']+['+']+['-'];

{* Melakukan konversi *}
for I := 1 to length(Infix) do
begin
Kar := Infix[I];

{* Kurung buka. Push ke dalam tumpukan *}
if Kar = '(' then PUSH(T, Kar)

{* Kurung tutup. Pop semua elemen tumpukan *
* dan dicetak, sampai elemen atas tumpukan *
* adalah kurung buka. Pop juga elemen ini *
* tetapi tidak perlu ditulis. *}
else if Kar = ')' then
begin
while T.Rinci[T.Atas] <> '(' do
write(POP(T):2);
Temp := POP(T)
end

{* Operator. Test valensinya terhadap *
* valensi elemen atas tumpukan. Jika *
* valensinya lebih kecil, pop elemen atas *
* tumpukan sampai valensi elemen atas *
* tumpukan lebih kecil. Push operator ini *}

else if Kar in Operator then
begin
while (T.Atas <> 0) and (VALENSI(Kar) <= VALENSI(T.Rinci[T.Atas])) do
write(POP(T):2);
PUSH(T, Kar)
end

{* Operand. Langsung dicetak. *}
else if Kar <> ' ' then
write(Kar:2)
end;

if T.Atas <> 0 then
{* Tumpukan masih isi. Pop semua elemen *
* yang masih ada dalam tumpukan *}
repeat
write(POP(T):2)
until T.Atas = 0;
end; { *** prosedur KONVERSI_CETAK *** }

{*****************
* Program utama *
*****************}
begin
clrscr;
writeln('MENGUBAH NOTASI INFIX MENJADI POSTFIX');
writeln('DENGAN MEMANFAATKAN STRUKTUR TUMPUKAN');
writeln('-------------------------------------');
writeln;
repeat

{* Notasi infix yang akan dikonversikan *}
write('Masukkan ungkapan infix: ');
readln(Infix); writeln;
write('Ungkapan postfix: ');

{* Melakukan konversi dan mencetak hasil *}
KONVERSI_CETAK (Infix);

writeln; writeln;
write('Akan mencoba lagi? Y(a)/T(idak): ');
readln(Lagi);
writeln
until not (Lagi in ['Y', 'y'])
end. {* program utama *}

Output: