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:

Read More

Algoritma dan Pascal Formula S

Algoritma dan Program Pascal untuk menghitung :

S = 1 - 2/3 + 3/5 - 4/7 + ...

Sebelum kita membuat Algoritma dan Program diatas, maka terlebih dahulu kita tentukan POLA yang digunakan oleh Deret S tersebut. Adapun pola yang digunakan oleh Deret S diatas adalah :

S = i / (2i-1)

misal : 

• i = 1  -->  S = 1/(2.1-1)   -->   S = 1/1
• i = 2  -->  S = 2/(2.2-1)   -->   S = 2/3
• i = 3  -->  S = 3/(2.3-1)   -->   S = 3/5
•  . . .
• i = n  -->  S = i / (2.i-1)    -->   S = i / (2i-1)

          

Bentuk Algoritma Formula/Rumus S

Algoritma formulas
{I.S : diinputkan satu bilangan oleh user}
{F.S : menampilkan hasil perhitungan rumus S}

Deklarasi:
 i : integer
 n : integer
 s : real
 
Algoritma:
 input(n)
 
 s <- 0
 for i <- 1 to n do
  if i mod 2 = 1 then
   s <- s+(i/(2*i-1))
  else
   s <- s-(i/(2*i-1))
  endif
 endfor
 
 output('S = ',s:0:2)

Bentuk Pascal Formula/Rumus S

program formulas;
uses crt;

var
   i : integer;
   n : integer;
   s : real;

begin
     write('Masukkan Banyak Deret Pecahan : '); readln(n);
     writeln();

     s := 0;
     for i:=1 to n do
     begin
          if i mod 2 = 1 then
              s:=s+(i/(2*i-1))
          else
              s:=s-(i/(2*i-1));
     end;

     writeln();
     write('S = ',s:0:2);

     readkey();
end.

Screenshot :

input/output

Read More

Algoritma dan Pascal Deret Bilangan Ganjil

Algoritma dan Program Pascal untuk menampilkan jumlah deret bilangan ganjil.

Bentuk Algoritma Deret Bilangan Ganjil

Algoritma deretbilanganganjil
{I.S : diinputkan satu bilangan oleh user}
{F.S : menampilkan jumlah deret bilangan ganjil}

Deklarasi:
 x   : integer
 akhir  : integer
 jumlah  : integer
 
Algoritma:
 input(akhir)
 
 jumlah <- 0
 for x <- 1 to akhir do
  if x mod 2 = 1 then
   jumlah <- jumlah+x
  endif
 endfor
 
 output('Jumlah Deret Bilangan Ganjil dari 1 sampai ',x,' = ',jumlah)

Bentuk Pascal Deret Bilangan Ganjil

program deretbilanganganjil;
uses crt;

var
   x      : integer;
   akhir  : integer;
   jumlah : integer;

begin
     write('Masukkan batas akhir angka : '); readln(akhir);
     writeln();

     jumlah := 0;
     for x:=1 to akhir do
     begin
          if x mod 2 = 1 then
             jumlah := jumlah + x;
     end;

     write('Jumlah Deret Bilangan Ganjil dari 1 sampai ',akhir,' = ',jumlah);
     readkey();
end.

Screenshot :

input

output

Read More

Algortima dan Pascal Segitiga Bintang

Algoritma dan Program Pascal untuk menyelesaikan kasus seperti di bawah ini (warna bintang setiap baris dibedakan).

N=3

*

**

***

**

*

Bentuk Algoritma Segitiga Bintang

Algoritma segitigabintang
{I.S : Diinputkan satu angka oleh user}
{F.S : Menampilkan barisan segitiga bintang}

Deklarasi:
 n : integer
 i : integer
 j : integer
 
Algoritma:
 input(n)
 
 for i <- 1 to n do
  for j <- 1 to i do
   output('*')
  endfor
  output('')
 endfor
 
 for i <- n-1 downto 1 do
  for j <- 1 to i do
   output('*')
  endfor
  output('')
 endfor

Bentuk Program Pascal Segitiga Bintang dimana warna bintang setiap baris dibedakan.

program segitigabintang;
uses crt;

var
   n : integer;
   i : integer;
   j : integer;

begin
     write('Masukkan Jumlah Baris Segitiga Bintang : '); readln(n);
     clrscr();

     i := 0;
     j := 0;
     for i:=1 to n do
     begin
          for j:=1 to i do
          begin
               write('*');
          end;
          writeln(''); textcolor(i);
     end;

     for i:=n-1 downto 1 do
     begin
          for j:=1 to i do
          begin
               write('*');
          end;
          writeln(''); textcolor(j);
     end;
     readkey();
end.

Screenshot :

input

output

Read More