Информация об изменениях

Сообщение Re[9]: Оптимизация через разделение/вынос функционала от 22.06.2024 18:21

Изменено 22.06.2024 18:33 Khimik

Старый текст
Новый текст
Разница

Re[9]: Оптимизация через разделение/вынос функционала

Здравствуйте, 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;

Учите матчасть.

Re[9]: Оптимизация через разделение/вынос функционала

procedure TList<T>.SetCapacity(Value: Integer);
begin
  if Value < Count then
    Count := Value;
  SetLength(FItems, Value);
end;

Скрытый текст

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;

Учите матчасть.