суббота, 1 июня 2013 г.

Сортировка списка по аналогу "Проводника Windows"

Когда проект практически завершен и вся бизнес логика находится в тестировании иногда возникает желание дополнить его "рюшечками и фишечками" и прочими "украшательствами", ну например перерисовать пару иконок на более красивые, или сделать выделение элементов через градиент с альфаканалом.
Вариантов таких спонтанных хотелок (особенно при наличии времени) много и все из серии украшательств, не несущих по сути никакой смысловой нагрузки - но вот хочется и все :)

В данной мини-статье я рассмотрю одну из таких "хотелок".

Допустим у вас есть список элементов, отображаемый в TListView, вы пробуете его отсортировать и получаете вот такой результат.


Не красиво, почему это второй элемент с именем "101" находится не на своем месте? Ведь это число, а стало быть место ему как минимум после элемента с именем "2". Да и "New Folder (101)" явно должна быть после "New Folder (2)". Ведь в проводнике все выглядит нормально.


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




Для начала давайте разберемся в причинах неверной сортировки.
По умолчанию в TListView для сравнения строк используется функция lstrcmp, которая сравнивает строки посимвольно.

К примеру если взять две строки "1" и "2", то первая строка должна располагаться над второй, т.к. символ единицы идет перед двойкой. Однако если вместо первой строки взять "101", функция lstrcmp так-же скажет что данная строка должна идти первой, ибо в этом случае она принимает решение по результату сравнения самого первого символа обеих строк, не учитывая тот факт что обе строки являются строковым представлением чисел.

Немножко усложним, возьмем строки "1a2" и "1a101" на которых lstrcmp опять выдаст неверный результат, сказав что вторая строка должна идти первой. Это решение она принимает на основе результата сравнения третьего символа обеих строк, не смотря на то что в данном случае они так-же являются строковыми представлениями чисел.

С причинами разобрались, теперь думаем решение.
Раз lstrcmp ошибается на сравнении, интерпретируя части чисел в виде символов, нужно реализовать аналогичный ей алгоритм сравнения, в котором числа будут сравниваться именно как числа, а не как символы.

Алгоритмически это сделать достаточно просто.

Возьмем опять-же "1a2" и "1a101". Разобьем их на отдельные составляющие, где символы будут отделены от чисел. Если представить первую строку в виде "1 + a + 2", а вторую в виде "1 + a + 101" то получится что нам нужно выполнить всего три сравнения.

1. Число с числом
2. Символ с символом
3. Опять число с числом

Итог такого сравнения будет верный и покажет что вторая строка действительно должна идти второй, а не первой, как нам об этом сообщала lstrcmp.

Теперь продумаем ТЗ к реализации данного алгоритма.

Очевидно что:
1. Если одна из строк, переданная для сравнения пустая - она должна идти выше первой.
2. Если обе строки пустые - они идентичны.
3. Регистр строк при сравнении не учитывается.
4. Для анализа строк используем курсор содержащий адрес текущего анализируемого символа каждой строки.
5. Если курсор одной из строк содержит число, а курсор другой строки содержит символ - первая строка выше второй.
6. Если курсоры строк указывают на символ - сравнение происходит по аналогу lstrcmp
7. Если курсоры строк указывают на число - извлекаем оба числа и сравниваем их между собой.
7.1 Если оба числа равны нулю (к примеру "00" и "0000") то вверх помещается число с меньшим количеством нулей.
8. Если в процессе анализа курсор любой из строк обнаружил терминирующий ноль - эта строка идет выше.
8.1 Если в этот-же момент курсор второй строки тоже находится на терминирующем нуле - строки идентичны.

Для реализации алгоритма, данного ТЗ более чем достаточно.
Собственно реализуем:

