Здравствуйте, swame, Вы писали: S>Мой тест показал, что твой алгоритм сопоставим по +/- по скорости со стандартным TList <double>.Sort S>(как раз из за того что внутри использует QSort2GPT) S>и, как и прежде в 2-5 раз медленней quick QSort2GPT. S>При этом расходует в 100 раз и больше памяти. на 5 млн элементов уже переполняет память. S>ты просто замедлил отсебятиной QSort2GPT S>Так что на помойку и хватит бредить.
А вы покажите полностью код для вашего теста. Могу предположить, что ваш вариант медленнее из-за заполнения нулями динамических массивов при инициализации. У меня используется мой класс tdoublearray, представляющий собой кастомный динамический массив:
Скрытый текст
TDoubleArray=class(tsafeobject)
private
public
fcount:integer;
fcapacity:integer;
procedure SetCount(newcount:integer);
procedure SetCapacity(newcapacity:integer);
//procedure SetCapacityQuick(newcapacity:integer);
//Странно, выходит и setcapacity не заполняет нулями. И setcount значит тожеfunction GetItem(index: integer): double;
procedure SetItem(index: integer; Value: double);
public
fitems:pdoublearr;
procedure CopyToSimpleArray(var arr:array of double);
destructor Destroy; override;
property Items[index:integer]:double read GetItem write SetItem; default;
property Count:integer read fcount write setcount;
property Capacity:integer read fcapacity write SetCapacity;
function FirstPointer:pdoublearr;
procedure Grow;
procedure Clear;
function SafeGetItem(ind:integer; errval:double):double;//Если выходит за границы индекса - возвращает errvalfunction TryGetItem(ind:integer; out res:double):boolean;
procedure SetZeroValues(newcount:integer);
procedure SetBlankValues(newcount:integer; newval:double);
procedure Add(value:double);
procedure AddArray(otherarray:tdoublearray);
procedure SwapPoints(pointnum1,pointnum2:integer);
procedure Assign(otherarray:tdoublearray);
procedure SortByGrowing;
function LinInterValue(kx:double):double;//kx-положение в массиве (в вещественных координатах);0 - первая точка, 1 - вторая, 0.5 - посерединеfunction LagrInterpValue(kx:double; polnum:integer):double;//Интерполяция по Лагранжу: polnum - стенень полинома (должно быть четное число). 2 - линейная интерполяцияfunction SumValues:double;
function MaxValue:double;
function HasNonZeroValues:boolean;
procedure QSort(ascending:boolean);
procedure SmoothAdjacentAveraging(numpoints:integer);
procedure GetValuesInterval(minval,maxval:double; out minn,maxn:integer);//определяет интервал точек, попадающих
//в указанные границы (предполагается что точки в массиве расположены по возрастанию)function GetSortedNums(ascending:boolean):tintarray;
//Возвращает список номеров своих элементов, отсортированных по возрастанию (если ascending=true) или убываниюfunction ValuesAreEquiDistant(out beg,step:double):boolean;//Возвращает false если чисел 0 или 1
//Также возвращает false если все значения равныfunction ValuesAreSubsequent(out beg,step:double):boolean;//Возвращает true если идёт непрерывная последовательность эквидистантных значений, постоянно увеличивающихся
//Возвращает false если чисел 0; если 1, возвращает true и step 1procedure AddValues(val:double);
procedure MultValues(val:double);
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;
Я получил выигрыш в скорости 30% для массивов из 100 000 чисел с равномерно распределенными random-ами.
И если вы даже не можете сразу понять принцип моего алгоритма (и почему он работает быстро), это очередной пример что "профессиональные программеры" с rsdn могут заимствовать чужие идеи, но не генерировать свои. Я в КСВ об этом создал тему.
"Ты должен сделать добро из зла, потому что его больше не из чего сделать". АБ Стругацкие.
Здравствуйте, Khimik, Вы писали: K>Здравствуйте, swame, Вы писали: S>>Мой тест показал, что твой алгоритм сопоставим по +/- по скорости со стандартным TList <double>.Sort S>>(как раз из за того что внутри использует QSort2GPT) S>>и, как и прежде в 2-5 раз медленней quick QSort2GPT. S>>При этом расходует в 100 раз и больше памяти. на 5 млн элементов уже переполняет память. S>>ты просто замедлил отсебятиной QSort2GPT S>>Так что на помойку и хватит бредить. K>А вы покажите полностью код для вашего теста. Могу предположить, что ваш вариант медленнее из-за заполнения нулями динамических массивов при инициализации. У меня используется мой класс tdoublearray, представляющий собой кастомный динамический массив:
Скрытый текст
tdoublearray = class (TList<double>)
boolarr:array of boolean;
arr2:array of double;
procedure superqsort;
procedure Log (FN: string; bCnt: boolean=true);
procedure QuickSort(low, high: Integer);
procedure QSort4;
procedure QSort10Sections;
procedure DoQSort(intervalbeg,intervallast:integer; hasminval,hasmaxval:boolean; minval,maxval:double);
end;
procedure tdoublearray.Log (FN: string; bCnt: boolean=true);
var
S, SCNT: string;
i: integer;
SA: TStringArray;
begin
SetLength (SA, count);
for i := 0 to count-1 do begin
SA [i] := Items[i].ToString;
end;
S := JoinStr (SA, ' ');
if bCnt then
SCNT := count.ToString
else
SCNT := '';
LOgger.AppendS (FN+'_'+SCNT + '.txt', S);
end;
procedure tdoublearray.superqsort;
var
q:integer;
sumval, midval, tmpval: double;
tmparray1, tmparray2: tdoublearray;
tmp: double;
begin//Log;if count<=1 then exit;
if count=2 then begin
if items[1]<items[0] then begin
tmp:=items[1];
items[1]:=items[0];
items[0]:=tmp;
end;
exit;
end;
sumval:=0;
for q:=0 to count-1 do
sumval:=sumval+items[q];
midval:=sumval/count;
tmparray1:=tdoublearray.create;
tmparray1.capacity:=count;
tmparray2:=tdoublearray.create;
tmparray2.capacity:=count;
for q:=0 to count-1 do begin
if items[q]>midval then
tmparray2.add(items[q])
else
tmparray1.add(items[q]);
end;
tmparray1.superqsort;
tmparray2.superqsort;
for q:=0 to tmparray1.count-1 do
items[q]:=tmparray1.items[q];
for q:=0 to tmparray2.count-1 do
items[tmparray1.count+q]:=tmparray2.items[q];
tmparray1.free;
tmparray2.free;
end;
procedure tdoublearray.QSort4;
begin
setlength(arr2,count);
setlength(boolarr,count);
DoQSort(0, count-1,false,false,0,0);
setlength(arr2,0);
setlength(boolarr,0);
end;
procedure tdoublearray.DoQSort(intervalbeg,intervallast:integer; hasminval,hasmaxval:boolean; minval,maxval:double);
const
MaxFloat=1E50;
var
curcount:integer;
aveval:double;
ii:integer;
curvalscount:integer;
lowvalscount:integer;
tmpval:double;
begin
curcount:=intervallast-intervalbeg+1;
if curcount<=1 then exit;//Всего один элемент, сортировать не надоif curcount=2 then
begin
if (Items[intervalbeg]<Items[intervallast])<>true then
begin
tmpval:=Items[intervalbeg];
Items[intervalbeg]:=Items[intervallast];
Items[intervallast]:=tmpval
end;
exit;
end;
if not hasminval then
begin
minval:=MaxFloat;
for ii:=intervalbeg to intervallast do if Items[ii]<minval then minval:=Items[ii];
end;
if not hasminval then
begin
maxval:=-MaxFloat;
for ii:=intervalbeg to intervallast do if Items[ii]>maxval then maxval:=Items[ii];
end;
aveval:=(minval+maxval)*0.5;
for ii:=intervalbeg to intervallast do boolarr[ii]:=(Items[ii]<aveval);
//Помещаем элементы, меньшие aveval, в первую часть arr2:
curvalscount:=0;
for ii:=intervalbeg to intervallast do if boolarr[ii]=true then
begin
inc(curvalscount);
arr2[intervalbeg+curvalscount-1]:=Items[ii];
end;
lowvalscount:=curvalscount;
if (lowvalscount=0) or (lowvalscount=curcount) then
exit;//Все элементы в интервале равны, сортировать нельзя
//Помещаем элементы, большие или равные aveval, в первую часть arr2:for ii:=intervalbeg to intervallast do if boolarr[ii]=not true then
begin
inc(curvalscount);
arr2[intervalbeg+curvalscount-1]:=Items[ii];
end;
//Перемещаем arr2 в arr1:for ii:=intervalbeg to intervallast do Items[ii]:=arr2[ii];
doqsort(intervalbeg,intervalbeg+lowvalscount-1,true,false,minval,0);
doqsort(intervalbeg+lowvalscount,intervallast,false,true,0,maxval);
end;
procedure TDoubleArray.QSort10Sections;
const
SectionsCount=100;
MaxSafeFloat= 1E9;
minsafefloat= 1E-9;
var
sectionsize:integer;
Sections:array[0..SectionsCount] of tdoublearray;
q,w:integer;
minval,maxval:double;
interval:double;
begin
if count<300 then begin//Log ('C:\tems3\q10_', false);
QuickSort (0, Count-1);
exit;
end;
minval:=MaxSafeFloat;
maxval:=-MaxSafeFloat;
for q:=0 to count-1 do begin
if items[q]<minval then minval:=items[q];
if items[q]>maxval then maxval:=items[q];
end;//next q
minval:=minval-minsafefloat;
maxval:=maxval+minsafefloat;
interval:=maxval-minval;
sectionsize:=count div sectionscount;
for q:=0 to sectionscount-1 do begin
sections[q]:=TDoubleArray.Create;
sections[q].Capacity:=sectionsize*10;
end;
for q:=0 to count-1 do begin
sections[floor((sectionscount-1)*(items[q]-minval)/interval)].Add(items[q]);
end;
count:=0;
for q:=0 to SectionsCount-1 do begin
if q < SectionsCount-1 then begin
sections[q].QSort10Sections;
for w:=0 to sections[q].count-1 do
add(sections[q].items[w]);
end;
sections[q].Free;
end;
end;
*procedure tdoublearray.QuickSort(low, high: Integer);
var
i, j: Integer;
pivot, temp: double;
begin
i := low;
j := high;
pivot := Items[(low + high) div 2];
repeat
while Items[i] < pivot do
Inc(i);
while Items[j] > pivot do
Dec(j);
if i <= j then
begin
temp := Items[i];
Items[i] := Items[j];
Items[j] := temp;
Inc(i);
Dec(j);
end;
until i > j;
if low < j then
QuickSort(low, j);
if i < high then
QuickSort(i, high);
end;
procedure TestDoubleArray (L: integer; Cicles: integer);
var
A, A1: tdoublearray;
i, j: integer;
S: string;
begin
A:= tdoublearray.Create;
A1 := tdoublearray.Create;
A.Count := L;
for i :=0 to L-1 do
A [i] := Random (1000) + Random (1000) / 1000 + i / 100000000;
S := 'standard' + ' ' + L.ToString + ' ' + Cicles.ToString;
A1.Clear;
A1.AddRange (A);
TB (S);
for i := 1 to Cicles do begin
if i > 1 then begin
A1.Clear;
A1.AddRange (A);
end;
A1.Sort;
end;
TE (S);
if L <= 10000000 then begin
S := 'super' + ' ' + L.ToString + ' ' + Cicles.ToString;
A1.Clear;
A1.AddRange (A);
TB (S);
for i := 1 to Cicles do begin
if i > 1 then begin
A1.Clear;
A1.AddRange (A);
end;
A1.superqsort;
end;
TE (S);
S := 'q4' + ' ' + L.ToString + ' ' + Cicles.ToString;
A1.Clear;
A1.AddRange (A);
TB (S);
for i := 1 to Cicles do begin
if i > 1 then begin
A1.Clear;
A1.AddRange (A);
end;
A1.QSort4;
if (i = 1) and (L <= 100000) then
A1.Log ('C:\tems3\q4');
end;
TE (S);
S := 'q10' + ' ' + L.ToString + ' ' + Cicles.ToString;
A1.Clear;
A1.AddRange (A);
TB (S);
for i := 1 to Cicles do begin
if i > 1 then begin
A1.Clear;
A1.AddRange (A);
end;
A1.QSort10Sections;
if (i = 1) and (L <= 100000) then
A1.Log ('C:\tems3\q10');
end;
TE (S);
end;
S := 'quick' + ' ' + L.ToString + ' ' + Cicles.ToString;
A1.Clear;
A1.AddRange (A);
TB (S);
for i := 1 to Cicles do begin
if i > 1 then begin
A1.Clear;
A1.AddRange (A);
end;
A1.QuickSort (0, A1.Count-1);
if (i = 1) and (L <= 100000) then
A1.Log ('C:\tems3\quick');
end;
TE (S);
A.Free;
A1.Free;
end;
initialization
Initializer.RegisterProc (ipLast,
procedure
var
i: integer;
begin
TestDoubleArray (1000, 1000);
TestDoubleArray (1000000, 1);
TestDoubleArray (2000000, 1);
// TestDoubleArray (10000000, 1);
//TestDoubleArray (50000000, 1);end);
K>Я получил выигрыш в скорости 30% для массивов из 100 000 чисел с равномерно распределенными random-ами. K>И если вы даже не можете сразу понять принцип моего алгоритма (и почему он работает быстро), это очередной пример что "профессиональные программеры" с rsdn могут заимствовать чужие идеи, но не генерировать свои. Я в КСВ об этом создал тему.
Re[7]: Оптимизация через разделение/вынос функционала
Здравствуйте, swame, Вы писали:
S> tdoublearray = class (TList<double>)
Сорри, что такое TList<double> ? Я попробовал это задать, подключил модуль system.classes и там можно сослаться только на просто tlist, т.е. это старый класс из Delphi7, без дженериков. А какой у вас Delphi?
Вы посмотрите, как в вашем TList обрабатывается SetCapacity — полагаю массив заполняется нулями, а это заведомо тормозит алгоритм.
"Ты должен сделать добро из зла, потому что его больше не из чего сделать". АБ Стругацкие.
Re[8]: Оптимизация через разделение/вынос функционала
Здравствуйте, Khimik, Вы писали:
K>Здравствуйте, swame, Вы писали:
S>> tdoublearray = class (TList<double>)
K>Сорри, что такое TList<double> ? Я попробовал это задать, подключил модуль system.classes и там можно сослаться только на просто tlist, т.е. это старый класс из Delphi7, без дженериков. А какой у вас Delphi?
System.Generics.Collections
поддерживается с Delphi 2009
Эти контейнеры развиваются от версии к версии, собранные более поздними версиями могут работать существенно быстрее, возможно в разы.
Есть такой чувак Дмитрий Мозулев, он раньше он был фанатом оптимизации, у него есть библиотека Rapid.Generics,
можно найти на гитхабе, в прежние времена (десятые года)его контейнеры обгоняли стандартные контейнеры Delphi в 2-4 раза,
в отличие от тебя прекрасно знает нутрянку Delphi и действительно в отличие от тебя может написать оптимизированнынй алгоритм.
НО последние годы стандартные контейнеры Delphi были хорошо оптимизированы и видимо догнали его контейнеры, я давно не тестил.
Теперь нет смысла оптимизировать на этом уровне, уже видимо оптимизировано близко к пределу.
K>Вы посмотрите, как в вашем TList обрабатывается SetCapacity — полагаю массив заполняется нулями, а это заведомо тормозит алгоритм.
ну посмотри если интересно, думаю едва ли больше 1% времени работы.
Здравствуйте, 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;
Учите матчасть.
"Ты должен сделать добро из зла, потому что его больше не из чего сделать". АБ Стругацкие.
K>tmparray:=tarray.create;
K>tmparray.count:=count;
K>for i:=0 to count-1 do tmparray.fitems[i]:=arr[i];
K>tmparray.superqsort;
K>for i:=0 to count-1 do arr[i]:=tmparray[i];
K>tmparray.free;
K>
Чот я не понял — зачем создавать отдельный массив, копировать данные в него, сортировать его и копировать обратно?
Re[2]: Оптимизация через разделение/вынос функционала
K>>tmparray:=tarray.create;
K>>tmparray.count:=count;
K>>for i:=0 to count-1 do tmparray.fitems[i]:=arr[i];
K>>tmparray.superqsort;
K>>for i:=0 to count-1 do arr[i]:=tmparray[i];
K>>tmparray.free;
K>>
M>Чот я не понял — зачем создавать отдельный массив, копировать данные в него, сортировать его и копировать обратно?
Так удобнее, чем писать сортировку внутри какого-то кода где это потребовалось. Мне кажется мой код в данном случае очень простой и понятный.
"Ты должен сделать добро из зла, потому что его больше не из чего сделать". АБ Стругацкие.
Re[10]: Оптимизация через разделение/вынос функционала
K>Поэтому и дольше. Я вставил ваш код, получилось что мой superqsort очень медленный — в три раза медленнее QuickSort, а QuickSort в полтора раза медленнее QSort10Sections. Мой же класс tdoublearray с процедурой QSort10Sections, код которого я приводил выше, работает ещё на 30% быстрее.
Не вижу замеры
Re[11]: Оптимизация через разделение/вынос функционала
K>>Поэтому и дольше. Я вставил ваш код, получилось что мой superqsort очень медленный — в три раза медленнее QuickSort, а QuickSort в полтора раза медленнее QSort10Sections. Мой же класс tdoublearray с процедурой QSort10Sections, код которого я приводил выше, работает ещё на 30% быстрее.
S>Не вижу замеры
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;
"Ты должен сделать добро из зла, потому что его больше не из чего сделать". АБ Стругацкие.
Re[3]: Оптимизация через разделение/вынос функционала
Здравствуйте, Khimik, Вы писали:
K>Здравствуйте, swame, Вы писали:
K>>>Поэтому и дольше. Я вставил ваш код, получилось что мой superqsort очень медленный — в три раза медленнее QuickSort, а QuickSort в полтора раза медленнее QSort10Sections. Мой же класс tdoublearray с процедурой QSort10Sections, код которого я приводил выше, работает ещё на 30% быстрее.
S>>Не вижу замеры
Не вижу замеры
Цифры сравнения разных алгоритмов с твоими и стандартными дженериковыми листами.
Re[13]: Оптимизация через разделение/вынос функционала
Здравствуйте, swame, Вы писали:
S>Не вижу замеры S>Цифры сравнения разных алгоритмов с твоими и стандартными дженериковыми листами.
Ну хорошо, вот ещё раз замерил:
tdoublearray.QSort10Sections — 858 ms (это мой tdoublearray без заполнения нулями)
tdoublearray.QSort1Old(true) — 3245 ms (это мой алгоритм в оп)
tdoublearray.QSort2GPT — 1201 ms (это алгоритм от gpt который тут выкладывали, только с инициализацией вспомогательного массива arr в котором выполняется эта сортировка)
tdoublearray.QSort5GPTNoExtraArr — 1233 ms (то же самое, только не используется вспомогательный массив, сразу запускается эта стандартная сортировка с Хоаром, обрабатывающая fitems класса tdoublearray)
tdoublearray1.superqsort — 8471 ms (tdoublearray1 это то что вы выложили, обертка над tlist<double>, мой алгоритм в оп)
tdoublearray1.QuickSortStandHoar — 2918 ms (стандартная сортировка с Хоаром, вызов QuickSort(0,count-1); )
tdoublearray1.QSort10Sections — 1154 ms (моя сортировка с секциями, то же что в tdoublearray.QSort10Sections).
"Ты должен сделать добро из зла, потому что его больше не из чего сделать". АБ Стругацкие.
Re[14]: Оптимизация через разделение/вынос функционала
Здравствуйте, Khimik, Вы писали:
K>Здравствуйте, swame, Вы писали:
S>>Не вижу замеры S>>Цифры сравнения разных алгоритмов с твоими и стандартными дженериковыми листами.
K>Ну хорошо, вот ещё раз замерил:
K>tdoublearray.QSort10Sections — 858 ms (это мой tdoublearray без заполнения нулями)
K>tdoublearray.QSort1Old(true) — 3245 ms (это мой алгоритм в оп)
K>tdoublearray.QSort2GPT — 1201 ms (это алгоритм от gpt который тут выкладывали, только с инициализацией вспомогательного массива arr в котором выполняется эта сортировка)
А сколько QSort2GPT без ненужного дополнительного массива?
K>tdoublearray.QSort5GPTNoExtraArr — 1233 ms (то же самое, только не используется вспомогательный массив, сразу запускается эта стандартная сортировка с Хоаром, обрабатывающая fitems класса tdoublearray)
K>tdoublearray1.superqsort — 8471 ms (tdoublearray1 это то что вы выложили, обертка над tlist<double>, мой алгоритм в оп)
K>tdoublearray1.QuickSortStandHoar — 2918 ms (стандартная сортировка с Хоаром, вызов QuickSort(0,count-1); )
непонятно что это, тот что я выкладывал или K>tdoublearray1.QSort10Sections — 1154 ms (моя сортировка с секциями, то же что в tdoublearray.QSort10Sections).
Сколько QSort2GPT на tdoublearray1? Алгоритм который я выкладывал?
Сколько стандартный sort на tdoublearray1? Вызов Sort
И кстати тест на 32 или 64 разрядах? Я делал на 32
Здравствуйте, swame, Вы писали: K>>tdoublearray.QSort2GPT — 1201 ms (это алгоритм от gpt который тут выкладывали, только с инициализацией вспомогательного массива arr в котором выполняется эта сортировка) S>А сколько QSort2GPT без ненужного дополнительного массива?
Это tdoublearray.QSort5GPTNoExtraArr, 1233 мс.
Там с одной стороны экономится время на копирование, но с другой стороны идёт обращение к свойству fitems класса tdoublearray, а это указатель на указатель на массивоуказатель. K>>tdoublearray.QSort5GPTNoExtraArr — 1233 ms (то же самое, только не используется вспомогательный массив, сразу запускается эта стандартная сортировка с Хоаром, обрабатывающая fitems класса tdoublearray) K>>tdoublearray1.superqsort — 8471 ms (tdoublearray1 это то что вы выложили, обертка над tlist<double>, мой алгоритм в оп) K>>tdoublearray1.QuickSortStandHoar — 2918 ms (стандартная сортировка с Хоаром, вызов QuickSort(0,count-1); ) S>непонятно что это, тот что я выкладывал или
Вот она:
Скрытый текст
procedure tdoublearray1.QuickSortStandHoar;
begin
QuickSort(0,count-1);
end;
procedure tdoublearray1.QuickSort(low, high: Integer);
var
i, j: Integer;
pivot, temp: double;
begin
i := low;
j := high;
pivot := Items[(low + high) div 2];
repeat
while Items[i] < pivot do
Inc(i);
while Items[j] > pivot do
Dec(j);
if i <= j then
begin
temp := Items[i];
Items[i] := Items[j];
Items[j] := temp;
Inc(i);
Dec(j);
end;
until i > j;
if low < j then
QuickSort(low, j);
if i < high then
QuickSort(i, high);
end;
Видимо это медленнее потому, что идёт обращение к items, а в моём варианте сначала создаётся массив и к нему обращаться можно быстрее (указатель на массив а не указатель на указатель на массив). S>Сколько QSort2GPT на tdoublearray1? Алгоритм который я выкладывал?
Вроде QuickSortStandHoar или QuickSort(0,count-1) это она и есть. S>Сколько стандартный sort на tdoublearray1? Вызов Sort
В смысле библиотечная функция? Я её не сравнивал, там же надо отдельно функцию-компаратор определить, мне это было лень. S>И кстати тест на 32 или 64 разрядах? Я делал на 32
У меня 64.
"Ты должен сделать добро из зла, потому что его больше не из чего сделать". АБ Стругацкие.
А что, на делфи не принято делать отступы для логических блоков в коде? Невозможно же читать эту простыню. Страшно даже представить, что у вас будет в реальных проектах.
Здравствуйте, SaZ, Вы писали:
K>>...
SaZ>А что, на делфи не принято делать отступы для логических блоков в коде? Невозможно же читать эту простыню. Страшно даже представить, что у вас будет в реальных проектах.
Мне кажется, что как у меня — удобнее. Может это какая-то моя специфика. Конечно если устроюсь в контору — придётся переучиваться.
Часто бывает удобно, например, поместить блок begin end с несколькими операторами в одну строку, потому что смысл блока понятен и часто эти блоки повторяются (в моём коде выше это есть).
"Ты должен сделать добро из зла, потому что его больше не из чего сделать". АБ Стругацкие.
Здравствуйте, Khimik, Вы писали:
K>Здравствуйте, SaZ, Вы писали:
K>>>...
SaZ>>А что, на делфи не принято делать отступы для логических блоков в коде? Невозможно же читать эту простыню. Страшно даже представить, что у вас будет в реальных проектах.
K>Мне кажется, что как у меня — удобнее. Может это какая-то моя специфика. Конечно если устроюсь в контору — придётся переучиваться. K>Часто бывает удобно, например, поместить блок begin end с несколькими операторами в одну строку, потому что смысл блока понятен и часто эти блоки повторяются (в моём коде выше это есть).
Это никак не противоречит нормальным отступам.
Зато эти отступы позволяют быстро видеть границы "вертикальных" блоков, а не выискивать глазами очередной end среди нагромождения ключевых слов:
procedure tdoublearray.superqsort;
var
q:integer;
sumval, midval, tmpval: double;
tmparray1, tmparray2: tdoublearray;
begin
if count <= 1 then exit;
if count = 2 then begin
if fitems[1] < fitems[0] then begin tmp := fitems[1]; fitems[1] := fitems[0]; fitems[0 ]:= tmp; end;
exit;
end; // вот этот end - он от какого begin? Отступы позволяют сразу это увидеть, не тратя мозг на поиск незакрытых begin вверх по тексту
sumval := 0;
for q := 0 to count do sumval := sumval + fitems[q];
midval := sumval / count;
tmparay1 := tdoublearray.create;
tmparray1.capacity := сount; // почему нельзя сразу передать capacity в конструктор?
tmparray2 := tdoublearray.create;
tmparray2.capacity := count;
for q := 0 to count-1 do if fitems[q] > midval then tmparray2.add(fitems[q]) else tmparray1.add(fitems[q]);
tmparray1.superqsort;
tmparray2.superqsort;
for q := 0 to tmparray1.count - 1 do fitems[q]:=tmparray1.fitems[q];
for q := 0 to tmparray2.count - 1 do fitems[tmparray1.count + q] := tmparray2.fitems[q];
tmparray1.free;
tmparray2.free;
end;
Уйдемте отсюда, Румата! У вас слишком богатые погреба.
Я ещё чуть соптимизировал свой алгоритм, уменьшив изначальный размер массивов в секциях:
[cut]
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*2;
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;
[/cut]
end;
Я тут заменил
sections[q].Capacity:=sectionsize*10;
на
sections[q].Capacity:=sectionsize*2;
Мне вообще удивительно, почему так вышло. Я думал, чем больше этот размер, тем лучше (если хватает на всё памяти). Если его сделать маленьким — лишнее время будет уходить на пересоздавание массивов и перефрагментирование, когда в capacity не влезает count. Но почему с большим размером тоже скорость чуть помедленнее — для меня странно. Вроде ReallocMem в Delphi не заполняет массив нулями? Значит лишние такты уходят на какое-то перефрагментирование?
"Ты должен сделать добро из зла, потому что его больше не из чего сделать". АБ Стругацкие.
Здравствуйте, Sinclair, Вы писали:
S>Зато эти отступы позволяют быстро видеть границы "вертикальных" блоков, а не выискивать глазами очередной end среди нагромождения ключевых слов:
Я часто после end; пишу комментарий вроде //next q, так становится понятнее.
"Ты должен сделать добро из зла, потому что его больше не из чего сделать". АБ Стругацкие.