pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazStats: Add QuickSort routine.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7696 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-09-26 17:52:52 +00:00
parent 6678dc1af8
commit 3c23258256
1 changed files with 47 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
applications/lazstats/source/units/utils.pas
View File

@ -28,13 +28,15 @@ procedure Exchange(var a, b: String); overload;
procedure SortOnX(X: DblDyneVec; Y: DblDyneVec = nil; Z: DblDyneVec = nil);
procedure SortOnX(X: DblDyneVec; Y: DblDyneMat);
procedure QuickSortOnX(X: DblDyneVec; Y: DblDyneVec = nil; Z: DblDyneVec = nil);
function IndexOfString(L: StrDyneVec; s: String): Integer;
implementation
uses
ToolWin;
Math, ToolWin;
// https://stackoverflow.com/questions/4093595/create-ttoolbutton-runtime
procedure AddButtonToToolbar(AToolButton: TToolButton; AToolBar: TToolBar);
@ -179,6 +181,50 @@ begin
end;
end;
procedure QuickSortOnX(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;
function IndexOfString(L: StrDyneVec; s: String): Integer;
var
i: Integer;