Sunday 23 December 2012

Belajar contoh program pascal counting sort, selection sort, insertion sort, dan bubble sort.

Hari ini saya akan memberikan beberapa contoh source code sorting pada program pascal. Untuk keterangan dan teorinya tidak saya berikan karena sudah banyak di Google search. Bisa anda cari sendiri.  lihat tutorial dibawah ini.


1. Counting Sort


program counting_sort;

uses wincrt;
type
nilai = array[1..50] of integer;
var
nl : nilai;
mindata,maxdata: integer;
jumlah ,i:integer;
procedure isinilai(var nl:nilai; var n:integer);
var
j:integer;
begin
write('banyak data : ');
readln(n);
for j:=1 to n do
begin
write('data ke ',j,' : ');
readln(nl[j]);
end;
end;

procedure minmax(nl:nilai;n:integer;var mindata:integer;var maxdata:integer);

begin
mindata :=nl[1];
maxdata :=nl[1];
for i:=2 to n do
begin
if nl[i] < mindata then mindata :=nl[i];
if nl[i] > maxdata then maxdata :=nl[i];
end;
end;

procedure countsort(var tabint:nilai;n:integer;mindata:integer;maxdata:integer);

const min=1;max=100;
var
i,j,k:integer;
tabcount:array [min..max] of integer;
begin
for i:=mindata to maxdata do
tabcount[i]:=0;

for i:=1 to n do

tabcount[tabint[i]]:=tabcount[tabint[i]]+1;
k:=0;
for i :=mindata to maxdata do
if tabcount[i]<>0 then
for j:=1 to tabcount[i] do
begin
k:=k+1;
tabint[k]:=i;
end;
end;

procedure cetak(nl:nilai;n:integer);

begin
for i:=1 to n do
write(nl[i],' ');
writeln;
end;

begin

isinilai(nl,jumlah);
minmax(nl,jumlah,mindata,maxdata);
writeln('ini data sebelum diurutkan: ');
cetak(nl,jumlah);
countsort(nl,jumlah,mindata,maxdata);
writeln('ini data setelah diurutkan: ');
cetak(nl,jumlah);
readln;
end.





2. Insertion Sort

program insertion(input,output);
const
MAX = 100;
var
a : array[1..MAX] of integer;
i, n : integer;

procedure insertion_sort;
var
i, pos : integer;
nilai : integer;
tanda : boolean;
begin
for i := 2 to n do
begin

nilai := a[i];
pos := i;
tanda := false;
while not tanda do
begin
if pos <= 1 then
tanda := true
else if nilai >= a[pos-1] then
tanda := true
else
begin
a[pos] := a[pos-1];
pos := pos-1
end
end; {while}

a[pos] := nilai;

end {for}
end;

begin { main }
write('Masukkan banyak data (max=',MAX:2,') : ');
readln(n);

writeln('Masukkan Angka sebanyak ',n:1,' : ');
for i := 1 to n do
read(a[i]);

insertion_sort;

for i := 1 to n do
write(a[i]:1,' ');
readln;
writeln;
readln;
end.


3. Selection Sort

program selectionsort;
uses crt;
var
angka: array[1..5] of integer;
i,a,n,temp: integer;
begin
clrscr;
write('masukkan banyak data: ');
readln(n);
for i:=1 to n do
begin
write('masukkan angka ke',i,' = ');
readln(angka[i]);
end;
writeln;

{Tampilkan data sebelum diurutkan}
writeln('Sebelum diurutkan : ');
for i:=1 to n do
begin
writeln('angka ke-', i, ' : ', angka[i]);
end;

{Lakukan pengurutan/sorting}
for i:=1 to n-1 do
begin
for a:=i+1 to n do
begin
if(angka[a] < angka[i]) then
begin
temp := angka[a];
angka[a] := angka[i];
angka[i] := temp;
end;
end;
end;

{Tampilkan data setelah diurutkan}
writeln('Setelah diurutkan : ');
for i:=1 to n do
begin
writeln('angka ke-', i, ' : ', angka[i]);
readln;
end;
readln;
end.



4. Bubble Sort

Program Bubble_Sort;
Uses Crt;
const
max = 100;
type
Larik = array [1..max] of integer;
var
A: Larik;
I: integer;
N: integer;
pil:byte;

procedure Jumlah_Data;
begin
write('Masukkan banyaknya data = '); readln(N);
writeln;
end;
procedure Input;
var
I: integer;
begin
for I:=1 to N do
begin
write('Masukkan data ke- ', I, ' = '); readln(A[I]);
end;
end;

procedure Change(var A, B: integer);
var
T: integer;
begin
T:=A;
A:=B;
B:=T;
end;

procedure asc_buble;
var
p,q :INTEGER;
flag:boolean;
begin
flag:=false;
p:=2;
while (p
begin
flag:=true;
for q:=N downto p do
if A[q]
begin
change(A[q],A[q-1]);
flag:=false;
end;
inc(i);
end;
writeln;
write('Data Diurutkan Secara Ascending: ');
end;

procedure desc_buble;
var
p,q :byte;
flag:boolean;
begin
flag:=false;
p:=2;
while (p
begin
flag:=true;
for q:=max downto p do
if A[q]>A[q-1] then
begin
change(A[q],A[q-1]);
flag:=false;
end;
inc(i);
end;
writeln;
write('Data Diurutkan Secara Descending: ');
end;

procedure Output;
var
i: integer;
begin
for i:=1 to N do
write(A[i], '  ');
writeln;
end;

begin
Jumlah_Data;
input;
clrscr;
writeln('[1].pengurutan secara Ascending');
writeln('[2].pengurutan secara Descending');
write('Silahkan Masukkan Pilihan Anda = ');readln(pil);
case pil of
1:asc_buble;

2:desc_buble;
end;
output;
readln;
end.

Input


Output





Monday 17 December 2012