Data Structure practice 2nd Meeting

This 2nd meeting is really confused for me, because i can’t finish one of my task no 4. Here is the list of the task :

1.  Stack by certain input


program stack;
uses wincrt;
var
a,b,c,top:byte;
data:array[1..20] of integer;
x:integer;
lagi:char;
procedure push;
begin
 if top>=20 then
 writeln('Stack Penyh')
 else if top<20 then
 begin
 write('data = ');read(x);

 if x=999 then
 begin
 exit;
 end;

 if x>=60 then
 begin
 if top>=20 then
 begin
 writeln('penuh');
 end
 else if top<=20 then
 begin
 top:=top+1;
 data[top]:=x;
 end;
 end;

 if x<60 then
 begin
 if top>=0 then
 begin
 x:=data[top];
 top:=top-1;
 end
 else if top<=0 then
 writeln('stack kosong');

 end;
 end
 else
 writeln('error');

end;

procedure pop;
begin
 if top<=0 then
 writeln('stack kosong')
 else if top >=0 then
 begin
 x:=data[top];
 top:=top-1;
 end;

end;

procedure show;
begin
 for b:=1 to top do
 writeln('INDEX[',b,']=',data[b]);
end;

begin
top:=0;
repeat

writeln('LIST');
writeln('1.  PUSH');
writeln('2.  POP');
writeln('3.  SHOW');
write('pilih = ');read(a);
case a of
1:push;
2:pop;
3:show;
else
writeln('salah ');
end;

write('lagi = ');read(lagi);read(lagi);read(lagi);
until (lagi='y') or (lagi='Y')

end.

2.  Checking arithmatic expression

1st Version


program matching_parenthesis;
uses wincrt;
var
data,stack:array[1..20]of char;
a,b,top:byte;
lagi,c:char;
eks:string;
buka,tutup:byte;
begin
top:=0;
buka:=0;
tutup:=0;
write('masukkan ekspresi = ');read(eks);
 a:=length(eks);
 for b:=1 to a do
 begin
 data[b]:=eks[b];
 end;

 for b:=1 to a do
 begin
 if data[b]='(' then
 begin
 buka:=buka+1;
 top:=top+1;
 stack[top]:=data[b];
 end
 else if data[b]=')' then
 begin
 tutup:=tutup+1;
 if top=0 then
 begin
 writeln('terjadi kesalahan');
 writeln('berarti ada simbol ) tetapi tidak ada simbol ( yang seharusnya mendahului');
 end
 else if top<>0 then
 begin
 if buka=tutup then
 begin
 writeln('benar');
 writeln('ada pasangannya');
 c:=data[b];
 top:=top-1;
 end
 else if buka>tutup then
 writeln('salah');
 end;
 end
 end;

end.

or 2nd version


program parenthesis;
uses wincrt;
var
data:array[1..20]of char;
a,b,c,buk,tup:byte;
e:string;
begin
buk:=0;
tup:=0;
write('data = ');read(e);
a:=length(e);
for b:=1 to a do
begin
 data[b]:=e[b];
end;

for b:=1 to a do
begin
 if data[b]='(' then
 buk:=buk+1
 else if data[b]=')' then
 tup:=tup+1;
end;

 if buk=tup then
 write('benar')
 else
 write('salah');

end.

3.  infix to postfix

4.  Box as stack function


program gudang;
uses wincrt;
var
data:array[1..10]of byte;
bantu,i,top,pil,nilai:byte;
nama:string;
utama:char;

procedure ambil;
var
lagi:byte;
begin
repeat
 if top=0 then
 begin
 writeln('kosong');
 exit;
 end
 else
 writeln('                        =====================');
 for i:=top downto 1 do
 begin
 case data[i] of
 1:nama:='permen';
 2:nama:='kue';
 3:nama:='biskuit';
 4:nama:='mie';
 5:nama:='beras';
 end;
 writeln('|':24,i,'=',nama:10,'|':10);
 end;
 writeln('                        =====================');
 write('data yang ke berapat yang akan diambil = ');read(nilai);
 for i:=nilai to top-1 do
 begin
 data[i]:=data[i+1];
 end;
 top:=top-1;
 writeln('                        =====================');
 for i:=top downto 1 do
 begin
 case data[i] of
 1:nama:='permen';
 2:nama:='kue';
 3:nama:='biskuit';
 4:nama:='mie';
 5:nama:='beras';
 end;
 writeln('|':25,nama:10,'|':10);
 end;
 writeln('                        =====================');
writeln('1 untuk berhenti');
writeln('2 untuk ulang');
write('ulang (1 / 2)= ');readln(lagi);
until lagi=1;

end;

procedure isi;
var
ulang:byte;
begin
repeat
writeln(' pilih barang ');
writeln('1.  permen');
writeln('2.  kue');
writeln('3.  biskuit');
writeln('4.  mie');
writeln('5.  beras');
write('pilih = ');read(pil);

 case pil of
 1:nilai:=1;
 2:nilai:=2;
 3:nilai:=3;
 4:nilai:=4;
 5:nilai:=5;
 else
 writeln('salah pilihan');
 end;

 if top=0 then
 begin
 top:=top+1;
 data[top]:=nilai;
 end
 else if top=10 then
 writeln('penuh')
 else
 begin
 top:=top+1;
 for i:=(top-1) downto 1 do
 begin
 if nilai>=data[i] then
 begin
 bantu:=data[i];
 data[i]:=nilai;
 data[i+1]:=bantu;
 end;
 end;
 end;
 writeln('                        =====================');
 for i:=top downto 1 do
 begin
 case data[i] of
 1:nama:='permen';
 2:nama:='kue';
 3:nama:='biskuit';
 4:nama:='mie';
 5:nama:='beras';
 end;
 writeln('|':25,nama:10,'|':10);
 end;
 writeln('                        =====================');
writeln('1 untuk berhenti');
writeln('2 untuk ulang');
write('ulang (1 / 2)= ');readln(ulang);
until (ulang=1);

end;

begin

top:=0;

repeat
writeln('pilih operasi');
writeln('1.  isi');
writeln('2.  ambil');
write('pilih = ');read(pil);
case pil of
1:isi ;
2 :ambil;
else
writeln('salah');
end;
write('menu utama (y / t)= ');readln(utama);
until (utama='t') or (utama='T');

end.

For the other source code i’m gonna finish it later

2 thoughts on “Data Structure practice 2nd Meeting

  1. matsay 11/02/2010 at 5:47 pm Reply

    fotomya ganti si biar keren gak kayak pekerja di belakang rkb itu………. he he he ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    • xaxioza 11/03/2010 at 8:07 am Reply

      g’ Punya Foto Yng Bgs. Cuma itu satu2 nya …………

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: