Program Pascal untuk mengubah Notasi Infix ke Notasi Postfix kemudian menghitungnya berdasarkan angka yang diinputkan oleh user.
program Implementasi_Stack; uses crt; const max = 255; type AInfix = string[max]; Pointer = ^Stack; Stack = record info : char; next : Pointer; end; Point = ^Angka; Angka = record info : real; next : Point; end; var Top : Pointer; TopA : Point; Infix : AInfix; Huruf : string; ATop : integer; elemen : char; data : real; lagi : char; hasil : real; Function Kosong(list:Pointer):boolean; begin Kosong:=false; if(list = nil) then Kosong:=true; end; Function Panjang(kata:string):integer; begin Panjang:=length(kata); end; Function Salah(k:string):boolean; var i : integer; SetOperator : set of char; begin SetOperator:=['^']+['*']+['/']+['+']+['-']; for i:=1 to Panjang(k) do begin if((k[i] in SetOperator) and (k[i+1] in SetOperator)) or (k[Panjang(k)] in SetOperator) or (k[1] in SetOperator) then begin Salah:=true; end; end; end; Function Derajat(opr:char):integer; begin case opr of '^' : Derajat:=3; '*','/' : Derajat:=2; '+','-' : Derajat:=1; end; end; Function Pangkat(m,n:real):real; begin if(n = 0) then Pangkat := 1 else Pangkat := m * Pangkat(m,n-1); end; Function Kali(m,n:real):real; begin if(n = 1) then Kali := m else Kali := m + Kali(m,n-1); end; Procedure Inisialisasi(var Top:Pointer; var ATop:integer; var TopA:Point); begin Top:=nil; ATop:=0; TopA:=nil; end; Procedure Isi(var Infix:Ainfix); var stop : boolean; begin stop:=false; while(not stop) do begin textcolor(WHITE);write('Notasi Infix : '); readln(Infix); if(Salah(Infix)) or (Infix = '') then begin gotoxy(55,whereY-1);textcolor(GREEN);writeln('Input Salah !'); writeln; end else stop:=true; end; end; Procedure Push(var Top:Pointer; databaru:char); var baru : Pointer; begin new(baru); baru^.info:=databaru; if(Kosong(Top)) then baru^.next:=nil else baru^.next:=Top; Top:=baru; end; Procedure Pop(var Top:Pointer; var elemen:char); var phapus : Pointer; begin phapus:=Top; elemen:=phapus^.info; if(Kosong(Top^.next)) then Top:=nil else Top:=Top^.next; dispose(phapus); end; Procedure Tampung(var ATop:integer; var Huruf:string; elemen:char); begin ATop:=ATop+1; Huruf[ATop]:=elemen; end; Procedure Postfix(var Top:Pointer); var i : integer; SetOperator : set of char; Simbol : char; begin SetOperator := ['^']+['*']+['/']+['+']+['-']; Push(Top,'('); Infix[Panjang(Infix)+1]:=')'; for i:=1 to Panjang(Infix)+1 do begin Simbol:=Infix[i]; if(Simbol = '(') then Push(Top,Simbol) else if(Simbol = ')') then begin repeat Pop(Top,elemen); Tampung(ATop,Huruf,elemen); until(Top^.info = '('); Pop(Top,elemen); end else if(Simbol in SetOperator) then begin while(Top^.info <> '(') and (Derajat(Top^.info) >= Derajat(Simbol)) do begin Pop(Top,elemen); Tampung(ATop,Huruf,elemen); end; Push(Top,Simbol); end else Tampung(ATop,Huruf,Simbol); end; if(Kosong(Top)) then begin for i:=1 to ATop do begin write(Huruf[i]); end; end; end; Procedure PushAngka(var TopA:Point; databaru:real); var baru : Point; begin new(baru); baru^.info:=databaru; if(TopA = nil) then baru^.next:=nil else baru^.next:=TopA; TopA:=baru; end; Procedure PopAngka(var TopA:Point; var data:real); var phapus : Point; begin phapus:=TopA; data:=phapus^.info; if(TopA^.next = nil) then TopA:=nil else TopA:=TopA^.next; dispose(phapus); end; Procedure HitungPostfix(var TopA:Point; var hasil:real); var i : integer; SetOperator : set of char; Simbol : char; a,b,angka,hitung : real; begin SetOperator := ['^']+['*']+['/']+['+']+['-']; Huruf[ATop+1] := ')'; for i:=1 to ATop+1 do begin Simbol:=Huruf[i]; if(Simbol in SetOperator) then begin PopAngka(TopA,data); b:=data; PopAngka(TopA,data); a:=data; case Simbol of '^' : hitung := Pangkat(a,b); '*' : hitung := Kali(a,b); '/' : hitung := a / b; '+' : hitung := a+b; '-' : hitung := a-b; end; PushAngka(TopA,hitung); end else if(Simbol = ')') then begin PopAngka(TopA,data); hasil:=data; end else begin write(' Masukkan Nilai ',Simbol,' : '); readln(angka); PushAngka(TopA,angka); end; end; end; begin repeat Inisialisasi(Top,ATop,TopA); clrscr; Isi(Infix); writeln; write('Notasi Postfix : '); Postfix(Top); writeln;writeln; HitungPostfix(TopA,hasil);writeln; write('Hasil Perhitungan Postfix : ',hasil:0:2); writeln;writeln;writeln; write('Input Notasi Infix lagi [Y/T] : '); readln(lagi); until(lagi = 'T') or (lagi = 't'); end.
Screenshot: