Конференция "Прочее" » Быстрая сортировка
 
  • Тимохов Дима © (14.12.18 22:34) [0]
    Коллеги, приветствую!

    Вы попадали когда-то в ситуацию, когда 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.

    Смысл в том, чтобы получить адрес первого элемента динамического массива.
 
Конференция "Прочее" » Быстрая сортировка
Есть новые Нет новых   [134427   +34][b:0.001][p:0.003]