program tes;
type
stack = ^isi;
rekam2 = record
info : char;
next : stack;
end;
isi = rekam2;
stack_angka = ^isi1;
rekam1 = record
info : real;
next : stack_angka;
end;
isi1 = rekam1;
var
panjang,i : integer;
angka,angka1,simpan,kar: string;
top,phapus,coba : stack;
top1,coba1,phapus1 :stack_angka;
item : char;
value : real;
procedure buatstack(var top : stack) ;
var
baru:stack;
begin
new(baru);
baru^.info := '(';
baru^.next := nil;
top := baru;
end;
procedure buatstack1(var top : stack_angka) ;
var
baru:stack_angka;
begin
new(baru);
baru:=nil;
top := baru;
end;
function kosong(var top : stack) : boolean;
begin
kosong := false;
if (top=nil) then
kosong := true;
end;
function kosong1(var top : stack_angka) : boolean;
begin
kosong1 := false;
if (top=nil) then
kosong1 := true;
end;
function satusimpul(var top : stack) : boolean;
begin
satusimpul := false;
if (top^.next=nil) then
satusimpul := true;
end;
function satusimpul1(var top : stack_angka) : boolean;
begin
satusimpul1 := false;
if (top^.next=nil) then
satusimpul1 := true;
end;
procedure sisip_depan(var top : stack ; item : char);
var
baru : stack;
begin
new(baru);
baru^.info := item;
baru^.next := top;
top := baru;
end;
procedure sisip_depan1(var top : stack_angka ; angka : real);
var
baru : stack_angka;
begin
new(baru);
baru^.info := angka;
baru^.next := top;
top := baru;
end;
procedure push(var top : stack ; item : char);
var
baru : stack;
begin
if kosong(top) then
begin
new(baru);
baru^.info := item;
baru^.next := nil;
top:=baru;
end
else
sisip_depan(top,item);
//writeln('masuk push');
end;
procedure push1(var top : stack_angka ; angka : real);
var
baru : stack_angka;
begin
if kosong1(top) then
begin
new(baru);
baru^.info := angka;
baru^.next := nil;
top:=baru;
end
else
sisip_depan1(top,angka);
end;
function pop(var top : stack) : char;
var
phapus : stack;
begin
if ((not(kosong(top)))and (not(satusimpul(top)))) then
begin
phapus := top;
pop := top^.info;
top := top^.next;
dispose(phapus);
end;
end;
function pop1(var top : stack_angka) : real;
var
phapus : stack_angka;
begin
if ((not(kosong1(top)))and (not(satusimpul1(top)))) then
begin
phapus := top;
pop1 := top^.info;
top := top^.next;
dispose(phapus);
end
else
begin
phapus:=top;
pop1 := top^.info;
dispose(phapus);
new(top);
top:=nil;
end;
end;
procedure huruf(var top:stack ; var item:char; var proses : string);
var
benar : boolean;
begin
if((item<>'+') and (item<> '-') and (item<> '/') and (item<> '*') and (item<> '^')
and (item<> ')') and (item<> '('))
then
begin
proses := proses+item;
end
else
begin
if (item='(') then
begin
push(top,item);
end;
if (item=')') then
begin
while (top^.info <> '(') do
begin
proses := proses + pop(top);
end;
pop(top);
if(top^.info='(') then
begin
pop(top);
end;
end
else
begin
{operan}if((top^.info = '+') or (top^.info = '-')
or (top^.info = '*') or (top^.info = '/')
or (top^.info = '^')) then
begin
{logikapop}if((top^.info = '^')and((item='/')or(item='*')or(item='+')
or(item='-')or(item = '^')))then
begin
if (item='^') then
begin
proses := proses+pop(top);
push(top,item);
end;
if ((item='*') or (item='/')) then
begin
if((top^.info='^')and((top^.next^.info='*')or(top^.next^.info='/'))) then
begin
while ((top^.info<>'*')and(top^.info<>'/')) do
begin
proses := proses+pop(top);
end;
end;
proses := proses+pop(top);
push(top,item);
end;
if ((item='+') or (item='-')) then
begin
benar := true;
if((top^.info='^')and((top^.next^.info='*')or(top^.next^.info='/'))and((top^.next^.next^.info='-')or(top^.next^.next^.info='+'))) then
begin
while ((top^.info<>'-')and(top^.info<>'+')) do
begin
proses := proses+pop(top);
end;
end;
if((top^.info='^')and((top^.next^.info='*')or(top^.next^.info='/'))and((top^.next^.next^.info<>'-')or(top^.next^.next^.info<>'+'))) then
begin
while ((top^.info<>'*')and(top^.info<>'/')) do
begin
proses := proses+pop(top);
end;
end;
proses := proses+pop(top);
push(top,item);
end;
end
else
begin
if(((top^.info='*')or(top^.info='/')) and ((item='+')or(item='-')or
(item='^')or(item='*')or(item='/')) )then
begin
if (item='^') then
begin
push(top,item);
end;
if ((item='+') or (item='-')) then
begin
if(((top^.info='*')or(top^.info='/'))and((top^.next^.info='-')or(top^.next^.info='+'))) then
begin
while ((top^.info<>'+')and(top^.info<>'-')) do
begin
proses := proses+pop(top);
end;
end;
proses := proses+pop(top);
push(top,item);
end;
if ((item='*') or (item='/')) then
begin
proses := proses+pop(top);
push(top,item);
end;
end
else
begin
if( ((top^.info='-')or(top^.info='+')) and ((item='*')or(item='/')or
(item='^') or (item='+')or(item='-')) )then
begin
if( (item='*')or(item='/')or(item='^') ) then
begin
push(top,item);
end
else
begin
proses := proses+pop(top) ;
push(top,item);
end;
end;
end;
end;
{logikapop}end
else
begin
push(top,item);
end;
end;
end;
end;
procedure proses1(var top : stack_angka ; item : char ; var value : real);
var
angka,var1,var2,hasil : real;
i :integer;
begin
if((item<>'+') and (item<> '-') and (item<> '/') and (item<> '*') and (item<> '^')
and (item<> ')'))
then
begin
write(item,' : ');readln(angka);
push1(top,angka);
end
else
begin
if (item=')') then
begin
value := pop1(top);
end
else
begin
var1 := pop1(top);
var2 := pop1(top);
case item of
'+' : hasil := var2+var1;
'-' : hasil := var2-var1;
'/' : hasil := (var2)/(var1);
'*' : hasil := var2*var1;
else
begin
hasil := 0;
if hasil=0 then
begin
hasil := 1;
end;
for i:=1 to round(var1) do
begin
hasil := hasil * var2;
end;
end;
end;
push1(top,hasil);
end;
end;
end;
begin
buatstack(top);
buatstack1(top1);
writeln('masukkan variabel dan operator yang ingin anda hitung : ');
writeln;
writeln('>>> akhiri dengan ")" cth: a+b) <<<');
writeln;
write('rumus infiksnya : ');readln(angka);
writeln;
angka1 := angka+')';
panjang := length(angka1);
for i:=1 to (panjang) do
begin
item := angka1[i];
write(item,' ');
huruf(top,item,kar);
simpan := kar;
coba := top;
while (coba<>nil) do
begin
write(coba^.info);
coba := coba^.next;
end;
writeln;
//writeln(item);
end;
writeln;
writeln('bentuk postfixnya : ');
writeln(simpan);
writeln;
writeln('masukan nilai untuk setiap variabel');
simpan := simpan+')';
panjang := length(simpan);
for i:=1 to (panjang) do
begin
item := simpan[i];
proses1(top1,item,value);
end;
writeln;
write('hasilnya adalah : ');
writeln(value:0:2);
readln;
phapus := top;
while (phapus <> nil) do
begin
top := top^.next;
dispose(phapus);
phapus := top;
end;
top := nil;
phapus1 := top1;
while (phapus1 <> nil) do
begin
top1 := top1^.next;
dispose(phapus1);
phapus1 := top1;
end;
top1 := nil;
end.
type
stack = ^isi;
rekam2 = record
info : char;
next : stack;
end;
isi = rekam2;
stack_angka = ^isi1;
rekam1 = record
info : real;
next : stack_angka;
end;
isi1 = rekam1;
var
panjang,i : integer;
angka,angka1,simpan,kar: string;
top,phapus,coba : stack;
top1,coba1,phapus1 :stack_angka;
item : char;
value : real;
procedure buatstack(var top : stack) ;
var
baru:stack;
begin
new(baru);
baru^.info := '(';
baru^.next := nil;
top := baru;
end;
procedure buatstack1(var top : stack_angka) ;
var
baru:stack_angka;
begin
new(baru);
baru:=nil;
top := baru;
end;
function kosong(var top : stack) : boolean;
begin
kosong := false;
if (top=nil) then
kosong := true;
end;
function kosong1(var top : stack_angka) : boolean;
begin
kosong1 := false;
if (top=nil) then
kosong1 := true;
end;
function satusimpul(var top : stack) : boolean;
begin
satusimpul := false;
if (top^.next=nil) then
satusimpul := true;
end;
function satusimpul1(var top : stack_angka) : boolean;
begin
satusimpul1 := false;
if (top^.next=nil) then
satusimpul1 := true;
end;
procedure sisip_depan(var top : stack ; item : char);
var
baru : stack;
begin
new(baru);
baru^.info := item;
baru^.next := top;
top := baru;
end;
procedure sisip_depan1(var top : stack_angka ; angka : real);
var
baru : stack_angka;
begin
new(baru);
baru^.info := angka;
baru^.next := top;
top := baru;
end;
procedure push(var top : stack ; item : char);
var
baru : stack;
begin
if kosong(top) then
begin
new(baru);
baru^.info := item;
baru^.next := nil;
top:=baru;
end
else
sisip_depan(top,item);
//writeln('masuk push');
end;
procedure push1(var top : stack_angka ; angka : real);
var
baru : stack_angka;
begin
if kosong1(top) then
begin
new(baru);
baru^.info := angka;
baru^.next := nil;
top:=baru;
end
else
sisip_depan1(top,angka);
end;
function pop(var top : stack) : char;
var
phapus : stack;
begin
if ((not(kosong(top)))and (not(satusimpul(top)))) then
begin
phapus := top;
pop := top^.info;
top := top^.next;
dispose(phapus);
end;
end;
function pop1(var top : stack_angka) : real;
var
phapus : stack_angka;
begin
if ((not(kosong1(top)))and (not(satusimpul1(top)))) then
begin
phapus := top;
pop1 := top^.info;
top := top^.next;
dispose(phapus);
end
else
begin
phapus:=top;
pop1 := top^.info;
dispose(phapus);
new(top);
top:=nil;
end;
end;
procedure huruf(var top:stack ; var item:char; var proses : string);
var
benar : boolean;
begin
if((item<>'+') and (item<> '-') and (item<> '/') and (item<> '*') and (item<> '^')
and (item<> ')') and (item<> '('))
then
begin
proses := proses+item;
end
else
begin
if (item='(') then
begin
push(top,item);
end;
if (item=')') then
begin
while (top^.info <> '(') do
begin
proses := proses + pop(top);
end;
pop(top);
if(top^.info='(') then
begin
pop(top);
end;
end
else
begin
{operan}if((top^.info = '+') or (top^.info = '-')
or (top^.info = '*') or (top^.info = '/')
or (top^.info = '^')) then
begin
{logikapop}if((top^.info = '^')and((item='/')or(item='*')or(item='+')
or(item='-')or(item = '^')))then
begin
if (item='^') then
begin
proses := proses+pop(top);
push(top,item);
end;
if ((item='*') or (item='/')) then
begin
if((top^.info='^')and((top^.next^.info='*')or(top^.next^.info='/'))) then
begin
while ((top^.info<>'*')and(top^.info<>'/')) do
begin
proses := proses+pop(top);
end;
end;
proses := proses+pop(top);
push(top,item);
end;
if ((item='+') or (item='-')) then
begin
benar := true;
if((top^.info='^')and((top^.next^.info='*')or(top^.next^.info='/'))and((top^.next^.next^.info='-')or(top^.next^.next^.info='+'))) then
begin
while ((top^.info<>'-')and(top^.info<>'+')) do
begin
proses := proses+pop(top);
end;
end;
if((top^.info='^')and((top^.next^.info='*')or(top^.next^.info='/'))and((top^.next^.next^.info<>'-')or(top^.next^.next^.info<>'+'))) then
begin
while ((top^.info<>'*')and(top^.info<>'/')) do
begin
proses := proses+pop(top);
end;
end;
proses := proses+pop(top);
push(top,item);
end;
end
else
begin
if(((top^.info='*')or(top^.info='/')) and ((item='+')or(item='-')or
(item='^')or(item='*')or(item='/')) )then
begin
if (item='^') then
begin
push(top,item);
end;
if ((item='+') or (item='-')) then
begin
if(((top^.info='*')or(top^.info='/'))and((top^.next^.info='-')or(top^.next^.info='+'))) then
begin
while ((top^.info<>'+')and(top^.info<>'-')) do
begin
proses := proses+pop(top);
end;
end;
proses := proses+pop(top);
push(top,item);
end;
if ((item='*') or (item='/')) then
begin
proses := proses+pop(top);
push(top,item);
end;
end
else
begin
if( ((top^.info='-')or(top^.info='+')) and ((item='*')or(item='/')or
(item='^') or (item='+')or(item='-')) )then
begin
if( (item='*')or(item='/')or(item='^') ) then
begin
push(top,item);
end
else
begin
proses := proses+pop(top) ;
push(top,item);
end;
end;
end;
end;
{logikapop}end
else
begin
push(top,item);
end;
end;
end;
end;
procedure proses1(var top : stack_angka ; item : char ; var value : real);
var
angka,var1,var2,hasil : real;
i :integer;
begin
if((item<>'+') and (item<> '-') and (item<> '/') and (item<> '*') and (item<> '^')
and (item<> ')'))
then
begin
write(item,' : ');readln(angka);
push1(top,angka);
end
else
begin
if (item=')') then
begin
value := pop1(top);
end
else
begin
var1 := pop1(top);
var2 := pop1(top);
case item of
'+' : hasil := var2+var1;
'-' : hasil := var2-var1;
'/' : hasil := (var2)/(var1);
'*' : hasil := var2*var1;
else
begin
hasil := 0;
if hasil=0 then
begin
hasil := 1;
end;
for i:=1 to round(var1) do
begin
hasil := hasil * var2;
end;
end;
end;
push1(top,hasil);
end;
end;
end;
begin
buatstack(top);
buatstack1(top1);
writeln('masukkan variabel dan operator yang ingin anda hitung : ');
writeln;
writeln('>>> akhiri dengan ")" cth: a+b) <<<');
writeln;
write('rumus infiksnya : ');readln(angka);
writeln;
angka1 := angka+')';
panjang := length(angka1);
for i:=1 to (panjang) do
begin
item := angka1[i];
write(item,' ');
huruf(top,item,kar);
simpan := kar;
coba := top;
while (coba<>nil) do
begin
write(coba^.info);
coba := coba^.next;
end;
writeln;
//writeln(item);
end;
writeln;
writeln('bentuk postfixnya : ');
writeln(simpan);
writeln;
writeln('masukan nilai untuk setiap variabel');
simpan := simpan+')';
panjang := length(simpan);
for i:=1 to (panjang) do
begin
item := simpan[i];
proses1(top1,item,value);
end;
writeln;
write('hasilnya adalah : ');
writeln(value:0:2);
readln;
phapus := top;
while (phapus <> nil) do
begin
top := top^.next;
dispose(phapus);
phapus := top;
end;
top := nil;
phapus1 := top1;
while (phapus1 <> nil) do
begin
top1 := top1^.next;
dispose(phapus1);
phapus1 := top1;
end;
top1 := nil;
end.
Tidak ada komentar:
Posting Komentar