Rabu, 07 Juli 2010

bagi yang kepepet ni ada sorting buat temen2

program sorting pascal:
program SORTINGMETHODS;
uses
Crt;

const
N = 14; (* NO. OF DATA TO BE SORTED *)
Digits = 3; (* DIGITAL SIZE OF THE DATA *)
Range = 1000; (* RANGE FOR THE RANDOM GENERATOR *)

type
ArrayType = array[1..N] of integer;
TwoDimension = array[0..9, 1..N] of integer; (* FOR RADIX SORT ONLY *)

var
Data : ArrayType;
D : integer;

(*--------------------------------------------------------------------*)

procedure GetSortMethod;
begin
clrscr;
writeln;
writeln(' CHOOSE: ');
writeln(' ');
writeln(' 1 FOR SELECT SORT ');
writeln(' 2 FOR INSERT SORT ');
writeln(' 3 FOR BUBBLE SORT ');
writeln(' 4 FOR SHAKE SORT ');
writeln(' 5 FOR RADIX SORT ');
writeln(' 6 TO EXIT ALLSORT ');
writeln(' ');
writeln;
readln(D)
end;

procedure LoadList;
var
I : integer;
begin
for I := 1 to N do
Data[I] := random(Range)
end;

procedure ShowInput;
var
I : integer;
begin
clrscr;
write('INPUT :');
for I := 1 to N do
write(Data[I]:5);
writeln
end;

procedure ShowOutput;
var
I : integer;
begin
write('OUTPUT:');
for I := 1 to N do
write(Data[I]:5)
end;

procedure Swap(var X, Y : integer);
var
Temp : integer;
begin
Temp := X;
X := Y;
Y := Temp
end;

(*-------------------------- R A D I X S O R T ---------------------*)

function Hash(Number, H : integer) : integer;
begin
case H of
3 : Hash := Number mod 10;
2 : Hash := (Number mod 100) div 10;
1 : Hash := Number div 100
end
end;

procedure CleanArray(var TwoD : TwoDimension);
var
I, J : integer;
begin
for I := 0 to 9 do
for J := 1 to N do
TwoD[I, J] := 0
end;

procedure PlaceIt(var X : TwoDimension; Number, I : integer);
var
J : integer;
Empty : boolean;
begin
J := 1;
Empty := false;
repeat
if (X[I, J] > 0) then
J := J + 1
else
Empty := true;
until (Empty) or (J = N);
X[I, J] := Number
end;

procedure UnLoadIt(X : TwoDimension; var Passed : ArrayType);
var
I,
J,
K : integer;
begin
K := 1;
for I := 0 to 9 do
for J := 1 to N do
begin
if (X[I, J] > 0) then
begin
Passed[K] := X[I, J];
K := K + 1
end
end
end;

procedure RadixSort(var Pass : ArrayType; N : integer);
var
Temp : TwoDimension;
Element,
Key,
Digit,
I : integer;
begin
for Digit := Digits downto 1 do
begin
CleanArray(Temp);
for I := 1 to N do
begin
Element := Pass[I];
Key := Hash(Element, Digit);
PlaceIt(Temp, Element, Key)
end;
UnLoadIt(Temp, Pass);
ShowOutput;
readln
end
end;



(*-------------------------- I N S E R T S O R T -------------------*)

procedure StrInsert(var X : ArrayType; N : integer);
var
J,
K,
Y : integer;
Found : boolean;
begin
for J := 2 to N do
begin
Y := X[J];
K := J - 1;
Found := false;
while (K >= 1)
and (not Found) do
if (Y < X[K]) then
begin
X[K + 1] := X[K];
K := K - 1
end
else
Found := true;
X[K + 1] := Y;
ShowOutput;
readln
end
end;


(*-------------------------- B U B B L E S O R T -------------------*)

procedure BubbleSort(var X : ArrayType; N : integer);
var
I,
J : integer;
begin
for I := 2 to N do
begin
for J := N downto I do
if (X[J] < X[J - 1]) then
Swap(X[J - 1], X[J]);
ShowOutput;
readln
end
end;

(*-------------------------- S H A K E S O R T ---------------------*)

procedure ShakeSort(var X : ArrayType; N : integer);
var
L,
R,
K,
J : integer;
begin
L := 2;
R := N;
K := N;
repeat
for J := R downto L do
if (X[J] < X[J - 1]) then
begin
Swap(X[J], X[J - 1]);
K := J
end;
L := K + 1;
for J := L to R do
if (X[J] < X[J - 1]) then
begin
Swap(X[J], X[J - 1]);
K := J
end;
R := K - 1;
ShowOutput;
readln;
until L >= R
end;


(*-------------------------- S E L E C T S O R T -------------------*)

procedure StrSelectSort(var X : ArrayType; N : integer);
var
I,
J,
K,
Y : integer;
begin
for I := 1 to N - 1 do
begin
K := I;
Y := X[I];
for J := (I + 1) to N do
if (X[J] < Y) then
begin
K := J;
Y := X[J]
end;
X[K] := X[J];
X[I] := Y;
ShowOutput;
readln
end
end;

(*--------------------------------------------------------------------*)

procedure Sort;
begin
case D of
1 : StrSelectSort(Data, N);
2 : StrInsert(Data, N);
3 : BubbleSort(Data, N);
4 : ShakeSort(Data, N);
5 : RadixSort(Data, N);
else
writeln('BAD INPUT')
end
end;

(*-------------------------------------------------------------------*)

BEGIN
GetSortMethod;
while (D <> 6) do
begin
LoadList;
ShowInput;
Sort;
writeln('PRESS ENTER TO RETURN');
readln;
GetSortMethod
end
END.

Tidak ada komentar:

Posting Komentar