program tigastack;
uses wincrt;
type tumpukan = record
isi :
array[1..25] of byte;
top :
0..25;
end;
var t1,t2,t3 : tumpukan;
x,n,angka,bantu
: byte;
procedure tumpuk(var t : tumpukan;angka : byte);
begin
inc(t.top);
t.isi[t.top]
:= angka;
end;
procedure keluarkan(var t : tumpukan;var angka : byte);
begin
angka :=
t.isi[t.top];
dec(t.top);
end;
{procedure atur(var t : tumpukan; angka : byte);
begin
repeat
keluarkan(t,bantu);
tumpuk(t3,bantu);
until
(t.isi[t.top] > angka) or (t.top = 0);
tumpuk(t,angka);
repeat
keluarkan(t3,bantu);
tumpuk(t,bantu);
until t3.top =
0;
end; }
procedure cetak(t : tumpukan);
begin
repeat
keluarkan(t,angka);
write(angka:3);
until t.top =
0;
end;
begin
t1.top := 0;
t2.top := 0; t3.top := 0;
repeat
clrscr;
writeln('PROGRAM APLIKASI STACK(tumpukan data)':50);
write('Silakan Tentukan banyaknya angka acak [5 sampai 25] :
');readln(n);
until n
in[5..25];
for x := 1 to
n do
begin
write('Angka ke ',x,' : ');readln(angka);
if angka
mod 2 = 0 then
tumpuk(t1,angka)
else
tumpuk(t2,angka);
end;
repeat
keluarkan(t1,angka);
if
t3.top = 0 then
tumpuk(t3,angka)
else
begin
if
angka > t3.isi[t3.top] then
tumpuk(t3,angka)
else
begin
repeat
keluarkan(t3,bantu);
tumpuk(t2,bantu);
until (t3.isi[t3.top] < angka) or (t3.top = 0);
tumpuk(t3,angka);
repeat
keluarkan(t2,bantu);
tumpuk(t3,bantu);
until t2.isi[t2.top] mod 2 = 1;
end;
end;
until
t1.top=0;
repeat
keluarkan(t3,angka);
tumpuk(t1,angka);
until t3.top =
0;
writeln;
write('Angka
genap = ');
if t1.top = 0
then
write('Tidak ada angka genap !')
else
cetak(t1);
writeln;
write('Angka
ganjil = ');
if t2.top = 0
then
write('Tidak ada angka ganjil !')
else
cetak(t2);
readkey;
end.
0 komentar:
Posting Komentar