program tugas_struktur_data;
uses crt;
type simpul = ^data;
data = record
info : char;
berikut : simpul;
end;
var awal,akhir,bantu,bantu1,baru : simpul;
elemen, jawab : char;
pilihan : integer;
procedure buble;
type larik = array[1..100] of integer;
var i,n,k,temp : integer;
l : larik;
begin
clrscr;
writeln('PENGURUTAN DATA DENGAN METODE BUBLE SHORT');
writeln('banyak data yang di input : ');readln(n);
for i := 1 to n do
begin
write ('data ke ',i,' : ');readln(l[i]);
end;
for i := 1 to n-1 do
begin
for k :=n downto i+1 do
begin
if l[k] < l[k-1] then
begin
temp := l[k];
l[k] := l[k-1];
l[k-1] := temp;
end;
end;
end;
writeln;writeln('Data yang sudah terurut adalah');
for i := 1 to n do
write(l[i],'');
readln;
end;
procedure max;
type larik = array[1..100] of integer;
var i,n,u,j,max,imax,temp : integer;
l : larik;
begin
clrscr;
writeln('PENGURUTAN DATA DENGAN METODE MAKSIMUM SHORT');
write('banyak data yang di input : ');readln(n);
for i := 1 to n do
begin
write('data ke ',i,' : ');readln(l[i]);
end;
u := n;
for i := 1 to n-1 do
begin
max := l[1];
imax := 1;
for j := 2 to u do
begin
if l[j] > max then
begin
max := l[j];
imax := j;
end;
end;
temp := l[u];
l[u] := l[imax];
l[imax] := temp;
u := u-1;
end;
writeln;writeln('Data yang sudah teurut adalah ');
for u := 1 to n do
write(l[u],' ');
readln;
end;
procedure min;
type larik = array[1..100] of integer;
var i,n,u,j,min,imin,temp : integer;
l : larik;
begin
clrscr;
writeln('PENGURUTAN DATA DENGAN METODE MINIMUM SHORT');
write('banyak data yang di input : ');readln(n);
for i := 1 to n do
begin
write('data ke ',i,' : ');readln(l[i]);
end;
u := n;
for i :=1 to n-1 do
begin
imin := 1;
for j := 2 to u do
begin
if l[j] < l[imin] then
begin
imin := j;
end;
end;
temp := l[u];
l[u] := l[imin];
l[imin] := temp;
u := u-1;
end;
writeln;writeln('Data yang sudah teurut adalah ');
for u := 1 to n do
write(l[u],' ');
readln;
end;
procedure insert_first(var awal,akhir : simpul; elemen : char);
var baru : simpul;
begin
new(baru);
baru^.info := elemen;
if awal = nil then
begin
awal := baru;
akhir := baru;
akhir^.berikut := nil;
end
else
begin
baru^.berikut := awal;
awal := baru;
end;
end;
procedure insert_last(var awal,akhir : simpul; elemen : char);
var baru : simpul;
begin
new(baru);
baru^.info := elemen;
if awal = nil then
begin
awal := baru;
akhir := baru;
akhir^.berikut := nil;
end
else
begin
akhir^.berikut := baru;
akhir := baru;
akhir^.berikut := nil;
end;
end;
procedure insert_after(var awal,akhir : simpul; elemen : char);
var baru : simpul;
begin
new(baru);
baru^.info := elemen;
if awal = nil then
begin
awal := baru;
akhir := baru;
akhir^.berikut := nil;
end
else
begin
bantu := awal;
while elemen > bantu^.berikut^.info do
bantu := bantu^.berikut;
baru^.berikut := bantu^.berikut;
bantu^.berikut := baru;
end;
end;
procedure baca(awal,akhir: simpul);
var bantu : simpul;
begin
bantu := awal;
repeat
write (bantu^.info:2);
bantu := bantu^.berikut;
until bantu = nil;
writeln;
end;
begin
jawab := 'y';
while (jawab = 'Y') or (jawab ='y') do
begin
clrscr;
writeln('MENU');
writeln('---');
writeln('1. Buble');
writeln('2. Max');
writeln('3. Min');
writeln('4. Insert First');
writeln('5. Insert Last');
writeln('6. Insert After');
writeln('7. Baca Data');
writeln('8. Exit');
writeln('---');
write('Pilihan anda : ');readln(pilihan);
case pilihan of
1 : begin
writeln;
writeln('buble');
buble;
baca(awal,akhir);
readln;
end;
2 : begin
writeln;
writeln('max');
max;
baca(awal,akhir);
readln;
end;
3 : begin
writeln;
writeln('min');
min;
baca(awal,akhir);
readln;
end;
4 : begin
writeln;
writeln('Insert First');
write('elemen yang akan di insert : ');readln(elemen);
insert_first(awal,akhir,elemen);
baca(awal,akhir);
readln;
end;
5 : begin
writeln;
writeln('Insert Last');
write('elemen yang akan di insert : ');readln(elemen);
insert_last(awal,akhir,elemen);
baca(awal,akhir);
readln;
end;
6 : begin
writeln;
writeln('Insert After');
write('elemen yang akan di insert : ');readln(elemen);
insert_after(awal,akhir,elemen);
baca(awal,akhir);
readln;
end;
7 : begin
baca(awal,akhir);
readln;
end;
8 : begin
writeln('Exit');
jawab := 'T'
end;
end;
end;
readln;
end.
