menu

Rabu, 08 Februari 2012

Ascending & Discending

uses crt;
const max = 10;
type arr=array[1..max] of real;
var i : byte; data : arr;
procedure input; begin
clrscr;randomize;
for i :=1 to max do
begin
data[i] :=random(11);
end;
clrscr;
for i := 1 to max do
writeln;writeln ('data hasil random yang telah diurutkan :');
end;
procedure tukar(var a,b:real);var c : real;begin
c:=a;a:=b;b:=c;
end;
procedure ascending; var p,q :byte;flaq:boolean;begin
flaq:=false; p:=2;
while (p<max) and (not flaq) do
begin
flaq:=true;
for q:=max downto p do
begin
if data[q] <data[q-1] then
begin
tukar(data[q], data[q-1]);flaq:=false;
end; inc(i);
end;
end;
end;
procedure descending; var p,q :byte;flaq:boolean;begin
flaq:=false;p:=2;
while (p<max) and (not flaq) do
begin
flaq:=true;
for q:=max downto p do
begin
if data[q] > data [q-1] then
begin
tukar(data[q], data [q-1]);flaq:=false;
end; inc(i);
end;
end;
end;
procedure output; begin
for i:= 1 to max do
write(data[i]:3:0);writeln;
end;
begin
input; write('ascending : ');ascending; output;
write('descending : '); descending;output;readkey;
end.


Tidak ada komentar:

Posting Komentar