You've already forked lazarus-ccr
21484fc4bd
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7925 8e941d3f-bd1b-0410-a28a-d453659cc2b4
90 lines
1.4 KiB
ObjectPascal
90 lines
1.4 KiB
ObjectPascal
program project1;
|
|
|
|
uses
|
|
math;
|
|
|
|
type
|
|
DblDyneVec = array of double;
|
|
|
|
procedure Exchange(var a, b: Double);
|
|
var
|
|
tmp: Double;
|
|
begin
|
|
tmp := a;
|
|
a := b;
|
|
b := tmp;
|
|
end;
|
|
|
|
|
|
procedure QuickSortOn(X: DblDyneVec; Y: DblDyneVec = nil; Z: DblDyneVec = nil);
|
|
|
|
procedure DoQuickSort(L, R: Integer);
|
|
var
|
|
I,J: Integer;
|
|
P: Integer;
|
|
begin
|
|
repeat
|
|
I := L;
|
|
J := R;
|
|
P := (L + R) div 2;
|
|
repeat
|
|
while CompareValue(X[P], X[I]) > 0 do inc(I);
|
|
while CompareValue(X[P], X[J]) < 0 do dec(J);
|
|
if I <= J then begin
|
|
if I <> J then begin
|
|
Exchange(X[I], X[J]);
|
|
if Y <> nil then
|
|
Exchange(Y[I], Y[J]);
|
|
if Z <> nil then
|
|
Exchange(Z[I], Z[J]);
|
|
end;
|
|
|
|
if P = I then
|
|
P := J
|
|
else if P = J then
|
|
P := I;
|
|
|
|
inc(I);
|
|
dec(J);
|
|
end;
|
|
until I > J;
|
|
|
|
if L < J then
|
|
DoQuickSort(L, J);
|
|
|
|
L := I;
|
|
until I >= R;
|
|
end;
|
|
|
|
begin
|
|
DoQuickSort(0, High(X));
|
|
end;
|
|
|
|
|
|
var
|
|
x: DblDyneVec;
|
|
y: DblDyneVec;
|
|
i: Integer;
|
|
begin
|
|
SetLength(x, 10);
|
|
SetLength(y, 10);
|
|
|
|
for i := 0 to High(x) do
|
|
begin
|
|
x[i] := Random(100);
|
|
y[i] := i;
|
|
end;
|
|
|
|
for i := 0 to High(x) do
|
|
WriteLn('i: x=', x[i]:0:0, ' y=', y[i]:0:0);
|
|
WriteLn;
|
|
|
|
QuickSortOn(X, Y);
|
|
|
|
for i := 0 to High(x) do
|
|
WriteLn(i, ': x=', x[i]:0:0, ' y=', y[i]:0:0);
|
|
|
|
ReadLn;
|
|
end.
|
|
|