Здравствуйте, swame, Вы писали:
S>System.Generics.Collections
S>поддерживается с Delphi 2009
Ну да я посмотрел — там идёт заполнение нулями через стандартный setlength:
procedure TList<T>.SetCapacity(Value: Integer);
begin
if Value < Count then
Count := Value;
SetLength(FItems, Value);
end;
Поэтому и дольше. Я вставил ваш код, получилось что мой superqsort очень медленный — в три раза медленнее QuickSort, а QuickSort в полтора раза медленнее QSort10Sections. Мой же класс tdoublearray с процедурой QSort10Sections, код которого я приводил выше, работает ещё на 30% быстрее.
Вот ещё раз полностью мой код:
| Скрытый текст |
| TDoubleArray=class(tsafeobject)
public
fcount:integer;
fcapacity:integer;
fitems:pdoublearr;
procedure SetCount(newcount:integer);
procedure SetCapacity(newcapacity:integer);
procedure Add(value:double);
procedure QSort2GPT;
procedure QSort10Sections;
property Count:integer read fcount write setcount;
property Capacity:integer read fcapacity write SetCapacity;
procedure Grow;
end;
procedure TDoubleArray.SetCount(newcount: integer);
begin
if newcount>fcapacity then setcapacity(newcount);
fcount := newcount;
end;
procedure TDoubleArray.SetCapacity(newcapacity: integer);
begin
if NewCapacity < fCount then
raise exception.Create('NewCapacity='+inttostr(NewCapacity));
if NewCapacity <> fCapacity then
begin
ReallocMem(fitems, NewCapacity * SizeOf(double));
FCapacity := NewCapacity;
end;
end;
procedure TDoubleArray.Add(value: double);
begin
fcount:=fcount+1;
if fcount>fcapacity then grow;
fitems^[fcount-1]:=value;
end;
procedure TDoubleArray.Grow;
begin
if fcapacity<100 then setcapacity(100) else
setcapacity(fcapacity*2);
end;
procedure TDoubleArray.QSort2GPT;
var
arr:array of double;
q:integer;
procedure QSort(low,high:integer);
var
i, j: Integer;
pivot, temp: double;
begin
i := low;
j := high;
pivot := arr[(low + high) div 2];
repeat
while arr[i] < pivot do
Inc(i);
while arr[j] > pivot do
Dec(j);
if i <= j then
begin
temp := arr[i];
arr[i] := arr[j];
arr[j] := temp;
Inc(i);
Dec(j);
end;
until i > j;
if low < j then
QSort(low, j);
if i < high then
QSort(i, high);
end;
begin
if count<=1 then exit;
setlength(arr,count);
for q:=0 to count-1 do arr[q]:=fitems[q];
qsort(0,count-1);
for q:=0 to count-1 do fitems[q]:=arr[q];
setlength(arr,0);
end;
procedure TDoubleArray.QSort10Sections;
const
SectionsCount=100;
var
sectionsize:integer;
Sections:array[0..SectionsCount-1] of tdoublearray;
q,w:integer;
minval,maxval:double;
interval:double;
begin
if fcount<300 then begin
QSort2GPT;
exit;
end;
minval:=MaxSafeFloat;
maxval:=-MaxSafeFloat;
for q:=0 to fcount-1 do begin
if fitems[q]<minval then minval:=fitems[q];
if fitems[q]>maxval then maxval:=fitems[q];
end;//next q
minval:=minval-minsafefloat;
maxval:=maxval+minsafefloat;
interval:=maxval-minval;
sectionsize:=fcount div sectionscount;
for q:=0 to sectionscount-1 do begin
sections[q]:=TDoubleArray.Create;
sections[q].Capacity:=sectionsize*10;
end;
for q:=0 to fcount-1 do begin
sections[floor((sectionscount-1)*(fitems[q]-minval)/interval)].Add(fitems[q]);
end;
count:=0;
for q:=0 to SectionsCount-1 do begin
sections[q].QSort10Sections;
for w:=0 to sections[q].fcount-1 do add(sections[q].fitems[w]);
sections[q].Free;
end;
end;
procedure TMainForm.Button9Click(Sender: TObject);
var
firsttime:longword;
q,w:integer;
curarray:tdoublearray;
begin
RandSeed :=0;
firsttime:=GetTickCount;
for q:=0 to 80 do begin
curarray:=tdoublearray.Create;
curarray.Capacity:=100000;
for w:=0 to 99999 do curarray.Add(random);
curarray.QSort10Sections;
curarray.Free;
end;//next q
caption:=inttostr(GetTickCount-firsttime);
end;
|
| |
Учите матчасть.
"Ты должен сделать добро из зла, потому что его больше не из чего сделать". АБ Стругацкие.