Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

Быстрая сортировка


Тимохов Дима ©   (14.12.18 22:34

Коллеги, приветствую!

Вы попадали когда-то в ситуацию, когда TStringList.Sort сортирует список из 42196 элементов долго (точно больше 20 минут, дальше ждать не стал, срубил)?

Вот я сегодня попал. Сначала был в шоке. Прочел, что у алгоритма быстрой сортировки бывают такие косяки, когда есть неудачный исходный список. Но чтобы так...

Переписал на красно-черное бинарное дерево. Даже быстрее (в моем случае) стало.

Пишу, чтобы поделится мыслью - не верьте безгранично быстрой сортировке. Она коварная)))


ухты ©   (14.12.18 22:54[1]

Сча придет Ша и киданет ссылочку с разборами сортировок и быстрой в том числе. :)


Тимохов Дима ©   (14.12.18 23:29[2]

Если так, то буду ждать с нетерпением. Т.к. Sha мне жутко помог года 3 назад с алгоритмом выставления порядка в списке путем перестановок. Я, правда, свой аналогичный написал. Но взял все же от Sha, ибо доверяю в части алгоритмов Sha безгранично))


Eraser ©   (15.12.18 02:23[3]


> Тимохов Дима ©   (14.12.18 22:34) 

ты точно не опечатался?

у меня вот такой код

procedure TForm1.Button1Click(Sender: TObject);
begin
 var Data := TStringList.Create;
 try
   for var I := 0 to 42196 do
   begin
     Data.Add(TGUID.NewGuid.ToString);
   end;

   var Time1 := GetTickCount;
   Data.Sort;
   Time1 := GetTickCount - Time1;

   ShowMessage(Time1.ToString);
 finally
   Data.Free;
 end;
end;


показывает ровно 141 мс.


Германн ©   (15.12.18 03:04[4]


> Тимохов Дима ©   (14.12.18 22:34)  

При простом алгоритме сортировки таких времен быть никак не Должно.

> Eraser ©   (15.12.18 02:23) [3]
>
>
> > Тимохов Дима ©   (14.12.18 22:34)
>
> ты точно не опечатался?
>
> у меня вот такой код

Мой бывший директор, у которого я работал программистом окончательно ушел на пенсию. Похоже и мне  пора.


Dimka Maslov ©   (15.12.18 11:29[5]

Коварен не алгоритм сортировки, а алгоритм сравнения при сортировке, который и создаёт тормоза.


KSergey ©   (15.12.18 12:00[6]

Каковы размеры строк в списке?
В каком символе они преимущественно отличаются?
Быть может речь про запихивание в list строк по 100Кб, различающихся в десяти последних символах от начала?


Тимохов Дима ©   (15.12.18 12:09[7]

Коллеги, ви мне не верите?
Погодите, создам течение дня тестовый пример. Вместе будем в шоке))


dmk ©   (15.12.18 12:38[8]

>алгоритм сравнения при сортировке, который и создаёт тормоза
asm cmp (он же if) в современных процессорах равен 1 такту.
Тормоза создают запись в переменную.


dmk ©   (15.12.18 13:08[9]

У меня Sort:
1. Миллион элементов ~5 сек.
2. 42196 элементов ~0.1 сек.


Тимохов Дима ©   (15.12.18 13:08[10]

https://yadi.sk/d/uHnjyZP3fyi7Vw

удивимся вместе)))
ждать не стал - срубил после 3 минут.

на всякий случай, у меня Delphi2007.


ухты ©   (15.12.18 14:53[11]

order by нужен


dmk ©   (15.12.18 15:11[12]

program Project1;

{$APPTYPE CONSOLE}

uses
 Classes, SysUtils, Windows, Vcl.Dialogs;

var
 SL: TStringList;
 st, et, tt: Double;
 i: Integer;

begin

 SL := TStringList.Create;

 SL.LoadFromFile('data.txt');
 st := GetTickCount;
 SL.Sort;
 et := GetTickCount;
 tt := (et - st) / 1000.0;
 MessageDlg('Время: ' + FloatToStrF(tt, ffNumber, 18, 2) + ' сек.', mtInformation, [mbOk], 0, mbOk);

 SL.Free;
end.

У меня сортировалось 94.88 сек.
i7-6950 Extreme 3.0 ГГц.


Тимохов Дима ©   (15.12.18 15:14[13]


> У меня сортировалось 94.88 сек.

все равно не мало, согласись.

у тебя Дельфи какой? Если отличный от моего, то пришли плз (timokhov собак gmail тчк com) текст TStringList.QuickSort.


Eraser ©   (15.12.18 16:32[14]


> Тимохов Дима ©   (15.12.18 13:08) [10]

130 сек. на древнем i7-2600 (2011 год разработки).

когда же ты уже выкинешь этот делфи 2007? вопрос риторический )


Eraser ©   (15.12.18 16:35[15]


> все равно не мало, согласись.

не мало, потому что не очень удобно для сортировки, по сравнению с рандомными значениями. по моему есть алгоритмы, оптимизированные для работы с частично отсортированными массивами.


Тимохов Дима ©   (15.12.18 16:36[16]


> когда же ты уже выкинешь этот делфи 2007? вопрос риторический
> )


Мне он дорог как память)  Мне его лично Ник Ходжес прислал. Честно говоря, я так и не понял, за какие заслуги в тесте. Видимо, мелькал много)))

Ты код то пришли)


Тимохов Дима ©   (15.12.18 16:59[17]


> Eraser ©   (15.12.18 16:35) [15]


просьба о TStringList.QuickSort снимается.
уверен, что она такая же.

дотерпел до конца. у меня 200 сек (комп старенький). как раз чуть больше трех минут, в прошлый раз не дотерпел.

но в боевом проекте в своем списке все же заменил быструю сортировку на сортировку по дереву. у меня там сравнение "дорогое", десятки минут получаются.

кстати, сортировка по бинарному дереву оказалась процентов на 30 быстрее в моих тестах. хотя, конечно, есть затраты памяти на само дерево, но для меня это несущественно.

всем спасибо за внимание)


dmk ©   (15.12.18 17:19[18]

>у тебя Дельфи какой?
Delphi XE6.

10000 - 6.3130 сек.
20000 - 23.1400 сек.
30000 - 47.3590 сек.
40000 - 85.8130 сек.
50000 - 133.9690 сек.

Вот код с генерацией строк.
program Project1;

{$APPTYPE CONSOLE}

uses
 Classes, SysUtils, Windows, Vcl.Dialogs, System.StrUtils, System.UITypes;

var
 SL: TStringList;
 st, et: Double;
 i, N: Integer;
 S: String;

const
 K: string = '|201410-';

begin

 SL := TStringList.Create;
 N := 50000;
 SL.Capacity := N;

 for i := 0 to (N div 2 - 1) do
 begin
   S := K + Format('%.5d', [i]) + '|';
   SL.Add(S);
 end;

 for i := (N div 2) downto 0 do
 begin
   S := K + Format('%.5d', [i]) + '|';
   SL.Add(S);
 end;

 Writeln('Генерация ' + IntToStr(N) + ' элементов завершена.');
 Writeln('Идет сортировка ...');

 st := GetTickCount;
 SL.Sort;
 et := GetTickCount;
 SL.Free;

 Writeln('Время: ' + FloatToStrF((et - st) * 0.001, ffNumber, 18, 4) + ' сек.');
 Readln;
end.


Чтобы ускорить переделай на AnsiString. Будет бестрее.


Тимохов Дима ©   (15.12.18 17:30[19]


> Чтобы ускорить переделай на AnsiString. Будет бестрее.

Мне уже не актуально, я забраковал быструю сортировку в моем случае.
Хотя столько лет пользовался.

Сейчас просто у меня велик шанс иметь такие частично сортированные массивы.

Ну ее, эту быструю сортировку от греха подальше.

Красно-черные деревья оказались надежнее.
Хотя там при опред. кол-ве данных возможны просадки при ребалансировке.
Время покажет.


картман ©   (15.12.18 17:42[20]

кусками сортировать


картман ©   (15.12.18 17:43[21]


> доверяю в части алгоритмов Sha безгранично

в него уже Верить пора))


Rouse_ ©   (15.12.18 23:43[22]

Сделай наследника и выкини вот эту конструкцию:

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);
//        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 QuickSort(L, J, SCompare);
   L := I;
 until I >= R;


Rouse_ ©   (15.12.18 23:46[23]

Ну и это можешь на досуге глянуть, чтоб Саню лишний раз не тирибонькать опять: http://www.guildalfa.ru/alsha/node/10


Sha ©   (16.12.18 00:32[24]

Всем привет, пропустил тему)

да точно, в статье по ссылке [23] есть 2 мысли на эту тему:

1. Гарантированно хорошее время на любых данных
(но примерно в 2 раза хуже лучшего времени QSort на случайных данных)
дает пирамидальная сортировка (она же сортировка кучей).

2. Все разобранные в статье варианты сортировки, в отличие от родного дельфевого,
управляют длиной рекурсии и на реальных данных работают почти также хорошо,
как QSort на случайных данных.

Разумеется, хакер всегда может *специально* смоделировать тормозящие данные.
В этом случае см. п.1.


Тимохов Дима ©   (16.12.18 01:02[25]


> Sha ©   (16.12.18 00:32) [24]

Александр, приветствую!

А что думаешь про красно-черные деревья?
Есть у них неудачный набор входных данных, который приводит к тому, что добавление будет сложности O(N^2), а не O(N*LogN)?

(после построения дерева я обхожу его слева направо и выясняю новый порядок элементов, потом переставляю элементы в исходном массиве - года 2-3 назад ты приводил такой алгоритм перестановки, им и пользуюсь).

У меня ситуация нетребовательная - данных до 500тыщ, но очень дорогое сравнение. Как ты сказал лет 10+ назад в кабаке (если не ошибаюсь, на ДР Юры Зотова) - если я слышу Variant, то ни о какой производительности говорить нельзя. Вот у меня как раз тот случай - дорогое сравнение из-за Variant.

RB-tree я сделал уже. Но опасаюсь, что появится какой-то набор входных данных, когда RB-tree тоже впадет в кому...


Sha ©   (16.12.18 11:11[26]

> Тимохов Дима ©   (16.12.18 01:02) [25]

Если представление данных используется для выбора кандидатов
на перестановку, то, очевидно, оно влияет на производительность.
Если ты там не делаешь лишнего, то скорее всего O(N^2) тебе не грозит )

1. Но все-таки было бы интересно проверить любой модифицированный
вариант QSort из статьи, чтобы понять в чем дело.

2. Если окажется, что дело не в реализации QSort, то можно поглядеть в сторону пирамидальной сортировки, она тоже "деревянная", но высота дерева минимальна, поэтому, вероятно, скорость будет выше, чем у КЧД.

3. Возможно, самое главное. Имеет смысл отказаться от типа Variant.
Если стандартные типы или записи с кейсами (variant part) не подходят,
то есть совершенно фантастический TDocVariant от Synopse.


Тимохов Дима ©   (16.12.18 11:30[27]


> 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;// P1:Pointer;
     P2 := TVarData(aV2).VString;// P2:Pointer;

     // Логика работы сравнения с NULL не стандартна - считаю NULL < any.
     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, //для сравнения без кейса ставить NORM_IGNORECASE
           PChar(P1), PMyStrRec(Integer(P1) - sizeof(MyStrRec)).length,
           PChar(P2), PMyStrRec(Integer(P2) - sizeof(MyStrRec)).length
        ) - 2;
     end;


Дает безусловный прирост, но не в разы. Поэтому "забил".
Видимо само по себе сравнение строк дело дорогое... Не думаю, что есть лучшее сравнение, чем штатный CompareString. Или есть?


Sha ©   (16.12.18 12:11[28]

> Тимохов Дима ©   (16.12.18 11:30) [27]

Можешь еще попробовать *существенно* сэкономить на перестановках,
если в качестве сортируемых элементов дерева или массива будешь использовать
PVariant вместо Variant


Sha ©   (16.12.18 12:16[29]

> брать напрямую строку из Variant,
> т.е. без конвертации через неявный вызов VarToLStr

VOleStr


Тимохов Дима ©   (16.12.18 12:19[30]


> Sha ©   (16.12.18 12:11) [28]
> > Тимохов Дима ©   (16.12.18 11:30) [27]
>
> Можешь еще попробовать *существенно* сэкономить на перестановках,
>  
> если в качестве сортируемых элементов дерева или массива
> будешь использовать PVariant вместо Variant

Я и так делаю перестановки через Move. Там уже некуда ускорять. Если только еще одну таблицу соотвествий не держать и вообще ничего не переставлять.
85% все равно занимает сравнение строк. Так, что это уже блохи))


Тимохов Дима ©   (16.12.18 12:22[31]


> Sha ©   (16.12.18 12:16) [29]
> > брать напрямую строку из Variant, т.е. без конвертации через неявный вызов VarToLStr
> VOleStr

А почему VOleStr? Я вот VString беру (у меня еще дельфи неуникодный) как выше в примере.

Собственно я поэтому и забил на использование сравнения строки из [27], т.к. не уверен был про этот VOleStr и как это все будет работать, когда все же на уникод перейду.


Sha ©   (16.12.18 12:25[32]

> Я и так делаю перестановки через 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;


Dimka Maslov ©   (16.12.18 12:28[33]


> asm cmp (он же if) в современных процессорах равен 1 такту.


Мы же строки тут сортируем. А как они теперь работают даже самому Вирту не известно.


Sha ©   (16.12.18 18:55[34]

В общем, как я и предполагал, дело было в реализации.
Если использовать правильную (из моей статьи),
то время будет в районе 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.


Тимохов Дима ©   (16.12.18 19:05[35]

Александр, благодарю!
Сравню, может обратно на QSort перейду.


Sha ©   (16.12.18 20:57[36]

Чуть ускорил и добавил красоты функции сравнения:


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.


Тимохов Дима ©   (17.12.18 21:50[37]

Александр, спасибо большое!
Я как топикстартер обязательно изучу и использую. О результатах сообщу, самому интересно, что выйдет.
Сейчас догоняю упущенное время на разработку собственной сортировки - релиз скоро!


KSergey ©   (18.12.18 11:09[38]

Спасибо за тему.
Никогда бы не подумал о таком коварном подвохе.

Спасибо 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 сек

Это, конечно, не "около нуля", но получше.


KSergey ©   (18.12.18 11:11[39]

Да, собственно .Sort() от  TList я не менял, лишь подсовываю ему свою функцию сортировки.


Mystic ©   (18.12.18 15:06[40]

Во-первых, можно использовать быструю сортировку, но переключаться на пирамидальную в случае, когда максимальный размер неосортированного сокращается мало.

Во-вторых, есть стратегия выбора элемента, с которым должно производится сравнение: P := (L + R) shr 1; Тут большой простор для творчества. Бери рандомный элемент из диапазона [L, R] и уже тебе будет грубоко наплевать на то, какое хитрое наполнение было в массиве.


Тимохов Дима ©   (14.01.19 09:42[41]


> Sha ©   (16.12.18 20:57) [36]

Александр, приветствую!

С завалами разобрался, пришло время использовать быструю сортировку от Sha))

Попытался разобраться, но не вышло. Напрямую у меня не компилируется с ошибкой на строке 134 - cannot access property (у меня Delphi2007).
Решил поправить код на прямое использование TStrings.Strings вместо List.
Естественно, т.к. используется удвоенный индекс, то валится с ошибкой - list index out of bounds.

Если не сложно, то прокомментируй, пожалуйста, смысл строк 134 и 135.
Я в принципе не могу понять, как параметр List соотносится с реальными строками в TStringList.TList.

Спасибо.


sniknik ©   (14.01.19 10:31[42]

0 целых чз. десятых... не замерял, но быстро, моментально просто...

   with TStringList.Create() do
   try
     Sorted:= true;
     LoadFromFile('data.txt');
     //Sort();
     SaveToFile('Sort.txt');
   finally
     Free();
   end;
 except
   on E:Exception do
     Writeln(E.Classname, ': ', E.Message);
 end;

в твоем случае похоже длинный и уже отсортированный список, для квиксорта нечего "делить", самый неудачный вариант для квиксорта.


sniknik ©   (14.01.19 10:42[43]

вернее, нужно добавить, а то у тебя там часть дублирующихся значений, которые в "выходном" файле пропадают
  with TStringList.Create() do
  try
    Sorted:= true;
    Duplicates:= dupAccept;
    LoadFromFile('data.txt');
    //Sort();
    SaveToFile('Sort.txt');
  finally
    Free();
  end;
except
  on E:Exception do
    Writeln(E.Classname, ': ', E.Message);
end;


Sha ©   (14.01.19 13:56[44]

> Тимохов Дима ©   (14.01.19 09:42) [41]
> Если не сложно, то прокомментируй, пожалуйста, смысл строк 134 и 135.

Смысл в том, чтобы получить адрес первого элемента динамического массива.


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо