tag:blogger.com,1999:blog-2374465879949372415.post5514849117897914785..comments2023-04-16T14:22:53.095+03:00Comments on Блог Rouse_: Сортировка списка по аналогу "Проводника Windows"Александр (Rouse_) Багельhttp://www.blogger.com/profile/03072586754182036553noreply@blogger.comBlogger26125tag:blogger.com,1999:blog-2374465879949372415.post-59002073566503981822014-05-19T22:00:57.546+04:002014-05-19T22:00:57.546+04:00отсортируй данный список
01. Arianna
02. Ebben
03....отсортируй данный список<br />01. Arianna<br />02. Ebben<br />03. Addio<br />04. Horizon<br />05. Barcarolle<br />06. Cantilena<br />07. Sviraj<br />08. Interlude<br />09. Pavane<br />10. Ave Maria<br />11. Leiermann<br />12. Lullabyerobtnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-62959284712966469622013-07-10T15:38:36.014+04:002013-07-10T15:38:36.014+04:00Какя-то дичь эта вся ваша сортировка.
Например, St...Какя-то дичь эта вся ваша сортировка.<br />Например, StrCmpLogicalW даёт<br /><br />A_1<br />A_1-1<br />A_11<br /><br />CompareStringOrdinal и dxSmartStringCompare дают<br /> <br />A_1-1<br />A_1<br />A_11<br /><br />"-" - это разделитель, поэтому StrCmpLogicalW ведёт себя правильно (видимо, учитывая длину строки). Исправив "ведущие нули", возможно, наделали новых багов. Пока что только автор Total Commander справился с нативной сортировкой (там всё нормально и с нулями и мой пример).<br />Anonymousnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-87550943411394964162013-06-20T19:23:40.000+04:002013-06-20T19:23:40.000+04:00В оригинале в своей задаче я использую вот такой в...В оригинале в своей задаче я использую вот такой вариант: http://www.delphimaster.ru/cgi-bin/forum.pl?id=1370081918&n=3&from=51<br />Он нам больше всего после длительных совещаний подошел :)Александр (Rouse_) Багельhttps://www.blogger.com/profile/03072586754182036553noreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-48513242448669002122013-06-20T04:36:58.223+04:002013-06-20T04:36:58.223+04:00Да всё не было времени, да и пробел в ТЗ. Хотел у ...Да всё не было времени, да и пробел в ТЗ. Хотел у автора по алгоритму подсмотреть, а в нем недетерминированность. В зависимости от звезд список может отсортироваться как "01" > "001" так и "01" < "001". А обновленный вариант моей сортировки:<br /><br />function dxSmartStringCompare(const S1, S2: string): Integer;<br />var<br /> P1, P2: PWideChar;<br /> CompareNumLen: Integer;<br /><br /> function IsEndCompare: Boolean;<br /> begin<br /> Result := (P1^ = #0) or (P2^ = #0);<br /> end;<br /><br /> function CheckSymbols(var ACompare: Integer): Boolean;<br /> begin<br /> ACompare := Ord(P1^) - Ord(P2^);<br /> if not IsEndCompare then<br /> begin<br /> Inc(P1);<br /> Inc(P2);<br /> end;<br /> Result := ACompare <> 0;<br /> end;<br /><br /> function IsDigit(P: PWideChar): Boolean; inline;<br /> begin<br /> Result := (P^ >= '0') and (P^ <= '9');<br /> end;<br /><br /> procedure GetNumberInfo(var P: PWideChar; out ALen, AZeroLen: Integer);<br /> begin<br /> ALen := 0;<br /> AZeroLen := 0;<br /> repeat<br /> if (ALen = 0) and (P^ = '0') then<br /> Inc(AZeroLen)<br /> else<br /> Inc(ALen);<br /> Inc(P);<br /> until (P^ = #0) or not IsDigit(P);<br /> end;<br /><br /> function CompareNumbers: Integer;<br /> var<br /> ALen1, AZeroLen1, ALen2, AZeroLen2: Integer;<br /> begin<br /> Result := 0;<br /> GetNumberInfo(P1, ALen1, AZeroLen1);<br /> GetNumberInfo(P2, ALen2, AZeroLen2);<br /> Result := ALen1 - ALen2;<br /> if Result = 0 then<br /> begin<br /> if ALen1 > 0 then<br /> begin<br /> Dec(P1, ALen1);<br /> Dec(P2, ALen1);<br /> repeat<br /> if CheckSymbols(Result) then<br /> Exit;<br /> Dec(ALen1);<br /> until ALen1 = 0;<br /> end;<br /> if CompareNumLen = 0 then<br /> CompareNumLen := AZeroLen1 - AZeroLen2;<br /> end;<br /> end;<br /><br />begin<br /> CompareNumLen := 0;<br /> P1 := PWideChar(S1);<br /> P2 := PWideChar(S2);<br /> while not IsEndCompare do<br /> begin<br /> if IsDigit(P1) and IsDigit(P2) then<br /> begin<br /> Result := CompareNumbers;<br /> if Result <> 0 then<br /> Exit;<br /> end;<br /> if CheckSymbols(Result) then<br /> Exit;<br /> end;<br /> CheckSymbols(Result);<br /> if Result = 0 then<br /> Result := CompareNumLen;<br />end;<br /><br />а кому надо чтоб с лидирующими нулями были выше в списке, могут инвертировать строчку:<br /><br /> CompareNumLen := AZeroLen1 - AZeroLen2;<br />Константинhttp://www.devexpress.comnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-59707990537565731682013-06-17T09:24:20.810+04:002013-06-17T09:24:20.810+04:00Константин, когда выложите свой исправленный вариа...Константин, когда выложите свой исправленный вариант?Anonymousnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-25626722148115563212013-06-12T16:37:18.011+04:002013-06-12T16:37:18.011+04:00Кстати ТЗ автора содержит интересный нюанс при сра...Кстати ТЗ автора содержит интересный нюанс при сравнении чисел "00" < "000" но "01" > "001".<br />И ещё, если в моём коде инвертировать значение одной строки, то получится аналог StrCmpLogicalW, по крайней мере мне не удалось обнаружить когда они бы выдали разные результатыКонстантинhttp://www.devexpress.comnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-43423201068252037122013-06-11T11:00:25.269+04:002013-06-11T11:00:25.269+04:00Думаю
"01a001" > "001a01"
&...Думаю<br />"01a001" > "001a01"<br />"01a0001" > "001a01"Anonymousnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-46160529061918725632013-06-11T10:33:30.730+04:002013-06-11T10:33:30.730+04:00С утра подумав нашел багу в своём решении. Исправл...С утра подумав нашел багу в своём решении. Исправленный вариант выложу как будет время. И для формализации условия, как должны сравниваться пары строк ("01a001", "001a01") и ("01a0001", "001a01") ?Константинhttp://www.devexpress.comnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-12290989038442549452013-06-11T03:37:02.075+04:002013-06-11T03:37:02.075+04:00Несколько мыслей по поводу статьи и комментов:
1....Несколько мыслей по поводу статьи и комментов: <br />1. Проверять на вещественные и отрицательные числа имхо бред. Тогда по идее надо учитывать настройки локали и форматирование чисел. Что приведет к различным вариантам сортировки на разных компьютерах т.е. недетерминированности.<br />2. Чтобы добиться сортировки "как у проводника" то тогда нужно использовать, как правильно отметили StrCmpLogicalW (хоть она и не всегда логична как указал автор)<br />3. Не следует использовать получение числа из строки - чревато переполнением<br />4. Предлагаю, как обещал, свой вариант, простой и быстрый, правда особо не тестировал, поскольку четвертый час ночи и очень хочется спать :)<br /><br />function SmartStringCompare(const S1, S2: string): Integer;<br /><br /> function CheckSymbols(var P1, P2: PWideChar; var ACompare: Integer): Boolean; inline;<br /> begin<br /> ACompare := Ord(P1^) - Ord(P2^);<br /> Inc(P1);<br /> Inc(P2);<br /> Result := ACompare <> 0;<br /> end;<br /><br /> function IsDigit(P: PWideChar): Boolean; inline;<br /> begin<br /> Result := (P^ >= '0') and (P^ <= '9');<br /> end;<br /><br /> procedure GetNumberInfo(var P: PWideChar; out ALen, AZeroLen: Integer);<br /> begin<br /> ALen := 0;<br /> AZeroLen := 0;<br /> repeat<br /> if (ALen = 0) and (P^ = '0') then<br /> Inc(AZeroLen)<br /> else<br /> Inc(ALen);<br /> Inc(P);<br /> until (P^ = #0) or not IsDigit(P);<br /> end;<br /><br /> function CompareNumbers(var P1, P2: PWideChar): Integer;<br /> var<br /> ALen1, AZeroLen1, ALen2, AZeroLen2: Integer;<br /> begin<br /> Result := 0;<br /> GetNumberInfo(P1, ALen1, AZeroLen1);<br /> GetNumberInfo(P2, ALen2, AZeroLen2);<br /> Result := ALen1 - ALen2;<br /> if Result = 0 then<br /> begin<br /> if ALen1 > 0 then<br /> begin<br /> Dec(P1, ALen1);<br /> Dec(P2, ALen1);<br /> repeat<br /> if CheckSymbols(P1, P2, Result) then<br /> Exit;<br /> Dec(ALen1);<br /> until ALen1 = 0;<br /> end;<br /> Result := AZeroLen1 - AZeroLen2;<br /> end;<br /> end;<br /><br />var<br /> P1, P2: PWideChar;<br />begin<br /> P1 := PWideChar(S1);<br /> P2 := PWideChar(S2);<br /> while (P1^ <> #0) and (P2 <> #0) do<br /> begin<br /> if IsDigit(P1) and IsDigit(P2) then<br /> begin<br /> Result := CompareNumbers(P1, P2);<br /> if Result <> 0 then<br /> Exit;<br /> end;<br /> if CheckSymbols(P1, P2, Result) then<br /> Exit;<br /> end;<br /> CheckSymbols(P1, P2, Result);<br />end;<br /><br />PS:<br /> Используется расширенная трактовка результата >0, <0, =0 что обычно достаточно для передачи в функции сортировки, как WinAPI так и Delphi, но желающие могут нормализовать результат до констант -1, 1 и 0. <br />PPS:<br /> За регистронезависиммость отвечает каллер, таким образом использование функции становится более универсальным.<br />Константинhttp://www.devexpress.comnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-9449298660792922362013-06-10T09:46:03.587+04:002013-06-10T09:46:03.587+04:00function CompareStr( Str1, Str2: string ): Integer...function CompareStr( Str1, Str2: string ): Integer;<br />var<br /> Num1,Num2:Double;<br /> pStr1,pStr2:PChar;<br /> Len1,Len2:Integer;<br /> <br /> function IsNumber( ch: Char ): Boolean;<br /> begin<br /> Result := ch in ['0'..'9'];<br /> end;<br /> <br /> function GetNumber( var pch: PChar; var Len: Integer ): Double;<br /> var<br /> FoundPeriod: Boolean;<br /> Count: Integer;<br /> begin<br /> FoundPeriod := False;<br /> Result := 0;<br /> while ( pch^ <> #0 ) and ( IsNumber( pch^ ) or ( ( not FoundPeriod ) and ( pch^ = '.' ) ) ) do<br /> begin<br /> if pch^ = '.' then<br /> begin<br /> FoundPeriod := True;<br /> Count := 0;<br /> end<br /> else<br /> begin<br /> if FoundPeriod then<br /> begin<br /> Inc( Count );<br /> Result := Result + ( Ord( pch^ ) - Ord( '0' ) ) * Power( 10, -Count );<br /> end<br /> else<br /> Result := Result * 10 + Ord( pch^ ) - Ord( '0' );<br /> end;<br /> Inc( Len );<br /> Inc( pch );<br /> end;<br /> end;<br /> <br />begin<br /> if ( Str1<>'' ) and ( Str2<>'' ) then<br /> begin<br /> pStr1 := @Str1[1];<br /> pStr2 := @Str2[1];<br /> Result := 0;<br /> while not ( ( pStr1^ = #0 ) or ( pStr2^ = #0 ) ) do<br /> begin<br /> Len1 := 0;<br /> Len2 := 0;<br /> while ( pStr1^ = ' ' ) do<br /> begin<br /> Inc( pStr1 );<br /> Inc( Len1 );<br /> end;<br /> while ( pStr2^ = ' ' ) do<br /> begin<br /> Inc( pStr2 );<br /> Inc( Len2 );<br /> end;<br /> if IsNumber( pStr1^ ) and IsNumber( pStr2^ ) then<br /> begin<br /> Num1 := GetNumber( pStr1, Len1 );<br /> Num2:=GetNumber( pStr2, Len2 );<br /> if Num1 < Num2 then<br /> Result := -1<br /> else<br /> if Num1 > Num2 then<br /> Result := 1<br /> else<br /> begin<br /> if Len1 < Len2 then<br /> Result := -1<br /> else<br /> if Len1 > Len2 then<br /> Result := 1;<br /> end;<br /> Dec( pStr1 );Dec( pStr2 );<br /> end<br /> else<br /> if pStr1^ <> pStr2^ then<br /> begin<br /> if pStr1^ < pStr2^ then<br /> Result := -1<br /> else<br /> Result := 1;<br /> end;<br /> if Result <> 0 then<br /> Break;<br /> Inc( pStr1 );<br /> Inc( pStr2 );<br /> end;<br /> end;<br /> Num1 := Length( Str1 );<br /> Num2 := Length( Str2 );<br /> if ( Result = 0 ) and ( Num1 <> Num2 ) then<br /> if Num1 < Num2 then<br /> Result := -1<br /> else<br /> Result := 1;<br />end;Anonymousnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-59163822453957698952013-06-07T20:07:31.384+04:002013-06-07T20:07:31.384+04:00Ну минус все-же должен идти отдельно (имхо :)
С би...Ну минус все-же должен идти отдельно (имхо :)<br />С битыми указателями проблему решить просто (правда смысла не имеет) а с переполнением сложнее. Впрочем, чуть ниже я ответил :)Александр (Rouse_) Багельhttps://www.blogger.com/profile/03072586754182036553noreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-47418863455886970192013-06-07T20:05:21.421+04:002013-06-07T20:05:21.421+04:00Да, действительно, этот нюанс не учтен :)
Хм, прид...Да, действительно, этот нюанс не учтен :)<br />Хм, придется копнуть поглубже с целью разузнать - как оригинальная сортировка обрабатывает данные моменты :)<br />Спасибо.Александр (Rouse_) Багельhttps://www.blogger.com/profile/03072586754182036553noreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-44810673045269664192013-06-07T18:15:23.641+04:002013-06-07T18:15:23.641+04:00Кстати да, переполнение Integer может произойти. Е...Кстати да, переполнение Integer может произойти. Если строка содержит очень большое количество цифр.<br />Ещё вот к примеру, такие строки:<br />-15.26р<br />-15.3р<br /><br />вещественное число 15.3 больше 15.26, но алгоритм число после точки выделит отдельно, и отсортирует так:<br />-15.3р<br />-15.26р<br /><br /><br />...и ещё интересно бы посмотреть, как он сортирует текстовые представления IP-адресов..Николай Зверевhttps://www.blogger.com/profile/08965247674233981930noreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-20712088692608559962013-06-07T18:15:08.504+04:002013-06-07T18:15:08.504+04:00Неправильный ответ :) Когда в названиях папок (или...Неправильный ответ :) Когда в названиях папок (или других сортируемых строк) будет много подряд идущих цифр (например строка с точной датой и временем "201306071810000"). В зависимости от опций компилятора можно будет и переполнение и иксепшен в StrToInt<br />Если вечером будет время наваяю и кину свой вариант :)Константинhttp://www.devexpress.comnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-6280973245936385732013-06-07T10:14:22.424+04:002013-06-07T10:14:22.424+04:00Нет, только добавлять новый.Нет, только добавлять новый.Александр (Rouse_) Багельhttps://www.blogger.com/profile/03072586754182036553noreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-12468917341110981532013-06-07T10:13:59.753+04:002013-06-07T10:13:59.753+04:00В случае битых указателей? :)В случае битых указателей? :)Александр (Rouse_) Багельhttps://www.blogger.com/profile/03072586754182036553noreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-39447516036774200112013-06-07T01:03:36.274+04:002013-06-07T01:03:36.274+04:00*извиняюсь конечно! Здесь можно редактировать свои...*извиняюсь конечно! Здесь можно редактировать свои посты?Константинhttp://www.devexpress.comnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-81261899051806769952013-06-07T01:00:06.863+04:002013-06-07T01:00:06.863+04:00Я конечно дико извеняюсь, но оба предложенные вари...Я конечно дико извеняюсь, но оба предложенные варианты имеют ошибки :) В частности могут давать неверную сортировку и вываливать исключительную ситуацию. Догадаетесь в каких случаях? ;)Константинhttp://www.devexpress.comnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-25855888580729552262013-06-03T11:25:21.590+04:002013-06-03T11:25:21.590+04:00>> А так не проще? (жаль что форматирование ...>> А так не проще? (жаль что форматирование кода не сохраняется)<br />>> function StrCmpDig( const Str1, Str2: string ): Integer;<br /><br />Да, так тоже можно, только накладные расходы будут бОльшими на реаллоках из-за вызова StrToInt и CopyАлександр (Rouse_) Багельhttps://www.blogger.com/profile/03072586754182036553noreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-4662695213734085122013-06-02T07:21:17.460+04:002013-06-02T07:21:17.460+04:00Очень давно использую
function StrCmpLogicalW; ext...Очень давно использую<br />function StrCmpLogicalW; external 'Shlwapi.dll' name 'StrCmpLogicalW';<br />в коде проверить только, что "XPandUP"Anonymousnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-16292313582694327662013-06-01T23:07:34.244+04:002013-06-01T23:07:34.244+04:00function IsDigit( c: Char ): Boolean;
begin
Res...function IsDigit( c: Char ): Boolean;<br />begin<br /> Result := ( c >= '0' ) and ( c <= '9' );<br />end;<br /><br />function DigitLen( Str: string; Index: Integer ): Integer;<br />var<br /> i: integer;<br />begin<br /> Result := 0;<br /> for i := Index to Length( Str ) do<br /> if IsDigit( Str[i] ) then<br /> Inc( Result )<br /> else<br /> Break;<br />end;Anonymousnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-41010941152098599502013-06-01T23:05:26.916+04:002013-06-01T23:05:26.916+04:00А так не проще? (жаль что форматирование кода не с...А так не проще? (жаль что форматирование кода не сохраняется)<br /><br />function StrCmpDig( const Str1, Str2: string ): Integer;<br />var<br /> i, Len, Digit1, Digit2, DigitLen1, DigitLen2: Integer;<br />begin<br /> if Trim( Str1 ) = Trim( Str2 ) then Exit( 0 );<br /> if ( Str1 = '' ) then Exit( -1 );<br /> if ( Str2 = '' ) then Exit( 1 );<br /> <br /> Len := Max( Length( Str1 ), Length( Str2 ) );<br /> i := 1;<br /> <br /> while i <= Len do<br /> begin<br /> if IsDigit( Str1[i] ) and ( IsDigit( Str2[i] ) ) and ( Str1[i] <> '0' ) and ( Str2[i] <> '0' ) then<br /> begin<br /> DigitLen1 := DigitLen( Str1, i );<br /> DigitLen2 := DigitLen( Str2, i );<br /> Digit1 := StrToInt( Copy( Str1, i, DigitLen1 ) );<br /> Digit2 := StrToInt( Copy( Str2, i, DigitLen2 ) );<br /> if Digit1 < Digit2 then Exit( -1 );<br /> if Digit1 > Digit2 then Exit( 1 );<br /> Inc( i, Min( DigitLen1, DigitLen2 ) );<br /> Continue;<br /> end;<br /> if Str1[i] < Str2[i] then Exit( -1 );<br /> if Str1[i] > Str2[i] then Exit( 1 );<br /> Inc( i );<br /> end;<br /> Result := 0;<br />end;Anonymousnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-85255676225114424972013-06-01T17:06:09.661+04:002013-06-01T17:06:09.661+04:00>>> Анонимный1 июня 2013 г., 16:59
Говори...>>> Анонимный1 июня 2013 г., 16:59<br />Говорила-ж мне Мама: "Учи Русский, а то так Беларусом и останешься" :)<br />Выпилил данную фразу, вроде и без нее нормально :)Александр (Rouse_) Багельhttps://www.blogger.com/profile/03072586754182036553noreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-64929006414060553872013-06-01T16:59:10.136+04:002013-06-01T16:59:10.136+04:00сравни:
результат вам (что сделает?) понравится
...сравни:<br /> результат вам (что сделает?) понравится<br /> результат вам должен (что сделать?) понравитьсяAnonymousnoreply@blogger.comtag:blogger.com,1999:blog-2374465879949372415.post-68399104130137983302013-06-01T16:02:45.070+04:002013-06-01T16:02:45.070+04:00Да вроде Ожегов с "нравиться" не спорит ...Да вроде Ожегов с "нравиться" не спорит :)<br />http://dic.academic.ru/dic.nsf/ogegova/128606Александр (Rouse_) Багельhttps://www.blogger.com/profile/03072586754182036553noreply@blogger.com