//
// CompareStringOrdinal сравнивает две строки по аналогу проводника, т.е.
// "Новая папка (3)" < "Новая папка (103)"
//
// Возвращает следующие значения
// -1     - первая строка меньше второй
// 0      - строки эквивалентны
// 1      - первая строка больше второй
// =============================================================================
function CompareStringOrdinal(const S1, S2: string): Integer;

  // Функция CharInSet появилась начиная с Delphi 2009,
  // для более старых версий реализуем ее аналог
  function CharInSet(AChar: Char; ASet: TSysCharSet): Boolean;
  begin
    Result := AChar in ASet;
  end;

var
  S1IsInt, S2IsInt: Boolean;
  S1Cursor, S2Cursor: PChar;
  S1Int, S2Int, Counter, S1IntCount, S2IntCount: Integer;
  SingleByte: Byte;
begin
  // Проверка на пустые строки
  if S1 = '' then
    if S2 = '' then
    begin
      Result := 0;
      Exit;
    end
    else
    begin
      Result := -1;
      Exit;
    end;

  if S2 = '' then
  begin
    Result := 1;
    Exit;
  end;

  S1Cursor := @AnsiLowerCase(S1)[1];
  S2Cursor := @AnsiLowerCase(S2)[1];

  while True do
  begin
    // проверка на конец первой строки
    if S1Cursor^ = #0 then
      if S2Cursor^ = #0 then
      begin
        Result := 0;
        Exit;
      end
      else
      begin
        Result := -1;
        Exit;
      end;

    // проверка на конец второй строки
    if S2Cursor^ = #0 then
    begin
      Result := 1;
      Exit;
    end;

    // проверка на начало числа в обоих строках
    S1IsInt := CharInSet(S1Cursor^, ['0'..'9']);
    S2IsInt := CharInSet(S2Cursor^, ['0'..'9']);
    if S1IsInt and not S2IsInt then
    begin
      Result := -1;
      Exit;
    end;
    if not S1IsInt and S2IsInt then
    begin
      Result := 1;
      Exit;
    end;

    // посимвольное сравнение
    if not (S1IsInt and S2IsInt) then
    begin
      if S1Cursor^ = S2Cursor^ then
      begin
        Inc(S1Cursor);
        Inc(S2Cursor);
        Continue;
      end;
      if S1Cursor^ < S2Cursor^ then
      begin
        Result := -1;
        Exit;
      end
      else
      begin
        Result := 1;
        Exit;
      end;
    end;

    // вытаскиваем числа из обоих строк и сравниваем
    S1Int := 0;
    Counter := 1;
    S1IntCount := 0;
    repeat
      Inc(S1IntCount);
      SingleByte := Byte(S1Cursor^) - Byte('0');
      S1Int := S1Int * Counter + SingleByte;
      Inc(S1Cursor);
      Counter := 10;
    until not CharInSet(S1Cursor^, ['0'..'9']);

    S2Int := 0;
    Counter := 1;
    S2IntCount := 0;
    repeat
      SingleByte := Byte(S2Cursor^) - Byte('0');
      Inc(S2IntCount);
      S2Int := S2Int * Counter + SingleByte;
      Inc(S2Cursor);
      Counter := 10;
    until not CharInSet(S2Cursor^, ['0'..'9']);

    if S1Int = S2Int then
    begin
      if S1Int = 0 then
      begin
        if S1IntCount < S2IntCount then
        begin
          Result := -1;
          Exit;
        end;
        if S1IntCount > S2IntCount then
        begin
          Result := 1;
          Exit;
        end;
      end;
      Continue;
    end;
    if S1Int < S2Int then
    begin
      Result := -1;
      Exit;
    end
    else
    begin
      Result := 1;
      Exit;
    end;
  end;
end;

Смотрим результат работы данного алгоритма.


Собственно что и ожидалось.
Очередная "украшалка" готова :)

Можно конечно сказать что это велосипед и нужно использовать StrCmpLogicalW:
http://msdn.microsoft.com/en-us/library/windows/desktop/bb759947

Чтож, попробуйте - третья кнопка отвечает за такую сортировку.
Обратите внимание на первые пять элементов списка после сортировки.


