Program pascal Pengurutan gelembung

Program Pengurutan_gelembung;
uses wincrt ;
type
Larik = array [1..1000] of integer;
Var
H : Larik;
stop : integer;

Procedure Input ( Var H : Larik; m : integer );
var
n : integer;
begin
for n := 1 to m do
begin
write ('Data Ke-',n,' : ');readln(H[n]);
end;
end;

Procedure BubbleNaik ( Var H : Larik; m : integer );
var
k, l, temp : integer;
begin
for k := 1 to (m-1) do
for l := m downto (k+1) do
if H[l] < H[l-1] then
begin temp := H[l];
H[l] := H[l-1];
H[l-1] := temp;
end;
end;

Procedure BubbleTurun ( Var H : Larik; m : integer );
var k, l, temp : integer;
begin
for k := 1 to (m-1) do
for l := m downto (k+1) do
if H[l] > H[l-1]
then
begin
temp := H[l];
H[l] := H[l-1];
H[l-1]:= temp;
end;
end;

Procedure Selection_Max_Naik ( Var H: Larik; m : integer );
var
o, p, omaks, temp : integer;
begin
for o := m downto 2 do
begin
omaks := 1;
for p := 2 to o do
if H[p] > H[omaks] then
omaks := p;
temp := H[o];
H[o] := H[omaks];
H[omaks] := temp;
end;
end;

Procedure Selection_Max_Turun ( Var H : Larik; m : integer );
var o, p, omaks, temp : integer;
begin
for o := 1 to (m-1) do
begin
omaks := o;
for p := o + 1 to m do
if H[p] > H[omaks]
then
omaks := p;
temp := H[o];
H[o] := H[omaks];
H[omaks] := temp;
end;
end;

Procedure Selection_Min_Naik ( Var H : Larik; m : integer );
var
x, y, xmin, temp : integer;
begin
for x := 1 to (m-1) do
begin
xmin := x;
for y := x + 1 to m do
if H[y] < H[xmin] then
xmin := y;
temp := H[x];
H[x] := H[xmin];
H[xmin]:= temp;
end;
end;

Procedure Selection_Min_Turun ( Var H : Larik; m : integer );
var
x, y, xmin, temp : integer;
begin
for x := m downto 2 do
begin
xmin := 1;
for y := 2 to x do
if H[y] < H[xmin] then
xmin := y;
temp := H[x];
H[x] := H[xmin];
H[xmin]:= temp;
end;
end;

Procedure OutPut ( m : integer );
var
r : integer;
begin
for r := 1 to m do
write (H[r]:5);
end;
Begin
write ('Masukkan Jumlah Data yang diinginkan : ');readln(stop); writeln;
writeln('Masukkan Data Secara Acak : ');
Input (H,stop);writeln;
BubbleNaik(H,stop);
write('a. Hasil Pengurutan Gelembung Menaik :');writeln;
OutPut(stop);writeln;
BubbleTurun(H,stop);
write('   HasilPengurutan Gelembung Menurun :');writeln;
OutPut(stop);writeln;
Selection_Max_Naik(H,stop);writeln;
write('b. Hasil Pengurutan Seleksi Maksimum Menaik :');writeln;
Output(stop);
Selection_Max_Turun(H,stop);writeln;
write('   Hasil Pengurutan Seleksi Maksimum Menurun :');writeln;
OutPut(stop);writeln;
Selection_Min_Naik(H,stop);writeln;
write('c. Hasil Pengurutan Seleksi Minimum Menaik :');writeln;;
OutPut(stop);
Selection_Min_Turun(H,stop);writeln;
write('   Hasil Pengurutan Seleksi Minimum Menurun :');writeln;;
OutPut(stop);writeln;
writeln ('                =================================') ;
writeln ('                                 ©Dandee Al-Baihaqi©');
writeln ('                                     Ninety Nine Nightmare') ;
writeln ('                        http://99-nightmare.blogspot.com/');
writeln ('                =================================') ;
End.

Share on :

Tweet