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