Хоть они и похожи на то, что отобразит проводник, но не совсем верны. Ну не должен элемент с именем "0" располагаться под элементом "00" и прочими :)

Исходный код демо-примера можно забрать по данной ссылке.

---

© Александр (Rouse_) Багель
Июнь, 2013

26 комментариев:

  1. Анонимный1 июня 2013 г., 15:24

    "Из комментов:
    xxx: А мне нравиться
    ууу: бляд , отдай мой мягкий знак" (с)http://bash.im/quote/417627

    А по существу, в копилку.

    ОтветитьУдалить
    Ответы
    1. Да вроде Ожегов с "нравиться" не спорит :)
      http://dic.academic.ru/dic.nsf/ogegova/128606

      Удалить
    2. Анонимный1 июня 2013 г., 16:59

      сравни:
      результат вам (что сделает?) понравится
      результат вам должен (что сделать?) понравиться

      Удалить
    3. >>> Анонимный1 июня 2013 г., 16:59
      Говорила-ж мне Мама: "Учи Русский, а то так Беларусом и останешься" :)
      Выпилил данную фразу, вроде и без нее нормально :)

      Удалить
  2. Анонимный1 июня 2013 г., 23:05

    А так не проще? (жаль что форматирование кода не сохраняется)

    function StrCmpDig( const Str1, Str2: string ): Integer;
    var
    i, Len, Digit1, Digit2, DigitLen1, DigitLen2: Integer;
    begin
    if Trim( Str1 ) = Trim( Str2 ) then Exit( 0 );
    if ( Str1 = '' ) then Exit( -1 );
    if ( Str2 = '' ) then Exit( 1 );

    Len := Max( Length( Str1 ), Length( Str2 ) );
    i := 1;

    while i <= Len do
    begin
    if IsDigit( Str1[i] ) and ( IsDigit( Str2[i] ) ) and ( Str1[i] <> '0' ) and ( Str2[i] <> '0' ) then
    begin
    DigitLen1 := DigitLen( Str1, i );
    DigitLen2 := DigitLen( Str2, i );
    Digit1 := StrToInt( Copy( Str1, i, DigitLen1 ) );
    Digit2 := StrToInt( Copy( Str2, i, DigitLen2 ) );
    if Digit1 < Digit2 then Exit( -1 );
    if Digit1 > Digit2 then Exit( 1 );
    Inc( i, Min( DigitLen1, DigitLen2 ) );
    Continue;
    end;
    if Str1[i] < Str2[i] then Exit( -1 );
    if Str1[i] > Str2[i] then Exit( 1 );
    Inc( i );
    end;
    Result := 0;
    end;

    ОтветитьУдалить
  3. Анонимный1 июня 2013 г., 23:07

    function IsDigit( c: Char ): Boolean;
    begin
    Result := ( c >= '0' ) and ( c <= '9' );
    end;

    function DigitLen( Str: string; Index: Integer ): Integer;
    var
    i: integer;
    begin
    Result := 0;
    for i := Index to Length( Str ) do
    if IsDigit( Str[i] ) then
    Inc( Result )
    else
    Break;
    end;

    ОтветитьУдалить
  4. Анонимный2 июня 2013 г., 7:21

    Очень давно использую
    function StrCmpLogicalW; external 'Shlwapi.dll' name 'StrCmpLogicalW';
    в коде проверить только, что "XPandUP"

    ОтветитьУдалить
  5. >> А так не проще? (жаль что форматирование кода не сохраняется)
    >> function StrCmpDig( const Str1, Str2: string ): Integer;

    Да, так тоже можно, только накладные расходы будут бОльшими на реаллоках из-за вызова StrToInt и Copy

    ОтветитьУдалить
  6. Я конечно дико извеняюсь, но оба предложенные варианты имеют ошибки :) В частности могут давать неверную сортировку и вываливать исключительную ситуацию. Догадаетесь в каких случаях? ;)

    ОтветитьУдалить
    Ответы
    1. Кстати да, переполнение Integer может произойти. Если строка содержит очень большое количество цифр.
      Ещё вот к примеру, такие строки:
      -15.26р
      -15.3р

      вещественное число 15.3 больше 15.26, но алгоритм число после точки выделит отдельно, и отсортирует так:
      -15.3р
      -15.26р


      ...и ещё интересно бы посмотреть, как он сортирует текстовые представления IP-адресов..

      Удалить
    2. Ну минус все-же должен идти отдельно (имхо :)
      С битыми указателями проблему решить просто (правда смысла не имеет) а с переполнением сложнее. Впрочем, чуть ниже я ответил :)

      Удалить
  7. *извиняюсь конечно! Здесь можно редактировать свои посты?

    ОтветитьУдалить
  8. Неправильный ответ :) Когда в названиях папок (или других сортируемых строк) будет много подряд идущих цифр (например строка с точной датой и временем "201306071810000"). В зависимости от опций компилятора можно будет и переполнение и иксепшен в StrToInt
    Если вечером будет время наваяю и кину свой вариант :)

    ОтветитьУдалить
    Ответы
    1. Да, действительно, этот нюанс не учтен :)
      Хм, придется копнуть поглубже с целью разузнать - как оригинальная сортировка обрабатывает данные моменты :)
      Спасибо.

      Удалить
  9. Анонимный10 июня 2013 г., 9:46

    function CompareStr( Str1, Str2: string ): Integer;
    var
    Num1,Num2:Double;
    pStr1,pStr2:PChar;
    Len1,Len2:Integer;

    function IsNumber( ch: Char ): Boolean;
    begin
    Result := ch in ['0'..'9'];
    end;

    function GetNumber( var pch: PChar; var Len: Integer ): Double;
    var
    FoundPeriod: Boolean;
    Count: Integer;
    begin
    FoundPeriod := False;
    Result := 0;
    while ( pch^ <> #0 ) and ( IsNumber( pch^ ) or ( ( not FoundPeriod ) and ( pch^ = '.' ) ) ) do
    begin
    if pch^ = '.' then
    begin
    FoundPeriod := True;
    Count := 0;
    end
    else
    begin
    if FoundPeriod then
    begin
    Inc( Count );
    Result := Result + ( Ord( pch^ ) - Ord( '0' ) ) * Power( 10, -Count );
    end
    else
    Result := Result * 10 + Ord( pch^ ) - Ord( '0' );
    end;
    Inc( Len );
    Inc( pch );
    end;
    end;

    begin
    if ( Str1<>'' ) and ( Str2<>'' ) then
    begin
    pStr1 := @Str1[1];
    pStr2 := @Str2[1];
    Result := 0;
    while not ( ( pStr1^ = #0 ) or ( pStr2^ = #0 ) ) do
    begin
    Len1 := 0;
    Len2 := 0;
    while ( pStr1^ = ' ' ) do
    begin
    Inc( pStr1 );
    Inc( Len1 );
    end;
    while ( pStr2^ = ' ' ) do
    begin
    Inc( pStr2 );
    Inc( Len2 );
    end;
    if IsNumber( pStr1^ ) and IsNumber( pStr2^ ) then
    begin
    Num1 := GetNumber( pStr1, Len1 );
    Num2:=GetNumber( pStr2, Len2 );
    if Num1 < Num2 then
    Result := -1
    else
    if Num1 > Num2 then
    Result := 1
    else
    begin
    if Len1 < Len2 then
    Result := -1
    else
    if Len1 > Len2 then
    Result := 1;
    end;
    Dec( pStr1 );Dec( pStr2 );
    end
    else
    if pStr1^ <> pStr2^ then
    begin
    if pStr1^ < pStr2^ then
    Result := -1
    else
    Result := 1;
    end;
    if Result <> 0 then
    Break;
    Inc( pStr1 );
    Inc( pStr2 );
    end;
    end;
    Num1 := Length( Str1 );
    Num2 := Length( Str2 );
    if ( Result = 0 ) and ( Num1 <> Num2 ) then
    if Num1 < Num2 then
    Result := -1
    else
    Result := 1;
    end;

    ОтветитьУдалить
  10. Несколько мыслей по поводу статьи и комментов:
    1. Проверять на вещественные и отрицательные числа имхо бред. Тогда по идее надо учитывать настройки локали и форматирование чисел. Что приведет к различным вариантам сортировки на разных компьютерах т.е. недетерминированности.
    2. Чтобы добиться сортировки "как у проводника" то тогда нужно использовать, как правильно отметили StrCmpLogicalW (хоть она и не всегда логична как указал автор)
    3. Не следует использовать получение числа из строки - чревато переполнением
    4. Предлагаю, как обещал, свой вариант, простой и быстрый, правда особо не тестировал, поскольку четвертый час ночи и очень хочется спать :)

    function SmartStringCompare(const S1, S2: string): Integer;

    function CheckSymbols(var P1, P2: PWideChar; var ACompare: Integer): Boolean; inline;
    begin
    ACompare := Ord(P1^) - Ord(P2^);
    Inc(P1);
    Inc(P2);
    Result := ACompare <> 0;
    end;

    function IsDigit(P: PWideChar): Boolean; inline;
    begin
    Result := (P^ >= '0') and (P^ <= '9');
    end;

    procedure GetNumberInfo(var P: PWideChar; out ALen, AZeroLen: Integer);
    begin
    ALen := 0;
    AZeroLen := 0;
    repeat
    if (ALen = 0) and (P^ = '0') then
    Inc(AZeroLen)
    else
    Inc(ALen);
    Inc(P);
    until (P^ = #0) or not IsDigit(P);
    end;

    function CompareNumbers(var P1, P2: PWideChar): Integer;
    var
    ALen1, AZeroLen1, ALen2, AZeroLen2: Integer;
    begin
    Result := 0;
    GetNumberInfo(P1, ALen1, AZeroLen1);
    GetNumberInfo(P2, ALen2, AZeroLen2);
    Result := ALen1 - ALen2;
    if Result = 0 then
    begin
    if ALen1 > 0 then
    begin
    Dec(P1, ALen1);
    Dec(P2, ALen1);
    repeat
    if CheckSymbols(P1, P2, Result) then
    Exit;
    Dec(ALen1);
    until ALen1 = 0;
    end;
    Result := AZeroLen1 - AZeroLen2;
    end;
    end;

    var
    P1, P2: PWideChar;
    begin
    P1 := PWideChar(S1);
    P2 := PWideChar(S2);
    while (P1^ <> #0) and (P2 <> #0) do
    begin
    if IsDigit(P1) and IsDigit(P2) then
    begin
    Result := CompareNumbers(P1, P2);
    if Result <> 0 then
    Exit;
    end;
    if CheckSymbols(P1, P2, Result) then
    Exit;
    end;
    CheckSymbols(P1, P2, Result);
    end;

    PS:
    Используется расширенная трактовка результата >0, <0, =0 что обычно достаточно для передачи в функции сортировки, как WinAPI так и Delphi, но желающие могут нормализовать результат до констант -1, 1 и 0.
    PPS:
    За регистронезависиммость отвечает каллер, таким образом использование функции становится более универсальным.

    ОтветитьУдалить
  11. С утра подумав нашел багу в своём решении. Исправленный вариант выложу как будет время. И для формализации условия, как должны сравниваться пары строк ("01a001", "001a01") и ("01a0001", "001a01") ?

    ОтветитьУдалить
    Ответы
    1. Анонимный11 июня 2013 г., 11:00

      Думаю
      "01a001" > "001a01"
      "01a0001" > "001a01"

      Удалить
    2. Кстати ТЗ автора содержит интересный нюанс при сравнении чисел "00" < "000" но "01" > "001".
      И ещё, если в моём коде инвертировать значение одной строки, то получится аналог StrCmpLogicalW, по крайней мере мне не удалось обнаружить когда они бы выдали разные результаты

      Удалить
    3. Анонимный17 июня 2013 г., 9:24

      Константин, когда выложите свой исправленный вариант?

      Удалить
  12. Да всё не было времени, да и пробел в ТЗ. Хотел у автора по алгоритму подсмотреть, а в нем недетерминированность. В зависимости от звезд список может отсортироваться как "01" > "001" так и "01" < "001". А обновленный вариант моей сортировки:

    function dxSmartStringCompare(const S1, S2: string): Integer;
    var
    P1, P2: PWideChar;
    CompareNumLen: Integer;

    function IsEndCompare: Boolean;
    begin
    Result := (P1^ = #0) or (P2^ = #0);
    end;

    function CheckSymbols(var ACompare: Integer): Boolean;
    begin
    ACompare := Ord(P1^) - Ord(P2^);
    if not IsEndCompare then
    begin
    Inc(P1);
    Inc(P2);
    end;
    Result := ACompare <> 0;
    end;

    function IsDigit(P: PWideChar): Boolean; inline;
    begin
    Result := (P^ >= '0') and (P^ <= '9');
    end;

    procedure GetNumberInfo(var P: PWideChar; out ALen, AZeroLen: Integer);
    begin
    ALen := 0;
    AZeroLen := 0;
    repeat
    if (ALen = 0) and (P^ = '0') then
    Inc(AZeroLen)
    else
    Inc(ALen);
    Inc(P);
    until (P^ = #0) or not IsDigit(P);
    end;

    function CompareNumbers: Integer;
    var
    ALen1, AZeroLen1, ALen2, AZeroLen2: Integer;
    begin
    Result := 0;
    GetNumberInfo(P1, ALen1, AZeroLen1);
    GetNumberInfo(P2, ALen2, AZeroLen2);
    Result := ALen1 - ALen2;
    if Result = 0 then
    begin
    if ALen1 > 0 then
    begin
    Dec(P1, ALen1);
    Dec(P2, ALen1);
    repeat
    if CheckSymbols(Result) then
    Exit;
    Dec(ALen1);
    until ALen1 = 0;
    end;
    if CompareNumLen = 0 then
    CompareNumLen := AZeroLen1 - AZeroLen2;
    end;
    end;

    begin
    CompareNumLen := 0;
    P1 := PWideChar(S1);
    P2 := PWideChar(S2);
    while not IsEndCompare do
    begin
    if IsDigit(P1) and IsDigit(P2) then
    begin
    Result := CompareNumbers;
    if Result <> 0 then
    Exit;
    end;
    if CheckSymbols(Result) then
    Exit;
    end;
    CheckSymbols(Result);
    if Result = 0 then
    Result := CompareNumLen;
    end;

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

    CompareNumLen := AZeroLen1 - AZeroLen2;

    ОтветитьУдалить
    Ответы
    1. В оригинале в своей задаче я использую вот такой вариант: http://www.delphimaster.ru/cgi-bin/forum.pl?id=1370081918&n=3&from=51
      Он нам больше всего после длительных совещаний подошел :)

      Удалить
  13. Анонимный10 июля 2013 г., 15:38

    Какя-то дичь эта вся ваша сортировка.
    Например, StrCmpLogicalW даёт

    A_1
    A_1-1
    A_11

    CompareStringOrdinal и dxSmartStringCompare дают

    A_1-1
    A_1
    A_11

    "-" - это разделитель, поэтому StrCmpLogicalW ведёт себя правильно (видимо, учитывая длину строки). Исправив "ведущие нули", возможно, наделали новых багов. Пока что только автор Total Commander справился с нативной сортировкой (там всё нормально и с нулями и мой пример).

    ОтветитьУдалить
  14. отсортируй данный список
    01. Arianna
    02. Ebben
    03. Addio
    04. Horizon
    05. Barcarolle
    06. Cantilena
    07. Sviraj
    08. Interlude
    09. Pavane
    10. Ave Maria
    11. Leiermann
    12. Lullabye

    ОтветитьУдалить