loading...
Belajar contoh program pascal
counting sort, selection sort, insertion sort, dan bublle 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. Enggak usah
basa-basi lagi,langsung lihat tutorial dibawah ini.
1.
Counting
sort.
program
countingsort;
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);
end.
untuk hasilnya bisa dilihat digambar dibawah ini :
2.
Selection
sort
program
selection_sort;
uses wincrt;
var
angka: array[1..14]
of integer;
j,a, temp: integer;
begin
angka[1] := 2;
angka[2] := 5;
angka[3] := 1;
angka[4] := 19;
angka[5] := 3;
angka[6] := 2;
angka[7] := 11;
angka[8] := 44;
angka[9] := 10;
angka[10] := 5;
angka[11] := 1;
angka[12] := 2;
angka[13] := 1;
angka[14] := 9;
writeln('Sebelum
diurutkan : ');
for j:=1 to 14 do
begin
write(', no', j, '
: ', angka[j]);
end;
for j:=1 to 14 do
begin
for a:=j+1 to 14 do
begin
if(angka[a] <
angka[j]) then
begin
temp := angka[a];
angka[a] :=
angka[j];
angka[j] := temp;
end;
end;
end;
writeln(' ');
writeln('Setelah
diurutkan : ');
for j:=1 to 14 do
begin
writeln('angka
ke-', j, ' : ', angka[j]);
end;
readln;
end.
untuk hasilnya :
3.
Insertion
sort
Program
insertion_sort;
uses wincrt;
var
jmldata,i,j:integer;
data,x:array
[1..100] of integer;
procedure
asc_insert;
var temp:integer;
begin
For i := 2 to
jmldata do
Begin
Temp :=data[i];
j := i-1;
while (data[j] >
temp) and (j>0) do
begin
data[j+1] :=
data[j];
dec(j);
end;
data[j+1]:=temp;
end;
writeln('urutan
datanya adalah: ');
for i:=1 to jmldata
do
begin
write(data[i],'
');
end;
readln;
end;
begin
clrscr;
write('masukkan
berapa angka yang akan di urut: '); readln(jmldata);
for i:=1 to jmldata
do
begin
write('masukkan
angka ke-',i,':'); readln(data[i]);
end;
asc_insert;
readln;
end.
hasilnya :
4.
Bublle
sort
Program
Bubble_Sort;
Uses WinCrt;
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<N) and
(not flag) do
begin
flag:=true;
for q:=N 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 Ascending: ');
end;
procedure
desc_buble;
var
p,q :byte;
flag:boolean;
begin
flag:=false;
p:=2;
while (p<max)
and (not flag) do
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;
end.
hasilnya :
Semoga bermanfaat
buat kita semua beberapa contoh program pascal diatas.
loading...
thx bro, atas informasinya
ReplyDelete