Assalamu'alaikum wr. wb.
Alhamdulillahirobbil'alamin
Program ketiga Algoritma & Pemrograman II Selesai
1. Screen shot program
 |
| Gambar 1.1 Tampilan awal program saat di run, input banyak data. |
 |
Gambar
1.2 Menginput data angka sesuai dengan banyak data yang diinput tadinya, kemudian
tekan enter data terurut.
|
2. Source Code Program
Program
HeapSort;
uses crt;
type Angka
= array[0..100] of string;
var Data :
Angka;
i, n: integer;
Procedure
temp (var a, b : string);
Var tmp :
string;
begin
tmp
:= a;
a :=
b;
b :=
tmp;
end;
procedure
SB (var Data: Angka; M, S: integer);
var akr,
ank : integer;
Begin
akr
:= M;
while
(akr*2+1 <= S) do
begin
ank
:= akr*2+1;
if
(ank < S) and (Data[ank] < Data[ank+1]) then
ank:=ank+1;
if
(Data[akr] < Data[ank]) then
begin
temp (Data[akr], Data[ank]);
akr := ank;
end
else
break;
end;
End;
Procedure
temp2 (var Data: angka; cnt: integer);
var M :
integer;
Begin
M :=
(cnt-1) div 2;
while
(M >= 0) do
begin
SB
(Data, M, cnt-1);
M:=M-1;
end;
End;
Procedure
heapSort(var Data : angka; n : integer);
var S :
integer;
Begin
temp2(Data,
n);
S :=
n-1;
while
(S > 0 ) do
begin
temp(Data[s], Data[0]);
s:=s-1;
SB(Data, 0, S);
end;
End;
BEGIN
Clrscr;
writeln('H e a p S o r t i n g ');
writeln('~~~~~~~~~~~~~~~~~~~~~~ ');
writeln;
write('Input Banyak Data : '); readln(n);
writeln('~~~~~~~~~~~~~~~~~~~~~');
for
i := 0 to n-1 do
begin
write('Data angka ke-',i+1:2,': ');
readln(Data[i]);
end;
writeln('~~~~~~~~~~~~~~~~~~~~~~');
heapsort (Data, n);
writeln;
writeln('Data Terurut');
writeln('~~~~~~~~~~~~');
for i := 0 to n-1 do
begin
writeln('Data angka ke-',i+1:2,': ',Data[i]);
end;
readkey;
END.
|
0 komentar :
Posting Komentar