Pascal Infix ke Postfix

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:

Posted in : Algoritma, Pascal