Rabu, 06 Juni 2012

Program Stack ( Struktur Data )

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.

Tidak ada komentar:

Posting Komentar