naturalstrcmp function lazarus / 32-Linux ---------------------------------------------------------------------- typo · 2015-05-05 12:36 Where is it declared? Thanks. ---------------------------------------------------------------------- typo · 2015-05-08 09:57 I am declaring it as external, but what to put in LIBNAME? Code: [Select]function naturalstrcmp(s, t: PChar): Integer; external 'LIBNAME' name 'naturalstrcmp'; The package is in /usr/share/man/man3/naturalstrcmp.3.gz Also, when I try to compile it, I get the message: "Warning: link.res contains output sections, did you forget?" ---------------------------------------------------------------------- marcov · 2015-05-08 10:15 The library should be mentioned in the manual page. I don't have it on my (freebsd) system.  Internet seems to say it is "mut" since it mentions the header "mut.h", but sometimes multiple headers resolve to one library. The link.res message is only a warning. If it links it is probably in libc. ---------------------------------------------------------------------- typo · 2015-05-08 10:45 It is here too: https://www.freebsd.org/cgi/man.cgi?query=naturalstrcmp&sektion=3&manp ath=FreeBSD+10.1-RELEASE+and+Ports ---------------------------------------------------------------------- marcov · 2015-05-08 11:58 "mbk utility function" doesn't sound like a system function, more something of a package. If I search for that, I encounter either the package "alliance" or open lisp. ---------------------------------------------------------------------- typo · 2015-05-08 12:18 Lazarus cannot find them on my Debian system. ---------------------------------------------------------------------- marcov · 2015-05-08 12:24 Quote from: typo on May 08, 2015, 02:18:18 pmLazarus cannot find them on my Debian system. I just tested, and my debian 7.8 doesn't have a manual page for naturalstrcmp, nor a mut.h header in /usr/include (and deeper) ---------------------------------------------------------------------- typo · 2015-05-09 11:28 I have found this page: http://manned.org/naturalstrcmp/e011433d It points to another package name: man1/alc_origin.1 My error message on Debian says: /usr/bin/ld: cannot find -lalliance ---------------------------------------------------------------------- typo · 2015-05-10 09:11 What is the libname I should put in my external declaration? On my Debian 7.7 it is on /usr/share/man/man3/naturalstrcmp.3.gz from Alliance package. I tried : Code: [Select]function naturalstrcmp(s, t: PChar): Integer; external 'alliance' name 'naturalstrcmp'; without success. The error message says that "cannot find -lalliance". ---------------------------------------------------------------------- typo · 2015-05-11 11:06 I tried: Code: [Select]function naturalstrcmp(s, t: PChar): Integer; external 'libMut.so' name 'naturalstrcmp'; but when I declare this function, the debugger returns an error condition. ---------------------------------------------------------------------- rvk · 2015-05-11 12:07 Ok, I got that working (on Ubuntu and my zero knowledge of Linux- desktops ). First you need the Alliance package. When you installed it you need to create a link from /usr/lib/alliance/libMut.so to /usr/lib/libMut.so Code: [Select]cd /usr/lib ln -s ./alliance/libMut.so libMut.so Now you have a valid libMut.so Now define this: Code: [Select]function naturalstrcmp(s, t: PChar): Integer; external 'Mut.so' name 'naturalstrcmp'; It should compile. Or are you having trouble running it? (Aaah, I see the debugger problem) ---------------------------------------------------------------------- typo · 2015-05-11 12:21 Done, but it persists. ---------------------------------------------------------------------- rvk · 2015-05-11 12:24 Is the Alliance package 64 bit or 32 bit? (i386 or x86_64) and does it match your Lazarus installation? ---------------------------------------------------------------------- typo · 2015-05-11 12:39 32 bit, i386. It matches Lazarus installation. ---------------------------------------------------------------------- typo · 2015-05-11 15:49 http://postimg.org/image/ty2kn3yvp/ What circunstances could cause this? ---------------------------------------------------------------------- rvk · 2015-05-12 08:43 Have your tried loading the libMut.so dynamically? This works for me. Code: [Select]// don't load it via external // function naturalstrcmp(const s: PChar; const t: PChar): Integer; external 'Mut.so' name 'naturalstrcmp'; procedure UseDLL; type   TMyFunc=function (const s: PChar; const t: PChar): Integer; cdecl; var   MyLibC: TLibHandle = dynlibs.NilHandle;   MyFunc: TMyFunc;   FuncResult: integer; begin   MyLibC := LoadLibrary('libMut.' + SharedSuffix);   if MyLibC = dynlibs.NilHandle then   begin     Showmessage('.so not loaded');     Exit;  //DLL was not loaded successfully   end;   MyFunc:= TMyFunc(GetProcedureAddress(MyLibC, 'naturalstrcmp'));   FuncResult:= MyFunc(PChar('a2'), PChar('a03'));  //Executes the function   Showmessage(IntToStr(FuncResult));   FuncResult:= MyFunc(PChar('a03'), PChar('a2'));  //Executes the function   Showmessage(IntToStr(FuncResult));   if MyLibC <>  DynLibs.NilHandle then     if FreeLibrary(MyLibC) then       MyLibC:= DynLibs.NilHandle;  //Unload the lib, if already loaded end; procedure TForm1.Button1Click(Sender: TObject); begin   UseDLL; end; I've been reading this: http://wiki.lazarus.freepascal.org/Lazarus/FPC_Libraries#Initializatio n Maybe there is some problem loading this library on startup of a Lazarus program. Loading it dynamically solves that. (learned a lot about Linux today ) ---------------------------------------------------------------------- typo · 2015-05-12 09:29 This worked for me, thanks. ---------------------------------------------------------------------- typo · 2015-05-12 13:16 I am disappointed with this function, it does not sort naturally neither sorts properly in local alphabetical order. Am I doing something wrong? ---------------------------------------------------------------------- rvk · 2015-05-12 13:45 According to this: http://www.unix.com/man-page/debian/3/NATURALSTRCMP/ Quotenaturalstrcmp is an alphanumerical comparison function that ensures x12 > x2 for example. First, the alphabetical part of the string is compared, using strcmp(3), then, if it has trailing numbers, they are compared using a numerical function. It should give the same result for x3 > x2 as for x12 > x2. But with this the result is different: Code: [Select]// Result x12 > x2 = -1 (false) FuncResult:= MyFunc(PChar('x12'), PChar('x2'));  //Executes the function Showmessage(IntToStr(FuncResult)); // Result x3 > x2 = 1 (true) FuncResult:= MyFunc(PChar('x3'), PChar('x2'));  //Executes the function Showmessage(IntToStr(FuncResult));        Strange indeed. x12 > x2 should give -1 with the normal strcmp, but in naturalstrcmp it gives the same. ---------------------------------------------------------------------- rvk · 2015-05-12 14:23 @typo... What are you planning on using this function for?? Does the strverscmp-function in libc.so not work for you? (It's the same function used internally for versionsort, which in turn is used to sort directory entries) http://man7.org/linux/man-pages/man3/strverscmp.3.html Code: [Select]function strverscmp(__s1:Pchar; __s2:Pchar):longint;cdecl;external 'libc.so' name 'strverscmp'; procedure TForm1.Button1Click(Sender: TObject); var   Rs: Integer; begin   // Result = 1   Rs := strverscmp(pChar('x12'), pChar('x2'));   Showmessage(IntToStr(Rs));   // Result = 1   Rs := strverscmp(pChar('x3'), pChar('x2'));   Showmessage(IntToStr(Rs));   // Result = -1   Rs := strverscmp(pChar('a12'), pChar('b2'));   Showmessage(IntToStr(Rs));   // Result = 1   Rs := strverscmp(pChar('c3'), pChar('b2'));   Showmessage(IntToStr(Rs)); end; For me, this gives the correct results. (But maybe you have some special strings which strverscmp can't handle ??) At least with strverscmp you won't need the alliance library ---------------------------------------------------------------------- typo · 2015-05-12 14:49 In my language, Portuguese, it sorts in a way that sends all accented chars to the end of the list, which is alphabetically incorrect. ---------------------------------------------------------------------- rvk · 2015-05-12 15:01 You could try to translate the function to clean pascal. In that case you can adjust it to your liking. Or was there a special reason you wanted it from a (standard) library? ---------------------------------------------------------------------- typo · 2015-05-12 15:13 I am trying to improve my unit NaturalSort. I will try to translate this function, which is a problem by itself, indeed. I would like to find a system/language-aware natural compare function in Linux, with the same result (or better, since it has at least one bug) as StrCmpLogicalW in Windows. ---------------------------------------------------------------------- rvk · 2015-05-12 15:28 Well, there are already lots ready-made solutions for pascal. Even in the topic from last year (in which I thought you already had a pascal- solution). (Edit: Ah, you already mentioned that) Another one I found (for plain ascii) which you could change: Code: [Select]uses Math; 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   begin     if Num1 < Num2 then       Result := -1     else       Result := 1;   end; end; (from here) Quote from: typo on May 12, 2015, 05:13:51 pmI would like to find a system/language-aware natural compare function in Linux, with the same result (or better, since it has at least one bug) as StrCmpLogicalW in Windows. In that case you could also make a hybrid-function. One that splits the string into parts (alpha and numeric) and use the system-functions (StrCmpLogicalW on Windows and strcoll on Linux) ---------------------------------------------------------------------- typo · 2015-05-12 15:59 Yes, a hybrid function, this is what I want to write, with numerical parts being handled by my function and alphabetical parts being handled by a language-aware function. ---------------------------------------------------------------------- rvk · 2015-05-12 17:14 Was the bug in StrCmpLogicalW only for the combination alpha/numeric or is the bug also present with just sorting letters? And I'm not sure if CompareString-api (Windows) and strcoll (Linux) handle the ordering the same. (we should test that before using that api) Otherwise the function should just sort in pascal after querying the Locale (which is probably not easy to do). What do you consider the right order (1 or 2)? 1) e1 é1 e2 é2 2) e1 e2 é1 é2 (I think CompareString sees 1 as correct, which would be according to  linguistic rules, so é en e are equal) Also... I saw in lazutf8.pas a function UTF8CompareStrCollated. It calls AnsiCompareStr for Windows (which should/could be locale-aware) but calls WideCompareStr for Linux (which I don't think is locale- aware). So in Linux it does not do as advertised. Edit: Oo, wait " result:=wcscoll(pwchar_t(hs1),pwchar_t(hs2));   " It is locale aware in Linux (see the wcscoll, unicode aware locale- sort) So you can just use UTF8CompareStrCollated for the text-part and you're good to go in Linux and Windows (You just need to write the splitter and comparer) ---------------------------------------------------------------------- typo · 2015-05-12 17:26 I consider the first sequence (1) the correct one. ---------------------------------------------------------------------- rvk · 2015-05-12 17:28 Quote from: typo on May 12, 2015, 07:26:56 pmI consider the first sequence (1) the correct one. In that case you need to look if UTF8CompareStrCollated in lazutf8.pas works correctly on both platform. (It does on Windows, just tested it there) You can use that function in your overall function. Then there is no need to do api-calls yourself because the UTF8CompareStrCollated does it for you. Just need to split the alpha/numeric parts and start comparing from start. ---------------------------------------------------------------------- typo · 2015-05-12 18:40 Unfortunatelly UTF8CompareStrCollated uses Code: [Select]AnsiCompareStr(UTF8ToSys(S1), UTF8ToSys(S2)); in order to make the collation and it results in a random order for accented chars in my language. ---------------------------------------------------------------------- rvk · 2015-05-12 19:02 Could you give an example list of same strings (with accented characters) and how you want to order then (for testing)? ---------------------------------------------------------------------- typo · 2015-05-12 19:09 Code: [Select]1b 2a 3 a 20 a a ã á à â ä b c ç d pic1 pic1a2 pic1a3 pic2 pic3 pic10 pic20 But it needs to work in any language, according to the system language. I need a function that works in any language, but could not test it there. UTF8CompareStrCollated seems to work for me. This is the function I am testing: Code: [Select]Function NaturalCompareStr(Str1,Str2: string):Integer; var Num1,Num2:Double;     pStr1,pStr2:PChar;     Len1,Len2:Integer;     utf8char1 :String;     utf8char2 :String;     charlen1 :Integer;     charlen2 :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        begin          Charlen1 := UTF8CharacterLength(pStr1);          Charlen2 := UTF8CharacterLength(pStr2);          UTF8Char1 := Copy(pstr1, 1, charlen1);          UTF8Char2 := Copy(pstr2, 1, charlen2);          Result := UTF8CompareStrCollated(UTF8Char1, UTF8Char2);        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   begin        if Num1#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;   procedure GetChars;   begin     TextLen1 := 0;     while not((pStr1 + TextLen1)^ in ['0'..'9']) and ((pStr1 + TextLen1)^ <> #0) do       Inc(TextLen1);     SetLength(TextStr1, TextLen1);     i := 1; j := 0;     while i <= TextLen1 do     begin       TextStr1[i] := (pStr1 + j)^;       Inc(i); Inc(j);     end;     TextLen2 := 0;     while not((pStr2 + TextLen2)^ in ['0'..'9']) and ((pStr2 + TextLen2)^ <> #0) do       Inc(TextLen2);     SetLength(TextStr2, TextLen2);     i := 1; j := 0;     while i <= TextLen2 do     begin       TextStr2[i] := (pStr2 + j)^;       Inc(i); Inc(j);     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       TextLen1 := 1;       TextLen2 := 1;       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       begin         GetChars;         Result := WideCompareText(UTF8Decode(TextStr1),UTF8Decode(TextStr2));       end;       if Result <> 0 then Break;       Inc(pStr1, TextLen1);       Inc(pStr2, TextLen2);     end;   end;   Num1 := Length(Str1);   Num2 := Length(Str2);   if (Result = 0) and (Num1 <> Num2) then   begin        if Num1 < Num2 then          Result := -1        else          Result := 1;   end; end;        Still slow. 3 times slower than Windows one. ---------------------------------------------------------------------- rvk · 2015-05-13 14:47 Quote from: typo on May 13, 2015, 02:31:18 pmStill slow. 3 times slower than Windows one. I just tested the difference between NaturalCompareStr, UTF8CompareStrCollated and StrCmpLogicalW. It came to this: 20000000 iterations: NaturalCompareStr: 26,22 UTF8CompareStrCollated: 5,94 (just string comparison) StrCmpLogicalW: 4,57 So the difference between UTF8CompareStrCollated and StrCmpLogicalW is not that big. I did notice a steep time-increase when you make the strings bigger. I did it like this, initially: Code: [Select]      begin         Charlen1 := 0;         Charlen2 := 0;         qStr1 := pStr1;         qStr2 := pStr2;         repeat           Charlen1 := Charlen1 + UTF8CharacterLength(qStr1);           Charlen2 := Charlen2 + UTF8CharacterLength(qStr2);           Inc(qStr1);           Inc(qStr2);         until (qStr1^ = #0) or (qStr2^ = #0) or IsNumber(qStr1^) or IsNumber(qStr2^);         UTF8Char1 := Copy(pstr1, 1, charlen1);         UTF8Char2 := Copy(pstr2, 1, charlen2);         Result := UTF8CompareStrCollated(UTF8Char1, UTF8Char2);         pStr1 := qStr1 - 1;         pStr2 := qStr2 - 1;         // Inc(NumCalled);       end; And that came at 16 seconds against your 26 seconds (for 20000000 iterations). That's probably due to the fact you use SetLength for TextStr1, etc... in GetChar. My method was just a quick and dirty scan to the next non alpha- character and taking that count to fill the UTF8Chars. But it can be even more optimized than it is now. There are also a lot of calls to internal functions (like IsNumber, GetNumber). If these are eliminated it would make some difference. You could start by making isNumber an inline-function. Code: [Select]  function IsNumber(ch: char): boolean; inline; (just 1 seconds from 16 but every little bit helps ) Another optimization... don't scan for characters when you already encountered a different character (pStr1^<>pStr2) because after that the strings are always different and we need not check any further. i.e. checking for the difference between 'aaxacccbbb1121' and 'aayacccbbb2212'. would only mean checking 'aax' and 'aay'. If you jump out, it will also save some 4 seconds of my test (12 against 16) and in that case it's getting closer to the 4,5 and 6 seconds of Windows-api Code: [Select]        repeat           Charlen1 := Charlen1 + UTF8CharacterLength(qStr1);           Charlen2 := Charlen2 + UTF8CharacterLength(qStr2);           if qStr1^  <> qStr2^ then break; // no need to check further           Inc(qStr1);           Inc(qStr2);         until (qStr1^ = #0) or (qStr2^ = #0) or IsNumber(qStr1^) or IsNumber(qStr2^); (and maybe the GetNumber could also still be optimized, but I need to look into that) How do you test the speeds? Do you have a small test program or do you use a real dataset to sort? (not checked for errors) Code: [Select]function NaturalCompareStr(Str1, Str2: string): integer; var   Num1, Num2: double;   pStr1, pStr2: PChar;   qStr1, qStr2: PChar;   Len1, Len2: integer;   utf8char1: string;   utf8char2: string;   charlen1: integer;   charlen2: integer;   function IsNumber(ch: char): boolean; inline;   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       begin         Charlen1 := 0;         Charlen2 := 0;         qStr1 := pStr1;         qStr2 := pStr2;         repeat           Charlen1 := Charlen1 + UTF8CharacterLength(qStr1);           Charlen2 := Charlen2 + UTF8CharacterLength(qStr2);           if qStr1^  <> qStr2^ then break; // no need to check further           Inc(qStr1);           Inc(qStr2);         until (qStr1^ = #0) or (qStr2^ = #0) or IsNumber(qStr1^) or IsNumber(qStr2^);         UTF8Char1 := Copy(pstr1, 1, charlen1);         UTF8Char2 := Copy(pstr2, 1, charlen2);         Result := UTF8CompareStrCollated(UTF8Char1, UTF8Char2);         pStr1 := qStr1 - 1;         pStr2 := qStr2 - 1;         // Inc(NumCalled);       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   begin     if Num1 < Num2 then       Result := -1     else       Result := 1;   end; end; ---------------------------------------------------------------------- typo · 2015-05-13 15:38 I use a real dataset to sort. A memo is populated by random text+numbers lines. And I measure NaturalCompareStr against StrCmpLogicalW and not StrCmpLogicalW against UTF8CompareStrCollated. ---------------------------------------------------------------------- rvk · 2015-05-13 15:40 Quote from: typo on May 13, 2015, 05:38:09 pmAnd I measure NaturalCompareStr against StrCmpLogicalW and not StrCmpLogicalW against UTF8CompareStrCollated. Yes, but I only included the UTF8CompareStrCollated to see if the raw- calling of UTF8CompareStrCollated is fast enough. Even if I exclude everything in the function (just compare raw strings) you can't come close to the speed of StrCmpLogicalW (due to Copy()-function etc). But... hey... the only reason you didn't want to use StrCmpLogicalW on Windows was that it didn't take locale into account, wasn't it? (and a small bug?) I just found out CompareString (beginning from Windows 7) has a parameter SORT_DIGITSASNUMBERS. And CompareString is locale-aware. https://msdn.microsoft.com/en- us/library/windows/desktop/dd317759(v=vs.85).aspx https://msdn.microsoft.com/en-us/library/windows/desktop/dd318144%28v= vs.85%29.aspx#sort_digits_as_numbers Is that no option for Windows? (in that case you have the speed back for Windows and you can concentrate on Linux) (or did you already found that one and dismissed it?) ---------------------------------------------------------------------- typo · 2015-05-13 16:02 Quote from: rvk on May 13, 2015, 05:40:19 pmBut... hey... the only reason you didn't want to use StrCmpLogicalW on Windows was that it didn't take locale into account, wasn't it? (and a small bug?) No, it takes locale into account. I want a function to Linux because the ones I could find did not works as expected. Code: [Select]begin   {$IFDEF WINDOWS}     Result := StrCmpLogicalW(PWideChar(UTF8Decode(aList[Index1])), PWideChar(UTF8Decode(aList[Index2])));   {$ELSE}     Result := NaturalCompareStr(aList[Index1], aList[Index2]);   {$ENDIF} end; ---------------------------------------------------------------------- rvk · 2015-05-13 16:09 Quote from: typo on May 13, 2015, 06:02:27 pmQuote from: rvk on May 13, 2015, 05:40:19 pmBut... hey... the only reason you didn't want to use StrCmpLogicalW on Windows was that it didn't take locale into account, wasn't it? (and a small bug?) No, it takes locale into account. I want a function to Linux because the ones I could find did not works as expected. Ah, Ok. That's weird, though. StrCmpLogicalW and CompareStr both sort the special characters in a different way (than UTF8CompareStrCollated): Code: [Select]1b 2a 3 a 20 a a à á â ã ä ç b c d pic1 pic1a2 pic1a3 pic2 pic3 pic10 pic20 That's different from your desired (and like UTF8CompareStrCollated does): Code: [Select]1b 2a 3 a 20 a a á à â ä ã b c ç d pic1 pic1a2 pic1a3 pic2 pic3 pic10 pic20 ---------------------------------------------------------------------- typo · 2015-05-13 16:12 I don't use UTF8CompareStrCollated for Windows. ---------------------------------------------------------------------- rvk · 2015-05-13 16:19 Quote from: typo on May 13, 2015, 06:12:57 pmI don't use UTF8CompareStrCollated for Windows. In that case, how do you get your desired order? WideCompareText gives a slightly different order than UTF8CompareStrCollated. So... don't you mind the difference in ordering, or what do you consider the right one? ---------------------------------------------------------------------- typo · 2015-05-13 16:24 UTF8CompareStrCollated uses WideCompareStr in Linux. The difference between it and WideCompareText is only about case sensibility. Both Windows function and my function get my desired order. ---------------------------------------------------------------------- typo · 2015-05-13 16:27 So I compare them to know about Windows X Linux performance. See the attached image. Of course I measure them both on Windows, but the code for the Linux function (NaturalCompareStr ) is the same as in a Linux system. I test on Linux only for accuracy, not performance. ---------------------------------------------------------------------- rvk · 2015-05-13 17:42 Quote from: typo on May 13, 2015, 06:24:12 pmUTF8CompareStrCollated uses WideCompareStr in Linux. The difference between it and WideCompareText is only about case sensibility. Both Windows function and my function get my desired order. Ah, yes... I made a mistake with my test-program (calling in calling StrCmpLogicalW with wrong encoded parameters  ). Now for speed. I think it will be very difficult to approach the speed of StrCmpLogicalW. One of the major speedbump is the Copy() (and or SetLength, etc) function. You could (besides the other 2 speed improvements given in my previous post) leave the copy out and just compare the strings in the original buffer pStr^. With Windows/CompareStringW you need to give the string-length so that's not a problem. With Linux/wcscoll it needs #0 at the end so you'll need to save the last character, set #0 and swap it back afterwards. Next problem is the WideCompareText. It is SLOW. (SLOW SLOW SLOW !!!) You're better off directly calling CompareStringW directly (or wcscoll in case of Linux). I'm not yet sure about the UTF8Decode-calls but with calling CompareStringW (or wcscoll) it already makes a huge difference. Maybe you could check if you see the same speed-improvement with my version: (not tested for stability): Code: [Select]function NaturalCompareStr(Str1, Str2: string): integer; var   Num1, Num2: double;   pStr1, pStr2: PChar;   qStr1, qStr2: PChar;   Len1, Len2: integer;   char1, char2: char;   function IsNumber(ch: char): boolean; inline;   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       begin         qStr1 := pStr1;         qStr2 := pStr2;         repeat           if qStr1^ <> qStr2^ then break; // no need to check further           Inc(qStr1);           Inc(qStr2);         until (qStr1^ = #0) or (qStr2^ = #0) or IsNumber(qStr1^) or IsNumber(qStr2^);         Char1 := qstr1^;         Char2 := qstr2^;         qStr1 := #0;         qStr2 := #0;         // SLOW SLOW SLOW SLOW SLOW SLOW SLOW         // Result := WideCompareText(UTF8Decode(pStr1), UTF8Decode(pStr2));         // This needs to be optimized even further         {$IFDEF WINDOWS}         Result := CompareStringW(LOCALE_USER_DEFAULT, 0,           pWideChar(UTF8Decode(pStr1)), Length(pStr1),           pWideChar(UTF8Decode(pStr2)), Length(pStr2)) - 2;         {$ELSE}         // not yet implemented         {$ENDIF}         if Result <> 0 then // no need to set char back if result <> 0         begin           qStr1^ := Char1;           qStr2^ := Char2;           pStr1 := qStr1 - 1;           pStr2 := qStr2 - 1;         end;       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   begin     if Num1 < Num2 then       Result := -1     else       Result := 1;   end; end; ---------------------------------------------------------------------- typo · 2015-05-13 19:23 Your version is a bit slower than the mine. ---------------------------------------------------------------------- rvk · 2015-05-13 19:27 Wow, I didn't expect that. Here, my version is twice as fast as yours Maybe it's the test-program. I'll try to do some testing with random strings (like yours). ---------------------------------------------------------------------- typo · 2015-05-13 19:45 I compared the 2 with the same WideCompareText call. Of course with Windows function it is faster. I need that the function works like the way it will do on Linux, not Windows. ---------------------------------------------------------------------- typo · 2015-05-13 20:21 BTW, how should I call wcscoll on Linux? Should I load some library? I cannot find any doc about this. This doc says that it is POSIX: http://linux.die.net/man/3/wcscoll ---------------------------------------------------------------------- rvk · 2015-05-13 20:57 Ok... first of all... I want to know the reason why we have different results on Windows. I take your exact function and do this: Code: [Select]        GetChars;         //Result := WideCompareText(UTF8Decode(TextStr1), UTF8Decode(TextStr2));         Result := CompareStringW(LOCALE_USER_DEFAULT, 0,           pWideChar(UTF8Decode(TextStr1)), Length(TextStr1),           pWideChar(UTF8Decode(TextStr2)), Length(TextStr2)) - 2; Look at the results of my screenshot. That's why I don't think you should call WideCompareText but call CompareStringW directly. I think internally in Lazarus there is too much going on with a big speed penalty. I got with that one change almost exact same results as the Windows-api. I hope if you change your function like this, it will be the same result. Next the wcscoll. Since you can't call WideCompareText (I assume it's slow under Linux too) you can also call it directly. Code: [Select] {$IFDEF WINDOWS} function StrCmpLogicalW(psz1, psz2: PWideChar): integer; stdcall; external 'shlwapi.dll'; {$ELSE} function wcscoll (__s1:pwchar_t; __s2:pwchar_t):cint;cdecl;external clib name 'wcscoll'; {$ENDIF} // .......         GetChars;         //Result := WideCompareText(UTF8Decode(TextStr1), UTF8Decode(TextStr2));         {$IFDEF WINDOWS1}         Result := CompareStringW(LOCALE_USER_DEFAULT, 0,           pWideChar(UTF8Decode(TextStr1)), Length(TextStr1),           pWideChar(UTF8Decode(TextStr2)), Length(TextStr2)) - 2;         {$ELSE}         Result := wcscoll(pWideChar(UTF8Decode(TextStr1)), pWideChar(UTF8Decode(TextStr2)));         {$ENDIF} I don't have my VM started so I'm not sure the declaration of wcscoll is correct. But it should be close. (Maybe clib is not defined. In that case you can just use 'libc'.) B.T.W. The difference with StrCmpLogicalW in sorting those 0000xxx in front of 0xxx.... that's probably what you called "the bug", isn't it? ---------------------------------------------------------------------- typo · 2015-05-13 22:06 I don't need to call CompareStringW because I call StrCmpLogicalW directly, not from inside my function. My function should run only on Linux. ---------------------------------------------------------------------- typo · 2015-05-13 22:22 Quote from: rvk on May 13, 2015, 10:57:53 pmB.T.W. The difference with StrCmpLogicalW in sorting those 0000xxx in front of 0xxx.... that's probably what you called "the bug", isn't it? Yes, it is. ---------------------------------------------------------------------- rvk · 2015-05-13 22:32 Quote from: typo on May 14, 2015, 12:06:36 amI don't need to call CompareStringW because I call StrCmpLogicalW directly, not from inside my function. My function should run only on Linux. Yes, I understand. But I used it to illustrate that WideCompareText is much slower than CompareStringW (while internally WideCompareText  uses CompareStringW). So the mechanism to call WideCompareText is too slow (probably for Linux too). Calling wcscoll directly would fix that on Linux. B.T.W. It won't matter to just include the IFDEF in your function too (for good measure). It's not in the way. And even on Windows your function is not slower than calling StrCmpLogicalW  directly (at least in my tests). (Don't think I can test on Linux yet, that will be in the morning. If all goes well I'll post the test-project for Linux/Windows) ---------------------------------------------------------------------- typo · 2015-05-13 22:47 Now I see, your function is 2x faster than the mine, both calling WideCompareText. ---------------------------------------------------------------------- rvk · 2015-05-13 22:52 Quote from: typo on May 14, 2015, 12:47:10 amNow I see, your function is 2x faster than the mine, both calling WideCompareText. Well, your function is just as fast after changing the WideCompareText to CompareStringW And internally there are still some other things that can be optimized but I think the CompareStringW (or wcscoll on Linux) will be the biggest speed change. One thing that can be optimized in your function is stop scanning text if you find a different character. (But scanning is really fast so I'm not sure how much you will gain). The other thing would be to not use separate strings but compare directly from pstr1 and pstr2 (instead of copying to another string). But lets see first how this does on Linux. ---------------------------------------------------------------------- typo · 2015-05-13 22:54 And your function is about only 40% slower than Windows one. ---------------------------------------------------------------------- rvk · 2015-05-13 23:02 Here is my test-project. Not completely implemented for Linux yet. Maybe you can see if I've done something wrong. I have a BaseList with random strings. (You need to take that one for comparing each time, otherwise it's cheating ) The second column is StrCmpLogicalW Third column is your first function with WideCompareText. Fourth column is your function with CompareStringW / wcscoll StrCmpLogicalW = 2605 WideCompareText = 5818 CompareStringW = 2724 That's just 5% difference. ---------------------------------------------------------------------- typo · 2015-05-13 23:44 I measured StrCmpLogicalW against Natural 1. ---------------------------------------------------------------------- typo · 2015-05-14 09:06 My test project (attached). ---------------------------------------------------------------------- rvk · 2015-05-14 09:17 You're still using WideCompareText in both _rvk and _typo functions. Include Windows in the uses and you can uncomment the CompareStringW in my function (removing the WideCompareText of course) and also include it in yours. You'll see you get a lot closer to the StrCmpLogicalW. I've got my VM going so I can see how the Linux version does. ---------------------------------------------------------------------- typo · 2015-05-14 09:24 Using CompareStringW in these functions has no meaning for me because any of these functions should run on Linux. ---------------------------------------------------------------------- rvk · 2015-05-14 09:28 Quote from: typo on May 14, 2015, 11:24:41 amUsing CompareStringW in these functions has no meaning for me because any of these functions should run on Linux. I already said (twice) that that was only for testing on Windows. For Linux you should use wcscoll directly (in stead of CompareStringW). But any way... you can't compare the native StrCmpLogicalW with WideCompareText on Windows (or Linux). And StrCmpLogicalW is a Windows-function so you also can't use that on Linux. I will have my test-version shortly. ---------------------------------------------------------------------- rvk · 2015-05-14 11:02 Wow, I didn't anticipate calling wcscoll directly would be this difficult. Attached is a test-project which should work on both Windows and Linux. The Natural 1 column uses the lazarus WideCompareText-call. The Natural 2 column uses CompareStringW on Windows and tries to use wcscoll on Linux. But... I couldn't get the direct call to wcscoll to work properly. Maybe you can see what I'm doing wrong? Apparently wcscoll can't accept a widestring (with #0 internally) and the #0's need to be filtered out. I imagine this is also a time- consuming process thus wonder if this can't be optimized. See... In your function you build a UTF8 string (why not directly a Widestring?). After that it's gets converted to a Widestring to pass on to WideCompareText or CompareStringW/wcscoll. The CompareStringW can use that directly but for Linux the WideCompareText again converts it to a UCS4String. You see where this is going... It's a lot of string-converting. If you can build a UCS4String directly in your GetChars-function all these conversions don't have to take place. I extracted the WideStringToUCS4StringNoNulls function from source to try to use it with a direct call to wcscoll but couldn't get it to work properly. When this is solved... the WideStringToUCS4StringNoNulls can be build directly into your GetChars. (edit: Uuuh, why is there UCS4 used for wcscoll? Isn't that 32bit characters? 4bytes/char?) ---------------------------------------------------------------------- rvk · 2015-05-14 11:41 Just to see if a direct call to a Linux is faster... I tried the strcoll. In the function the UTF8 string doesn't have special characters yet so strcoll would work (just as a test). Doing: Code: [Select]function strcoll(s1: pchar; s2: pchar): integer; cdecl; external 'c' Name 'strcoll'; //... Result := strcoll(pChar(TextStr1), pChar(TextStr2)); gives me the result below. (5088 vs 2136, and the 2136 is close to the Windows-api) So, now it's just a matter to make the wcscoll work. ---------------------------------------------------------------------- rvk · 2015-05-14 12:25 Okay, I got the wcscoll running (sorry for the multiple posts) Apparently it expects a pwchar_t (which is a 32 bit character string on Lazarus now, and not a widestring, which is 16 bit). (Yes, I'm a Linux-desktop newbie  ) Now the result (and test project) are in the screenshot below. I still think there is too much string-conversion going on, and if you can just create a UCS4 (no null) string directly in GetChars, it should improve even more. ---------------------------------------------------------------------- typo · 2015-05-14 13:49 Strange, for some reason number comparison seems to be incorrectly made on Linux. ---------------------------------------------------------------------- rvk · 2015-05-14 13:58 Quote from: typo on May 14, 2015, 03:49:15 pmStrange, for some reason number comparison seems to be incorrectly made on Linux. That would be strange. Your function is the same for Windows and Linux so we're only playing with the text-part ordering (with these direct calls). The number comparison is the same on both platforms. For me it's ok. (did you try my last test-project?) ---------------------------------------------------------------------- typo · 2015-05-14 16:07 No, I used an old project in Linux to run the code. Attached are the same routine on Windows and Linux. ---------------------------------------------------------------------- rvk · 2015-05-14 16:37 You changed your function. I'm not sure why it works on Windows but if you look at my last test-project. It has your earlier function. The only difference I can see is that in the earlier version you worked with a variable TextLen1/2. That one still works and I used it in my test-project. Your last version (where you eliminated the textlen1/2 variable) is not working correctly on Linux. Edit: Woops... ignore the above: You do this in your code: Code: [Select]    L.Assign(aList);     aList.Assign(L);     L.Clear; You never assign the real sorted list back to your memo (I wonder why it would work in Windows?) So comment out the last L.Assign(aList) and it works ok. Code: [Select]    //L.Assign(aList);     aList.Assign(L);     //L.Clear;          Now you can take my modified lines to include the wcscoll (semi)direct and concentrate on improving the efficiency of that GetChars. ---------------------------------------------------------------------- typo · 2015-05-14 18:16 The problem in Linux os not in GetChars. In fact, GetNumber is never called in Linux: Code: [Select]function GetNumber(var pch: PChar; var Len: integer): double;   var     FoundPeriod: boolean;     Count: integer;   begin     ShowMessage('Hello');   // <<<<<<<<< add this line     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; ---------------------------------------------------------------------- rvk · 2015-05-14 18:54 Well. All the functions I took from your .zip's work correctly here. Could you post it again? (your Linux version) For me it is called (in both version I got.) The only problem I found with your last .zip was that L.Assign(aList) while L was already sorted. Did you try my test-project? Did that work correctly? ---------------------------------------------------------------------- typo · 2015-05-14 19:04 Quote from: rvk on May 14, 2015, 08:54:19 pmDid you try my test- project? Did that work correctly? Yes, it did. ---------------------------------------------------------------------- typo · 2015-05-14 20:04 Try sorting only these 3 strings on Linux: Code: [Select]a20 a2 a10 ---------------------------------------------------------------------- rvk · 2015-05-14 20:13 I did. You last code works perfectly (with the exception of the already mentioned Assign which you need to remove). (I also got 9 "hello worlds" with a showmessage in Getnumber) So there must be something with code you changed. Especially if you say my test-project worked correctly (which uses your function). PS. I'm on Laz1.5 (trunk) (But that shouldn't matter because it's not about calling any laz-functions) Are you sure you have the showmessage in the right function (_typo and not _rvk) and did you remove that assign at the end? Otherwise... place your code again. ---------------------------------------------------------------------- typo · 2015-05-14 20:29 Your last project works perfectly on Windows. ---------------------------------------------------------------------- typo · 2015-05-15 01:39 Your project runs on Linux with some modifications, for instance: Code: [Select]function wcscoll(s1,s2: pWideChar):integer; cdecl; external 'libc' Name 'wcscoll'; ---------------------------------------------------------------------- rvk · 2015-05-15 06:04 Quote from: typo on May 15, 2015, 03:39:46 amYour project runs on Linux with some modifications, for instance: Code: [Select]function wcscoll(s1,s2: pWideChar):integer; cdecl; external 'libc' Name 'wcscoll'; Actually. My last test-project is the one I posted here: http://forum.lazarus.freepascal.org/index.php/topic,28310.msg177833.ht ml#msg177833 (I see you didn't download that one yet. it says 0 downloads) Your definition with pWideChar is technically not correct. It might work because the compiler doesn't check if you give a widestring (2bytes char) or a ucs4-string (4bytes char) with a pwidechar casting. But it should be like this: Code: [Select]function wcscoll (__s1:pwchar_t; __s2:pwchar_t):cint;cdecl;external 'c'; (The naming convention is not necessary if your functionname has the exact same name.) This is the same definition as is used in fpc\rtl\unix\cwstring.pp (which in turn is used by WideCompareText internally) Furthermore you need to include unixtype to be able to use pwchar_t. pwchar_t is a sort of pucs4char pointer (to a 4bytes character string). That's why I had this in my last project: Code: [Select]uses   {$IFNDEF WINDOWS} unixtype, {$ENDIF}   {$IFDEF WINDOWS} Windows, {$ENDIF}   lazutf8, lazutf8sysutils,   Math; // .... {$IFDEF WINDOWS} function StrCmpLogicalW(psz1, psz2: PWideChar): integer; stdcall; external 'shlwapi.dll'; {$ELSE} function wcscoll (__s1:pwchar_t; __s2:pwchar_t):cint;cdecl;external 'c'; function strcoll (__s1:pchar; __s2:pchar):cint;cdecl;external 'c'; {$ENDIF} Download the last one from my post here and you'll see. http://forum.lazarus.freepascal.org/index.php/topic,28310.msg177833.ht ml#msg177833 (granted... I posted quite a few times after each other so you might have mist that one ) ---------------------------------------------------------------------- rvk · 2015-05-15 08:38 Hey there, me again (also, please read the post above this one) I adjusted my test-project again. If you build in a test to see if your TextStr1/2 are just Ascii characters you can use strcoll instead of converting the strings (two strings times two conversions) ans using wcscoll. It's much, much faster. Only for the special characters the CompareWideString/wcscoll is used. So if you have lots of special characters it might hurt performance but overall I see an even better performance than the Windows-api Code: [Select]if IsAscii(TextStr1) and IsAscii(TextStr2) then   Result := strcoll(pChar(TextStr1), pChar(TextStr2)) else   Result := MyCompareWideString(UTF8Decode(TextStr1), UTF8Decode(TextStr2)); See screenshots below with my latest test-project. ---------------------------------------------------------------------- typo · 2015-05-15 09:38 Where is declared IsAscii? ---------------------------------------------------------------------- rvk · 2015-05-15 09:39 Quote from: typo on May 15, 2015, 11:38:15 amWhere is declared IsAscii? You still didn't download my test-project (it's attached to the post). IsAscii in there (in unit1.pas) ---------------------------------------------------------------------- typo · 2015-05-15 09:43 No, the forum has a bug on this. I do have downloaded your project. ---------------------------------------------------------------------- typo · 2015-05-15 13:54 My almost-final test project (attached). Should run on both OSs. ---------------------------------------------------------------------- typo · 2015-05-15 15:04 And here is the link for the resulting unit. http://sourceforge.net/projects/lazarusfiles/files/naturalsort.zip/dow nload Thanks, rvk. If you want that your real name appears on the copyright notice of the unit, please send me a PM. ---------------------------------------------------------------------- typo · 2015-05-15 18:20 I have just tested the double conversion of TextStr1/2 on Linux and the result is fast enough to compete. It performs in half the time of the one with WideCompareText. But still not done, indeed. ---------------------------------------------------------------------- typo · 2015-05-16 13:58 Two natural sort controls, a ListBox and a ComboBox: Code: [Select]unit NaturalControls; {$mode objfpc}{$H+} interface uses   Classes, SysUtils, StdCtrls, Forms, Controls, NaturalSortUnit; type   { TNaturalListBox }   TNaturalListBox = class(TListBox)   private     FSorted :boolean;     procedure NaturalListBoxUpdateSorted;   protected      procedure SetSorted(Val :boolean); override;   end;   { TNaturalComboBox }   TCustomNaturalComboBox = class(TCustomComboBox)   private     FSorted :boolean;     procedure NaturalComboBoxUpdateSorted;   protected     procedure SetSorted(Val :boolean); override;   public     property Sorted;   end;   TNaturalComboBox = class(TCustomNaturalComboBox)   published     property Align;     property Anchors;     property ArrowKeysTraverseList;     property AutoComplete;     property AutoCompleteText;     property AutoDropDown;     property AutoSelect;     property AutoSize;// Note: windows has a fixed height in some styles     property BidiMode;     property BorderSpacing;     property CharCase;     property Color;     property Constraints;     property DragCursor;     property DragKind;     property DragMode;     property DropDownCount;     property Enabled;     property Font;     property ItemHeight;     property ItemIndex;     property Items;     property ItemWidth;     property MaxLength;     property OnChange;     property OnChangeBounds;     property OnClick;     property OnCloseUp;     property OnContextPopup;     property OnDblClick;     property OnDragDrop;     property OnDragOver;     property OnDrawItem;     property OnEndDrag;     property OnDropDown;     property OnEditingDone;     property OnEnter;     property OnExit;     property OnGetItems;     property OnKeyDown;     property OnKeyPress;     property OnKeyUp;     property OnMeasureItem;     property OnMouseDown;     property OnMouseEnter;     property OnMouseLeave;     property OnMouseMove;     property OnMouseUp;     property OnStartDrag;     property OnSelect;     property OnUTF8KeyPress;     property ParentBidiMode;     property ParentColor;     property ParentFont;     property ParentShowHint;     property PopupMenu;     property ReadOnly;     property ShowHint;     property Sorted;     property Style;     property TabOrder;     property TabStop;     property Text;     property Visible;   end;   procedure Register; implementation procedure Register; begin   RegisterComponents('Misc',[TNaturalListBox]);   RegisterComponents('Misc',[TNaturalComboBox]); end; { TNaturalListBox } procedure TNaturalListBox.NaturalListBoxUpdateSorted; begin   if HandleAllocated then   begin     LockSelectionChange;     NaturalSort(Items);     UnlockSelectionChange;   end   else     NaturalSort(Items); end; procedure TNaturalListBox.SetSorted(Val: boolean); begin   if Val <> FSorted then   begin     FSorted:= Val;     NaturalListBoxUpdateSorted;   end; end; { TCustomNaturalComboBox } procedure TCustomNaturalComboBox.NaturalComboBoxUpdateSorted; var   lText: string;   lIndex: integer; begin if HandleAllocated then     NaturalSort(Items)   else   begin     // remember text     lText := Text;     NaturalSort(Items);     lIndex := Items.IndexOf(lText);     if lIndex >= 0 then       ItemIndex := lIndex;   end; end; procedure TCustomNaturalComboBox.SetSorted(Val : boolean); begin   if (Val <> FSorted) then   begin     FSorted := Val;     NaturalComboBoxUpdateSorted;   end; end; end.          I have just tested with accented chars, a new test project is attached. ---------------------------------------------------------------------- rvk · 2015-05-16 17:54 You can probably remove the NaturalCompareStr_RVK-procedure from your test-project. I don't think the way I tried to gather the strings makes a lot of difference. Maybe with some optimization we could shave of a few milliseconds but I don't think it is worth it overall. So your GetChars-part would be sufficient. Only thing to optimize there is jumping out when a different character is detected (because than the strings are different and compare will always result in <>0). But again, only a few milliseconds could be saved. You also still had the wcscoll-call with UTF8Decode strings in my routine. With my test on Linux that just made the test-project hang completely. After changing it to the ConvertedString1 (same as with your procedure) it went ok but still slower. I see you used the UnicodeStringToUCS4String now. Does this procedure work correctly with UTF8-strings too??? There is something to consider though. In the Lazarus source they used a WideStringToUCS4StringNoNulls. (fpc/rtl/unix/cwstring.pp) Quote    { wcscoll interprets null chars as end-of-string -> filter out } I didn't have trouble with testing it with UnicodeStringToUCS4String but I'm not sure why there was a separate function for it. Also... You used it directly and always in GetChars. I would change it so you would only use it just before wcscoll so only is isAscii = false;. If all character are ascii there is no need to convert it to UCS4. Code: [Select]        if IsAscii(TextStr1) and IsAscii(TextStr2) then           Result := strcoll(pchar(textstr1), pchar(textstr2))         else         begin           // only do the conversion here, only where we need it           ConvertedString1 := UnicodeStringToUCS4String(UTF8Decode(TextStr1));           ConvertedString2 := UnicodeStringToUCS4String(UTF8Decode(TextStr2));           Result := wcscoll(pWchar_t(ConvertedString1), pWChar_t(ConvertedString2));         end; And lastly... are the {$IFDEF LINUX} within the {$IFNDEF WINDOWS} necessary? Are there other bases to consider or is it always LINUX or WINDOWS? ---------------------------------------------------------------------- typo · 2015-05-16 18:19 Code: [Select]        if TextStr1 <> TextStr2 then         begin           {$IFDEF WINDOWS}           Result := CompareStringW(LOCALE_USER_DEFAULT, 0,             pWideChar(UTF8Decode(TextStr1)), Length(TextStr1),             pWideChar(UTF8Decode(TextStr2)), Length(TextStr2)) - 2;           {$ELSE}           if IsAscii(TextStr1) and IsAscii(TextStr2) then             Result := strcoll(pchar(textstr1), pchar(textstr2))           else           begin             ConvertedString1 := UnicodeStringToUCS4String(UTF8Decode(TextStr1));             ConvertedString2 := UnicodeStringToUCS4String(UTF8Decode(TextStr2));             Result := wcscoll(pWchar_t(ConvertedString1), pWChar_t(ConvertedString2));           end;           {$ENDIF}         end         else           Result := 0;  Quote from: rvk on May 16, 2015, 07:54:28 pmAnd lastly... are the {$IFDEF LINUX} within the {$IFNDEF WINDOWS} necessary? Are there other bases to consider or is it always LINUX or WINDOWS? I use it for testing only, at the end it will be removed. Unless it ends better than the Windows one. If I don't use it, I could not compare them on both OSs with the same code. In Windows it is compared with StrCmpLogicalW and on Linux it is compared with WideCompareText, which is the feasable alternative. ---------------------------------------------------------------------- coliv_aja · 2015-05-16 19:49 Hi, I've been tried your naturalsort, it's very nice. I found out windows function is a bit different from your naturalsort function. windows: p 0001 p 001 p 02 naturalsort1/2 p 001 p 0001 p 02 what do you think is the right one? ---------------------------------------------------------------------- typo · 2015-05-16 19:57 Well, NaturalSort in Windows IS Windows function. I guess it is some difference of version. Where have you tried Windows function? Code: [Select]Result := StrCmpLogicalW(PWideChar(UTF8Decode(aList[Index1])), PWideChar(UTF8Decode(aList[Index2]))); Maybe you are using the test project and comparing Windows function with our function for Linux, which does not have this bug. Windows function has a bug, which is mentioned on source code for NaturalSort. ---------------------------------------------------------------------- coliv_aja · 2015-05-16 20:14 I tried the one in rvk attachments. ---------------------------------------------------------------------- rvk · 2015-05-16 20:15 I'm not sure where we can find the real definition of "Natural Sort". The Windows-function orders same numbers as larger to smaller (i.e. 001, 01, 1) and letters as smaller to larger (a, aa, aaa). Code: [Select]001 01 1 002 02 2 a aa aaa One might argue it is because the "precision" of 001 is larger than 01 and 1. Or maybe the 0 should be taken into account when numbers are the same. In that case for same numbers we should fall back to letter sorting. When doing that the ordering in Windows could be considered correct. Code: [Select]001 01 1 ^^ ||-----look at the 0, 1 --------look at the 0, 0, 1 Do we have a official source for the definition of Natural sort? ---------------------------------------------------------------------- typo · 2015-05-16 20:19 Quote from: rvk on May 16, 2015, 10:15:23 pmDo we have a official source for the definition of Natural sort? Yes, I think: the SouceForge's NaturalSortUnit. It is immediately  updated, every time we change it. http://sourceforge.net/projects/lazarusfiles/files/naturalsort.zip/dow nload I think that the Windows function's bug is about differencing the numbers by its length, instead of the value, when the value is the same, which occurs only for zeroes, BTW. ---------------------------------------------------------------------- rvk · 2015-05-16 22:10 Quote from: typo on May 16, 2015, 10:19:09 pmI think that the Windows function's bug is about differencing the numbers by its length, instead of the value, when the value is the same, which occurs only for zeroes, BTW. No, I don't think Windows looks at the length of the string in the case the numbers are equal. It looks at the individual numbers at their position. And of course it only happens with the zero's before numbers. Otherwise the numbers wouldn't be the same: Code: [Select]111 11 1 These are not the same. Only if the (same) numbers are prefixed with zero they could be the same. I still think there is an argument for the way Windows sorts them. Like I said: Code: [Select]001 01 1 ^^ ||-----look at the 0, 1 --------[b]look at the 0, 0, 1[/b] And I think Microsoft sees that when these 3 numbers are in value equal (which they are) they look at the individual numbers themselves at their respective position and in that case the order would be correct. Code: [Select]1 01 001 This would be wrong in that case. Because the 1 is before the 0. I haven't found any real official document describing this kind of sorting (but will continue looking). Maybe there isn't any and it's just "open" to interpretation. I'm also still hopeful to get that naturalstrcmp going. (haven't tried passing a UCS4 to that one yet) B.T.W. I think Linux also sorts the filenames the way the Windows-sort works: Code: [Select]-rw-r--r--  1 root root 0 May 17 00:17 001 -rw-r--r--  1 root root 0 May 17 00:17 01 -rw-r--r--  1 root root 0 May 17 00:17 1 -rw-r--r--  1 root root 0 May 17 00:17 11 I also have found this definition: QuoteNatural Order uses the following rule to sort strings: The space character sorts before numbers; numbers sort before non- numbers.Numbers sort in numerical order; leading zeroes and spaces on numbers are ignored, except as a tie-breaker for numbers that have the same numerical value.Non-numbers sort in the Mac's System sorting order.So in case of a tie braker (numbers with same numerical value) you need to look at the leading zeros and spaces. And in that case a zero becomes before the 1. So... maybe this isn't a bug at all. ---------------------------------------------------------------------- typo · 2015-05-16 22:28 Our function avoids this issue this way: Code: [Select]        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; ---------------------------------------------------------------------- rvk · 2015-05-16 22:34 Quote from: typo on May 17, 2015, 12:28:32 amOur function avoids this issue this way: Well... it's not actually "avoiding" the issue. If, looking at the arguments in my previous post (I added some extra arguments), the ordering in Windows is considered correct (because of the definition) then the function should be: Code: [Select]          if Len1 < Len2 then             Result := 1           else if Len1 > Len2 then             Result := -1; So it all comes down to the fact... what is correct. Linux ls option -v also orders natural like this: Code: [Select]# ls -lv total 0 -rw-r--r--  1 root root 0 May 17 00:17 001 -rw-r--r--  1 root root 0 May 17 00:17 01 -rw-r--r--  1 root root 0 May 17 00:17 1 -rw-r--r--  1 root root 0 May 17 00:17 2 -rw-r--r--  1 root root 0 May 17 00:17 11 And sort -n also does this: Code: [Select]# ls | sort -n 001 01 1 2 11 ---------------------------------------------------------------------- typo · 2015-05-16 22:53 Hard question. In my opinion, natural sort refers to human sort, grammatically and alphabetically correct. If you ask a computer user to sort a list of words, he/she will sort: 01 001 0001 and not 0001 001 01 It is intuitive. Language dictionaries would do so the same. Perhaps it is not a bug, since it can be by design, but is not the human way of sorting strings. If it is necessary to do a choice, I choose the human, intuitive way, since computers did not invent sorting strings task. ---------------------------------------------------------------------- rvk · 2015-05-16 23:12 Quote from: typo on May 17, 2015, 12:53:52 amIf you ask a computer user to sort a list of words, he/she will sort: 01 001 0001 Yes. That's also true. Instinctively I would also choose this ordering. I guess Linux/Windows native ordering differs on that point (as not being intuitive). One possibility could be a global switch to use the same ordering in the function as is done with the Windows-api (and Linux-commands) but a clear description on the difference and why there is a difference would also be sufficient. Maybe calling it a "bug" would be a bit much (because they follow another set of rules. Calling it "ordering not according to dictionary-rules and non-intuitive" would be more diplomatic . ---------------------------------------------------------------------- typo · 2015-05-16 23:15 I changed the comment of the function to this: Code: [Select]{ NaturalSort sorts UTF-8 strings in a natural collated order, so numbers are sorted too.  By design it sorts like this:  01  001  0001  and  0  00  000  000_A  000_B  in a human, intuitive order.  } ---------------------------------------------------------------------- rvk · 2015-05-16 23:17 Quote from: typo on May 17, 2015, 01:15:53 amI change the comment of the function to this: Perfect ---------------------------------------------------------------------- typo · 2015-05-17 00:06 Code: [Select]{$IFDEF HUMAN_SORT}   {Uncomment Human_Sort define just at the beggining of implementation section    to use the human, intuitive sort way. Otherwise use Windows API function.    Who knows how to sort a list of strings, any alphabetically competent person    or programmers? The choice is yours.}     Result := NaturalStringCompare(aList[Index1], aList[Index2]);   {$ELSE}     {$IFDEF WINDOWS}       Result := StrCmpLogicalW(PWideChar(UTF8Decode(aList[Index1])), PWideChar(UTF8Decode(aList[Index2])));     {$ELSE}       Result := NaturalStringCompare(aList[Index1], aList[Index2]);     {$ENDIF}   {$ENDIF} Also, I think it is a good idea to use the NORM_LINGUISTIC_CASING flag in CompareStringW: Code: [Select]Result := CompareStringW(LOCALE_USER_DEFAULT, NORM_LINGUISTIC_CASING,             pWideChar(UTF8Decode(TextStr1)), Length(TextStr1),             pWideChar(UTF8Decode(TextStr2)), Length(TextStr2)) - 2; ---------------------------------------------------------------------- rvk · 2015-05-17 09:41 Now that the switch for HUMAN_SORT is build in and it is default (as it should) Windows uses this function correctly. However, if someone wants the Windows/Linux directory ordering, the HUMAN_SORT-define can be commented out but then it only works for Windows but not for Linux. My suggestion is to do this: Code: [Select]          {$IFDEF HUMAN_SORT}           if Len1 < Len2 then             Result := -1           else if Len1 > Len2 then             Result := 1;           {$ELSE}           if Len1 < Len2 then             Result := 1           else if Len1 > Len2 then             Result := -1;           {$ENDIF} In that case, when you comment out HUMAN_SORT on Linux it works the exact same way as on Windows (and as sort -n and ls -lv on Linux). NORM_LINGUISTIC_CASING might be a good option. Otherwise, for Turkish and Azeri, the i is mapped to I. I did notice something else in my testing. StrCmpLogicalW places the / before the numbers. But CompareStringW places it between the numbers and letters. Another weird thing about StrCmpLogicalW? ---------------------------------------------------------------------- typo · 2015-05-17 11:35 Quote from: rvk on May 17, 2015, 11:41:52 amMy suggestion is to do this: Done. Quote from: rvk on May 17, 2015, 11:41:52 amAnother weird thing about StrCmpLogicalW? No, AFAIK. I thought StrCmpLogicalW used CompareStringW internally for alpha strings as we do, but it seems that it is not the case. Linux manual page says nothing about casing in wcscoll: http://linux.die.net/man/3/wcscoll I assume it is locale-aware casing. So NORM_LINGUISTIC_CASING flag in CompareStringW is coherent to this. Attached the test project I am using, maybe it can be useful. ---------------------------------------------------------------------- typo · 2015-05-18 09:19 I have searched about UTF8ToUCS4String routine, but it seems that the perfomance increase is not significant. I even found this routine which does the same conversion: Code: [Select]function UTF8ToUCS4String(const str: UTF8String): UCS4String; begin   Result := WideStringToUCS4String(UTF8Decode(str)); end; http://bugs.freepascal.org/view.php?id=28126