"Natürliche" Sortierungen von Strings

[luwo]

Keine Ahnung, ob dieses Problem nicht schon jemand hier im Forum angesprochen hat,
aber im Netz hab ich einfach keine (brauchbare) Lösung gefunden
und deshalb kurzerhand selbst in die Tasten gegriffen. :-D

Zum Thema Sortierung wurde schon viel geschrieben.
Ich brauchte allerdings keinen superoptimierten Sortierungsalgorithmus,
sondern eher eine einfach Lösung die Strings der "menschlichen Ordnung" nach sortiert.
(ähnlich der natsort()-Funktion von PHP)

Zur Verdeutlichung:

a) normale ASCII-Sortierung:
rfc1.txt
rfc2086.txt
rfc822.txt

b) natürliche/menschliche Sortierung
rfc1.txt
rfc822.txt
rfc2086.txt

Hier ein Link zum Thema.

Der Code ist sicher suboptimal, aber er funzt :-)

Delphi-Quellcode:

function Compare_NaturalSort(List: TStringList; Index1, Index2: Integer): Integer;

  function JustNumbers(instr:string):string ;
  var
    t:integer;
  begin
   for t:=1 to length(instr) do
     if instr[t] in ['0'..'9'] then result:=result+instr[t];
  end;

var
  di1, di2: Integer;
begin
  if not TryStrToInt(JustNumbers(List[Index1]), di1) then
    di1:=0;
  if not TryStrToInt(JustNumbers(List[Index2]), di2) then
    di2:=0;

  if di1<di2 then
    Result:=-1
  else if di1>di2 then
    Result := 1
  else
    Result := 0;
end;

{Anwendungsbeispiel:}

procedure NaturalSort(const Strings2Sort:TStrings) ;
var
  SL:TStringlist;
begin
  SL:=tstringlist.create;

  SL.Assign(Strings2Sort);
  SL.CustomSort(Compare_NaturalSort);
  Strings2Sort.assign(SL);

  SL.free;
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
  NaturalSort(Listbox1.Items);
end;

shmia hat noch auf etwas hingewiesen:

Zitat:

Deine Compare-Funktion arbeitet IMHO nicht richtig, wenn keine Ziffern enthalten sind.
Man müsste die orginale C-Funktion ( http://sourcefrog.net/projects/natsort/strnatcmp.c ) nach
Delphi übersetzen, dann hat die Sache Hand & Fuss.
Natürlich muss auch der Disclaimer von Martin Pool dazu, sonst wär's ja unfair.

Nachtrag: H4ndy hat die C-Funktion übersetzt und ihr findet diese in diesem Thread weiter unten. :) MfG, Matze.



[edit=Chakotay1308]Beitrag aufgearbeitet. Mfg, Chakotay1308[/edit]
[edit=Matze]Code aktualisiert. Mfg, Matze[/edit]
[edit=Matze] Mfg, Matze[/edit]

[CalganX]

Der User djmasi hat noch eine etwas elegantere, schnellere und optimalere Alternative gebastelt:

Delphi-Quellcode:

//****************************************************************************// 
function NatCompareText(const S1, S2: WideString): Integer; 
begin 
  SetLastError(0); 
  Result := CompareStringW(LOCALE_USER_DEFAULT, 
                           NORM_IGNORECASE or 
                           NORM_IGNORENONSPACE or 
                           NORM_IGNORESYMBOLS, 
                           PWideChar(S1), 
                           Length(S1), 
                           PWideChar(S2), 
                           Length(S2)) - 2; 
  case GetLastError of 
    0: ; 
    ERROR_CALL_NOT_IMPLEMENTED: Result := DumbItDownFor95(S1, 
                                                          S2, 
                                                          NORM_IGNORECASE or 
                                                          NORM_IGNORENONSPACE or 
                                                          NORM_IGNORESYMBOLS); 
  else 
    RaiseLastOSError; 
  end; 
end; 
//****************************************************************************// 
//****************************************************************************//

Und falls es doch Probleme gibt (wurde im PSDK extra drauf hingewiesen):

Delphi-Quellcode:

function DumbItDownFor95(const S1, S2: WideString; CmpFlags: Integer): Integer; 
var 
  a1, a2: AnsiString; 
begin 
  a1 := s1; 
  a2 := s2; 
  Result := CompareStringA(LOCALE_USER_DEFAULT, CmpFlags, PChar(a1), Length(a1), 
    PChar(a2), Length(a2)) - 2; 
end;

[Matze]

Folgende Ergänzung stammt von KingIR.


Im Wesentlichen wurde ein Object File aus der originalen C-Datei erstellt. Der selbe Code wird u.a. auch in den PHP-Funktionen strnatcmp() und natsort() verwendet. Das Object File kann jetzt mit folgendem Code ins eigene Projekt gelinkt werden:

Delphi-Quellcode:

{$INCLUDE 'CHelpers.pas'}

{$LINK 'strnatcmp.obj'}

function _strnatcmp(const a, b: PChar): Integer; cdecl; external;
function _strnatcasecmp(const a, b: PChar): Integer; cdecl; external;


function NatCompareText(const S1, S2: String): Integer;
begin
  Result := _strnatcasecmp(PChar(S1), PChar(S2));
end;


function NatCompareStr(const S1, S2: String): Integer;
begin
  Result := _strnatcmp(PChar(S1), PChar(S2));
end;

Die Datei CHelpers.pas ist in der angehängten ZIP-Datei enthalten. Um nun eine TStringList "natürlich" zu sortieren, geht man z.B. folgendermaßen vor:

Delphi-Quellcode:

uses strnatcmp;
 
 // ...
 
 function Compare_NaturalSort(List: TStringList; Index1, Index2: Integer): Integer;
 begin
   Result := NatCompareText(List[Index1], List[Index2]);
 end;
 
 // ...
 
 var
   FileNames: TStringList;
 
 // ...
 
 FileNames.CustomSort(Compare_NaturalSort); // apply natural sorting
 
 // ...

[Matze]

H4ndy hat die strnatcmp.c komplett nach Delphi übersetzt. :thumb:

Im Anhang befindet sich sein übersetzter Quellcode.


Edit: Aktuelle Version hochgeladen