{*****************************************************
* program 5.14. (PROG5-14.PAS) *
* menghitung nilai ungkapan positifx. *
* ungkapan positifx dihasilkan dari ungkapan infix *
* operand pada ungkapan infix harus berupa angaka *
* sebelum dihitung ungkapan infixnya perlu *
* ditest validasinya. *
* ^, *, /, dan - *
*****************************************************}
program HITUNG_UNGKAPAN_POSITIF;
uses wincrt;
const max = 80;
operand = ['0'..'9'];
operator= ['*', '/', '+', '-', '^'];
{*deklarasi tipe simpul*}
type kalimat = string [max];
tumpukan = ^ elemen;
elemen = record
huruf : char;
angka : real;
berikut : tumpukan;
end;
var infix ,postfix : kalimat;
salah :boolean ;
kode ,cacah, I :integer ;
lagi :char ;
hitungan :real;
{*******************************************
* fungsi berikut digunakan untuk mengecek *
* valid tidaknya ungkapan infix *
* *****************************************}
function CEK_NOTASI (inf : kalimat) : boolean;
var I, N, C_Buka, C_Tutup : integer;
kar_Sah : set of char;
Salah : boolean;
I1, I2 : char;
begin
{* Notasi infix pertama kali dianggap benar *}
salah := false;
N:= length(inf);
if N <= 2 then
salah := true
else if (inf[1] = ')') or (inf[N] = ' (') then
{* jika infix diawali dengan ) atau diakhiri dengan (, berarti infixnya salah *}
salah := true
else
begin
{*himpunan dari karakter yang sah*}
Kar_Sah := operand + operator + ['(', ')'];
{*cacah kurang buka, dan kurung tutup*}
C_Buka := 0; C_Tutup := 0;
for I := 1 to N - 1 do
begin
I1 := inf[I]; I2 := inf[I+1];
if ((I1 in operand) and (I2 in operand))
or ((I1 in operator) and (I2 in operator))
or ((I1 = ')') and (I2 in operand))
or ((I1 = '(') and (I2 = ')'))
or ((I1 in operand) and (I2 = '('))
or ((I1 = ')') and (I2 in operand)) then
begin
salah := true;
I:= N - 1
end
end;
if not salah then
begin
for I:= 1 to N do
if inf[I] in Kar_Sah then
case inf [I] of
')' : C_Tutup := succ (C_Tutup);
'(' : C_Buka := succ (C_Buka)
end
else
begin
salah := true;
I:= N
end;
if not salah then
if c_Tutup > c_buka then
salah := true
else if c_tutup< c_buka then
salah :=true
end
end;
CEK_NOTASI :=Salah
end;
{*fungsi cek_notasi *}
{********************************
*prosedur untuk mempush simpul*
*********************************}
procedure PUSH ( var T: Tumpukan;
Hrf: char;
Digit:real);
var Baru : Tumpukan;
begin
{*Alokasi dan mengisi simpul baru*}
new(baru);
baru^.Huruf:=Hrf;
Baru^.Angka:=Digit;
if T=nil then
{*Tumpukan masih kosong*}
begin
T:=Baru;
T^.Berikut :=nil
end
else
{*tumpukan sudah berisi sejumlah elemen*}
begin
Baru^.Berikut:=T;
T:=Baru
end
end;
{*prosedur PUSH*}
{*********************************
*prosedure untuk mempop elemen teratas*
**********************************}
procedure POP
( var T:Tumpukan;
Var Hrf:char;
Var Digit:real);
var bantu :tumpukan;
begin
bantu :=T;
Hrf :=T^.Huruf;
Digit :=T^.Angka;
T:=T^.Berikut;
dispose (Bantu)
end;
{*prosedur POP*}
{************************************************
*Prosedur untuk mengkonversi ungkapan infix *
*menjadi postfix. Prosedur ini berisi fungsi *
*untuk menentukan derajad operator dan prosedur *
*untuk menyimpan dan mencetak karakter hasil *
*konversi *
************************************************}
procedure INFIX_KE_POSTFIX ( Infix : kalimat;
var Postfix : Kalimat;
var J : integer);
var
I : integer;
Tanda, Opand : set of char;
Temp, Kar : char;
T : Tumpukan;
Buram : real;
{************************************************
*Fungsi untuk menentukan derajad operator *
************************************************}
function VALENSI (Tanda_Op : char) : integer;
begin
case Tanda_Op of
'^' : VALENSI := 3;
'*', '/' : VALENSI := 2;
'+', '-' : VALENSI := 1;
'(' : VALENSI := 0
end
end; {* fungsi VALENSI *}
{************************************************
*Prosedur untuk mnyimpan dan *
*mencetak hasil konversi *
************************************************}
procedure OPER;
begin
POP(T, Temp, Buram);
J := J+1;
write(Temp:2);
Postfix[J] :=Temp
end; {* fungsi OPER *}
begin {* fungsi INFIX_KE_POSTFIX *}
T := nil;
for I := 1 to length(Infix) do
begin
Kar :=Infix[I];
if Kar = '[' then {* kurung buka *}
PUSH(T, Kar, 0)
else if Kar = ')' then {* kurung buka *}
begin
while T^.Huruf <> '(' do OPER;
POP(T, Temp, Buram)
end
else if Kar in Operator then {*Operator*}
begin
while (T<> nil) and
(VALENSI (Kar) <= VALENSI(T^.Huruf)) do
OPER;
PUSH (T, kar, 0)
end
else {*operand*}
begin
J:= J+I;
write(Kar:2);
Postfix[J] := Kar
end
end;
if T <> nil then
{*Tumpukan Bleum Kosong*}
repeat
OPER
until T=nil;
end; {*prosedur INFIX_KE_POSTFIX*}
{*********************************************************************
* Fungsi untuk menghitung nilai ungkapan postfix *
* Fungsi ini berisi fungsi lain untuk *
* mengoperasikan dua operand *
**********************************************************************}
procedure HITUNG_UNGKAPAN( cacah:integer;
postfix :kalimat;
var hitungan:real;
var Nol:boolean);
var Awal :Tumpukan;
Temp,Kar :char;
Satu,dua :real;
kode,kode1,I :integer;
hsl :real;
{*********************************************************************
posedur untuk mengoperasikan dua operand}
procedure HASIL( Op:char; satu, dua:real;
var nol:boolean;var Hsl:real);
begin
nol :=false;
case op of
'*' :Hsl :=satu*dua;
'/' :if dua<>0 then Hsl:=satu/dua
else nol:= true;
'+' :Hsl :=satu+dua;
'_' :Hsl :=satu-dua;
'^' : hsl:= exp (dua * ln(satu))
end
end; {* Prosedur Hasil *}
begin {* HITUNG_UNGKAPAN**}
for I := 1 to cacah do
begin
Kar:= postfix[I];
if Kar in operator then
{ * karakter yang di baca adalah operator *
* pop dua element teratas, dan operasikan *
* sesuai operator yang ada. Element yang *
* dipop pertama kali adalah operand *
* kedua, dan yang dipop berikutnya *
* adalah operand pertama. *}
begin
POP( awal, Temp, Dua);
POP( awal, Temp, Satu);
HASIL(Kar, Satu, Dua, Nol, Hsl);
if Nol then I := cacah
else PUSH (Awal, ' ',Hsl)
end
else
begin
val ( Kar, Kode, Kode1);
PUSH ( Awal, ' ', Kode)
end
end;
if not Nol then
{* Tidak ada pembagian dengan nol *
* pop ujung tumpukan sebagai hasil akhir *}
begin
POP( awal, temp, Satu);
Hitungan := Satu
end
end; {*prosedur Hitung_Ungkapan *}
{***********************Program Utama **********************}
begin
repeat
clrscr;
writeln ('NAMA : MUKLISIN');
writeln ('NIM : 11295100');
writeln;
writeln;
write ('-----------------------------------');
writeln ('-----------------------------------');
writeln (' Menghitung nilai ungkapan postfix ');
write ('( operand harus berupa angka ');
writeln ('dan harus terdiri dari 1 digit ) ');
write ('-----------------------------------');
writeln ('-----------------------------------');
writeln;
write ( ' Isikan sembarang notasi infix : ');
readln (infix);
writeln;
if CEK_NOTASI(infix)then
{*Notasi infixnya salah*}
writeln (' Notasi diatas adalah SALAH. ')
else
{ * Notasi infixnya benar *}
begin
writeln ('Notasi di atas sudah BENAR.');
write ('Notasi POSTFIXnya: ');
cacah := 0;
{* Konversi infix ke postfix *}
INFIX_KE_POSTFIX (infix, postfix, Cacah);
writeln;writeln;
{* Menghitung Ungkapan *}
HITUNG_UNGKAPAN (Cacah, Postfix, Hitungan, salah);
if salah then
{* Ada pembagiann dengan nol *}
begin
write ('Pembagian dengan nol ');
writeln ('Hasil tak terdefinisi');
end
else
begin
write ('Hasil Perhitungan: ');
writeln (Hitungan:10:5)
end;
end;
{* Akan mencoba lagi...? *}
writeln;
write ('Akan coba lagi (Y/T): '); readln (Lagi);
until not (Lagi in ['Y','T'] )
end. {*** program utama ***}
Tidak ada komentar:
Posting Komentar