13 Januari 2009

Quick Sort (Turbo Pascal)


{ Quick Sort
g0tch4.blogspot.com }

uses crt;
const
max = 10;
type
arr = array [1..max] of byte;
var
data :arr;
x,y :byte;

procedure input;
begin
clrscr;
writeln ('Program Sorting Data dengan Quick Sort');
writeln;
writeln ('Inputkan 10 buah bilangan :');
writeln ('---------------------------');
for x:= 1 to max do
begin
write ('Data ke-',x,'= '); readln (data[x]);
end;
clrscr;
writeln ('Data Sebelum diurutkan: ');
writeln ('---------------------------');
for x:= 1 to max do
write (data[x],' ');
writeln;writeln;
writeln('Data Sesudah diurutkan:');
writeln('---------------------------');
end;

procedure change(var a,b :byte);
var c : byte;
begin
c:=a; a:=b; b:=c;
end;

procedure asc_quick(l,r :integer);
var
mid,j,k :integer;
begin
j:=l; k:=r; mid:=(l+r) div 2;
repeat
while data [j] <> data [mid] do dec(k);
if j<=k then begin change (data [j],data[k]); inc(j); dec(k); end; until j>k;
if l <> data[mid] do inc(j);
while data [k] <>k;
if l < k then desc_quick(l,k);
if j < r then desc_quick(j,r);
end;

procedure output;
begin
for x :=1 to max do
write(data[x],' ');
writeln;
end;

begin
input;
asc_quick(1,max);write('Secara Ascending : ');
output;
desc_quick(1,max);write('Secara Descending : ');
output;
readkey;
end.

1 komentar:

Unknown mengatakan...

terima kasih mas semoga bermanfaat,...
izin sedot,...