-
кусками сортировать
-
> доверяю в части алгоритмов Sha безгранично
в него уже Верить пора))
-
Сделай наследника и выкини вот эту конструкцию: var
I, J, P: Integer;
begin
repeat
I := L;
J := R;
P := (L + R) shr 1;
repeat
while SCompare(Self, I, P) < 0 do Inc(I);
while SCompare(Self, J, P) > 0 do Dec(J);
if I <= J then
begin
if I <> J then
ExchangeItems(I, J);
Inc(I);
Dec(J);
end;
until I > J;
if L < J then QuickSort(L, J, SCompare);
L := I;
until I >= R;
-
-
Всем привет, пропустил тему)
да точно, в статье по ссылке [23] есть 2 мысли на эту тему:
1. Гарантированно хорошее время на любых данных (но примерно в 2 раза хуже лучшего времени QSort на случайных данных) дает пирамидальная сортировка (она же сортировка кучей).
2. Все разобранные в статье варианты сортировки, в отличие от родного дельфевого, управляют длиной рекурсии и на реальных данных работают почти также хорошо, как QSort на случайных данных. Разумеется, хакер всегда может *специально* смоделировать тормозящие данные. В этом случае см. п.1.
-
> Sha © (16.12.18 00:32) [24]
Александр, приветствую!
А что думаешь про красно-черные деревья? Есть у них неудачный набор входных данных, который приводит к тому, что добавление будет сложности O(N^2), а не O(N*LogN)?
(после построения дерева я обхожу его слева направо и выясняю новый порядок элементов, потом переставляю элементы в исходном массиве - года 2-3 назад ты приводил такой алгоритм перестановки, им и пользуюсь).
У меня ситуация нетребовательная - данных до 500тыщ, но очень дорогое сравнение. Как ты сказал лет 10+ назад в кабаке (если не ошибаюсь, на ДР Юры Зотова) - если я слышу Variant, то ни о какой производительности говорить нельзя. Вот у меня как раз тот случай - дорогое сравнение из-за Variant.
RB-tree я сделал уже. Но опасаюсь, что появится какой-то набор входных данных, когда RB-tree тоже впадет в кому...
-
> Тимохов Дима © (16.12.18 01:02) [25]
Если представление данных используется для выбора кандидатов на перестановку, то, очевидно, оно влияет на производительность. Если ты там не делаешь лишнего, то скорее всего O(N^2) тебе не грозит )
1. Но все-таки было бы интересно проверить любой модифицированный вариант QSort из статьи, чтобы понять в чем дело.
2. Если окажется, что дело не в реализации QSort, то можно поглядеть в сторону пирамидальной сортировки, она тоже "деревянная", но высота дерева минимальна, поэтому, вероятно, скорость будет выше, чем у КЧД.
3. Возможно, самое главное. Имеет смысл отказаться от типа Variant. Если стандартные типы или записи с кейсами (variant part) не подходят, то есть совершенно фантастический TDocVariant от Synopse.
-
> Sha © (16.12.18 11:11) [26] > > Тимохов Дима © (16.12.18 01:02) [25] > > Если ты там не делаешь лишнего, то скорее всего O(N^2) тебе > не грозит )
Это отлично! > 1. Но все-таки было бы интересно проверить любой модифицированный > вариант QSort из статьи, чтобы понять в чем дело.
Проверю. Но где гарантия, что тот самый "хакер" не подсунет еще раз свинью))) У меня "хакером" является MSSQL - после массовой добавки объектов он, видимо, просто выдает данные по кластерному индексу, но иногда переставляет большими кусками. NB У меня алгоритмы обработки предполагаю последующую сорировку на клиенте. А с сервера я получаю без order by. > 2. Если окажется, что дело не в реализации QSort, то можно > поглядеть в сторону пирамидальной сортировки, она тоже "деревянная", > но высота дерева минимальна, поэтому, вероятно, скорость > будет выше, чем у КЧД.
Ну я так понял, что я фактически и сделал такую сортировку. Только дерево не пирамидальное (сверху вниз), а обычное двоичное (слева направо). > 3. Возможно, самое главное. Имеет смысл отказаться от типа Variant. > Если стандартные типы или записи с кейсами (variant part) не подходят, > то есть совершенно фантастический TDocVariant от Synopse.
Я в качестве эксперимента пробовал брать напрямую строку из Variant, т.е. без конвертации через неявный вызов VarToLStr. Типа того: PMyStrRec = ^MyStrRec;
MyStrRec = packed record
refCnt: Longint;
length: Longint;
end;
P1 := TVarData(aV1).VString; P2 := TVarData(aV2).VString;
if (P1 = nil) and (P2 = nil) then
Result := 0
else if P1 = nil then
Result := -1
else if P2 = nil then
Result := 1
else
begin
Result := CompareString(
LOCALE_USER_DEFAULT,
0, PChar(P1), PMyStrRec(Integer(P1) - sizeof(MyStrRec)).length,
PChar(P2), PMyStrRec(Integer(P2) - sizeof(MyStrRec)).length
) - 2;
end;
Дает безусловный прирост, но не в разы. Поэтому "забил". Видимо само по себе сравнение строк дело дорогое... Не думаю, что есть лучшее сравнение, чем штатный CompareString. Или есть?
-
> Тимохов Дима © (16.12.18 11:30) [27]
Можешь еще попробовать *существенно* сэкономить на перестановках, если в качестве сортируемых элементов дерева или массива будешь использовать PVariant вместо Variant
-
> брать напрямую строку из Variant, > т.е. без конвертации через неявный вызов VarToLStr
VOleStr
-
> Sha © (16.12.18 12:11) [28] > > Тимохов Дима © (16.12.18 11:30) [27] > > Можешь еще попробовать *существенно* сэкономить на перестановках, > > если в качестве сортируемых элементов дерева или массива > будешь использовать PVariant вместо Variant
Я и так делаю перестановки через Move. Там уже некуда ускорять. Если только еще одну таблицу соотвествий не держать и вообще ничего не переставлять. 85% все равно занимает сравнение строк. Так, что это уже блохи))
-
> Sha © (16.12.18 12:16) [29] > > брать напрямую строку из Variant, т.е. без конвертации через неявный вызов VarToLStr > VOleStr
А почему VOleStr? Я вот VString беру (у меня еще дельфи неуникодный) как выше в примере.
Собственно я поэтому и забил на использование сравнения строки из [27], т.к. не уверен был про этот VOleStr и как это все будет работать, когда все же на уникод перейду.
-
> Я и так делаю перестановки через Move.
Не должно быть Move, надо что-то вроде
a: array of variant; b: array of pvariant; p: pvariant; ... for i:=0 to len-1 do b[i]:=@a[i]; ... p:=b[i]; b[i]:=b[j]; b[j]:=p;
-
> asm cmp (он же if) в современных процессорах равен 1 такту.
Мы же строки тут сортируем. А как они теперь работают даже самому Вирту не известно.
-
В общем, как я и предполагал, дело было в реализации. Если использовать правильную (из моей статьи), то время будет в районе 0ms.
На праздники надо будет добавить сей казус в статью. А кому невтерпеж или лень разбираться, может просто вызвать TShaStringList(SL).ShaSort отсюда:
unit ShaStringList;
interface
uses Classes;
type TIsLess = function(p1, p2: pointer): boolean;
TShaStringList = class(TStringList) public procedure ShaSort(IsLess: TIsLess= nil); end;
implementation
type THackStringList = class(TStrings) private FList: PStringItemList; public property List: PStringItemList read FList write FList; end;
const InsCount = 35; //33..49; InsLast = InsCount-1;
function StringListIsLess(p1, p2: pointer): boolean; begin; Result:=(string(p1)<string(p2)); end;
procedure StringListInsertionSort(List: PPointerList; Last: integer; IsLess: TIsLess); var I, J: integer; T, T1: pointer; begin; I:=0; J:=Last; if J>InsLast then J:=InsLast; repeat; if IsLess(List[2*J], List[2*I]) then I:=J; dec(J); until J<=0; if I>0 then begin; T:=List[0]; List[0]:=List[2*I]; List[2*I]:=T; T:=List[1]; List[1]:=List[2*I+1]; List[2*I+1]:=T; end;
J:=1; while true do begin; if J>=Last then break; inc(J); if IsLess(List[2*J],List[2*J-2]) then begin; T:=List[2*J]; T1:=List[2*J+1]; I:=J; repeat; List[2*I]:=List[2*I-2]; List[2*I+1]:=List[2*I-1]; dec(I); until not IsLess(T,List[2*I-2]); List[2*I]:=T; List[2*I+1]:=T1; end; end; end;
procedure StringListQuickSort(List: PPointerList; L, R: integer; IsLess: TIsLess); var I, J, M: integer; P, T: pointer; begin; while true do begin; J:=R; I:=L; if J-I<=InsLast then break; M:=(I+J) shr 1; P:=List[2*M];
if IsLess(List[2*J], List[2*I]) then begin; T:=List[2*I]; List[2*I]:=List[2*J]; List[2*J]:=T; T:=List[2*I+1]; List[2*I+1]:=List[2*J+1]; List[2*J+1]:=T; end; if IsLess(P, List[2*I]) then begin; P:=List[2*I]; List[2*I]:=List[2*M]; List[2*M]:=P; T:=List[2*I+1]; List[2*I+1]:=List[2*M+1]; List[2*M+1]:=T; end else if IsLess(List[2*J], P) then begin; P:=List[2*J]; List[2*J]:=List[2*M]; List[2*M]:=P; T:=List[2*J+1]; List[2*J+1]:=List[2*M+1]; List[2*M+1]:=T; end;
repeat; Inc(I); until not IsLess(List[2*I], P); repeat; Dec(J); until not IsLess(P, List[2*J]); if I<J then repeat; T:=List[2*I]; List[2*I]:=List[2*J]; List[2*J]:=T; T:=List[2*I+1]; List[2*I+1]:=List[2*J+1]; List[2*J+1]:=T; repeat; Inc(I); until not IsLess(List[2*I], P); repeat; Dec(J); until not IsLess(P, List[2*J]); until I>=J; dec(I); inc(J);
if I-L<R-J then begin; if I-InsLast>L then StringListQuickSort(List, L, I, IsLess); L:=J; end else begin; if J+InsLast<R then StringListQuickSort(List, J, R, IsLess); R:=I; end; end; end;
procedure StringListHybridSort(List: PPointerList; Count: integer; IsLess: TIsLess); begin; if (List<>nil) and (Count>1) then begin; Count:=Count-1; if Count>InsLast then StringListQuickSort(List, 0, Count, IsLess); StringListInsertionSort(List, Count, IsLess); end; end;
procedure TShaStringList.ShaSort(IsLess: TIsLess= nil); var pList: pointer; Offset: integer; begin; if not Sorted and (Count>1) then begin; Changing; if not Assigned(IsLess) then IsLess:=StringListIsLess; Offset:=@THackStringList(nil).List - pchar(nil); pointer(pList):=pchar(Self) + Offset; StringListHybridSort(PPointerList(pList^), Count, IsLess); Changed; end; end;
end.
-
Александр, благодарю! Сравню, может обратно на QSort перейду.
-
Чуть ускорил и добавил красоты функции сравнения:
unit ShaStringList;
interface
uses Classes;
type TIsLess = function(const s1, s2: string): boolean;
TShaStringList = class(TStringList) public procedure ShaSort(IsLess: TIsLess= nil); end;
implementation
type THackStringList = class(TStrings) private FList: PStringItemList; public property List: PStringItemList read FList write FList; end;
const InsCount = 35; //33..49; InsLast = InsCount-1;
function StringListIsLess(const s1, s2: string): boolean; begin; Result:=(s1<s2); end;
procedure StringListInsertionSort(List: PPointerList; Last: integer; IsLess: TIsLess); var I, J: integer; T, T1: pointer; begin; I:=0; J:=Last; if J>InsLast*2 then J:=InsLast*2; repeat; if IsLess(string(List[J]), string(List[I])) then I:=J; dec(J,2); until J<=0; if I>0 then begin; T:=List[0]; List[0]:=List[I]; List[I]:=T; T:=List[1]; List[1]:=List[I+1]; List[I+1]:=T; end;
J:=0+2; while true do begin; if J>=Last then break; inc(J,2); if IsLess(string(List[J]), string(List[J-2])) then begin; T:=List[J]; T1:=List[J+1]; I:=J; repeat; List[I]:=List[I-2]; List[I+1]:=List[I-1]; dec(I,2); until not IsLess(string(T), string(List[I-2])); List[I]:=T; List[I+1]:=T1; end; end; end;
procedure StringListQuickSort(List: PPointerList; L, R: integer; IsLess: TIsLess); var I, J, M: integer; P, T: pointer; begin; while true do begin; J:=R; I:=L; if J-I<=InsLast*2 then break; M:=(I shr 1 + J shr 1) and -2; P:=List[M];
if IsLess(string(List[J]), string(List[I])) then begin; T:=List[I]; List[I]:=List[J]; List[J]:=T; T:=List[I+1]; List[I+1]:=List[J+1]; List[J+1]:=T; end; if IsLess(string(P), string(List[I])) then begin; P:=List[I]; List[I]:=List[M]; List[M]:=P; T:=List[I+1]; List[I+1]:=List[M+1]; List[M+1]:=T; end else if IsLess(string(List[J]), string(P)) then begin; P:=List[J]; List[J]:=List[M]; List[M]:=P; T:=List[J+1]; List[J+1]:=List[M+1]; List[M+1]:=T; end;
repeat; Inc(I,2); until not IsLess(string(List[I]), string(P)); repeat; Dec(J,2); until not IsLess(string(P), string(List[J])); if I<J then repeat; T:=List[I]; List[I]:=List[J]; List[J]:=T; T:=List[I+1]; List[I+1]:=List[J+1]; List[J+1]:=T; repeat; Inc(I,2); until not IsLess(string(List[I]), string(P)); repeat; Dec(J,2); until not IsLess(string(P), string(List[J])); until I>=J; dec(I,2); inc(J,2);
if I-L<R-J then begin; if I-InsLast*2>L then StringListQuickSort(List, L, I, IsLess); L:=J; end else begin; if J+InsLast*2<R then StringListQuickSort(List, J, R, IsLess); R:=I; end; end; end;
procedure StringListHybridSort(List: PPointerList; Count: integer; IsLess: TIsLess); begin; if (List<>nil) and (Count>1) then begin; Count:=Count-1; Count:=Count+Count; if Count>InsLast*2 then StringListQuickSort(List, 0, Count, IsLess); StringListInsertionSort(List, Count, IsLess); end; end;
procedure TShaStringList.ShaSort(IsLess: TIsLess= nil); var pList: pointer; Offset: integer; begin; if not Sorted and (Count>1) then begin; Changing; if not Assigned(IsLess) then IsLess:=StringListIsLess; Offset:=@THackStringList(nil).List - pchar(nil); pointer(pList):=pchar(Self) + Offset; StringListHybridSort(PPointerList(pList^), Count, IsLess); Changed; end; end;
end.
-
Александр, спасибо большое! Я как топикстартер обязательно изучу и использую. О результатах сообщу, самому интересно, что выйдет. Сейчас догоняю упущенное время на разработку собственной сортировки - релиз скоро!
-
Спасибо за тему. Никогда бы не подумал о таком коварном подвохе.
Спасибо dmk © (15.12.18 17:19) [18] за готовый к экспериментам пример!
Признаюсь, крутости от Sha © не изучал.
Со своей стороны вижу так: таки большое время занимает копирование строк. Даже таких совсем коротких маленьких, как в примере [18].
Я в своё время, когда натыкался на проблемы со скоростью сортировки/поиска + отъедаемой памятью под всё это, сделал так:
Вводная: сортировать надо было элементы строки, разделёные запятой; т.е. у меня изначально данные были в виде "str1,str2, str3" и т.д. с произвольным количеством пробелов вокруг запятых, такие пробелы в моём случае являются незначимыми, от них надо избавляться.
Изначально из такой строки выкусывались кусочки по запятым (удалялись вокруг пробелы) и всё пихалось в StringList, где сортировалось и бинарно искалось.
Когда элементов в строке стало более 20..30 тыс. шт., начались проблемы с быстродействием в момент разбора строки. (Про проблемы со скоростью сортировки - не знаю, я ей отдельно не замерял, никогда бы не подумал, что это может быть проблемой.)
Сделал следующее: наследник TList в нём элементы хранят указатели PChar на начала "подстрок" сама строка копируется внутрь этого TList целиком (отдельным полем), что быстрее, чем отдельные куски прямо в этой строке String запятые заменены на #0 (ну вернее запятые или первый незначивый пробел после очередного кусочка) сортировка производится для указателей, не строк
В итоге: Если брать пример из [18] на 50 тыс. строк, то сортировка на моём железе: - пример [18] работает 104 сек. - вариант, описанный мною выше на тех же данных, работает 2,6 сек
Это, конечно, не "около нуля", но получше.
-
Да, собственно .Sort() от TList я не менял, лишь подсовываю ему свою функцию сортировки.
|