Natürliche Sortierung

[xaromz]

Hallo,

hat hier jemand zufällich einen Algorithmus zum natürliche Sortieren von Stringlisten?

Für alle, die nicht wissen, was ich meine:

Elemente:
x123, x34, x1, x2

Normal sortiert:
x1, x123, x2, x34

Natürlich sortiert:
x1, x2, x34, x123

Der Algorithmus sollte auch mit solchen Elementen funktionieren:

Elemente:
12x1, 12x12, 12x2, 1x2, 1x10

Sortiert:
1x2, 1x10, 12x1, 12x2, 12x12

Gruß
xaromz

[JasonDX]

Eine Möglichkeit wäre dass du jede Zahl in ein Array zerlegst:
aus 12x2 wird bspw. [12, 2]. da dürft copy, pos, delete und TryStrToInt helfen ;)
Anschließend kannst du ja den implementierten Quicksort verwenden, oder einen selber Programmieren. Tutorials gibts hier dafür wie Sand am Meer :)
Der Vergleich könnte dann ca. so aussehen:

• Vergleiche das Element i (anfangs = 0)
• Wenn <>, gib +/-1 (oder was auch immer ;) ) zurück
• Ansonsten inkrementiere i und beginne wieder von vorne, falls i noch nicht am Ende des arrays angekommen ist

Wenn i am Ende angekommen ist, sind beide Werte gleich groß, also machts dann nichts aus, was du zurückgibst ;)


[Edit]Der Algorithmus würde dann auch mit Elementen wie x12x93x345x53 funktionieren, wobei vorausgesetzt sein muss, dass alle Elemente gleich lang sind. Ansonsten musst du die arrays zuerst auf länge vergleichen.[/Edit]

[marabu]

Delphi-Quellcode:

function After(S, Pattern: String): String;
var
  I: Integer;
begin
  I := Pos(Pattern,S);
  if I = 0
    then Result := ''
    else Result := Copy(S, I + Length(Pattern), Length(S));
end;

function Before(S, Pattern: String): String;
var
  I: Integer;
begin
  I := Pos(Pattern,S);
  Delete(S, I, Length(S));
  Result := S;
end;

function ZPad(S: String; Size: Integer): String;
begin
  while (Length(S) < Size) and (Size < 256) do
    S := '0' + S;
  Result := S;
end;

function SortCompare(List: TStringList; Index1, Index2: Integer): Integer;
const
  DIGITS = 4;
var
  item1, item2: string;
begin
  item1 := List[Index1];
  item2 := List[Index2];
  if ZPad(Before(item1, 'x'), DIGITS) < ZPad(Before(item2, 'x'), DIGITS) then Result := -1 else
  if ZPad(Before(item1, 'x'), DIGITS) > ZPad(Before(item2, 'x'), DIGITS) then Result := 1 else
  if ZPad(After(item1, 'x'), DIGITS) < ZPad(After(item2, 'x'), DIGITS) then Result := -1 else
  if ZPad(After(item1, 'x'), DIGITS) > ZPad(After(item2, 'x'), DIGITS) then Result := 1 else
  Result := 0;
end;

Aufruf mit "StringList.CustomSort(SortCompare)"

Grüße vom marabu

[xaromz]

Hallo,

danke für die Antworten. Wie ich sehe bin ich mit meinen Überlegungen auf dem richtigen Weg.

@marabu: Die Elemente waren nur Beispiele zur Verdeutlichung, ich benötige leider eine allgemeine Routine. Werde ich mir dann wohl selbst schreiben, wenn ich mal etwas Zeit habe.

Gruß
xaromz

[xaromz]

Hallo,

so, ich hatte etwas Zeit und hab das hier zustande gebracht:

Delphi-Quellcode:

function Compare(List: TStringList; Index1, Index2: Integer): Integer;
var
  Start1, Start2: Integer;
  S1, S2: String;
  N1, N2: Boolean;
  Item1, Item2: String;

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

  function GetNext(S: String; var Start: Integer; var IsNumber: Boolean): String;
  var
    StringLaenge: Integer;
    C, Laenge: Integer;
  begin
    Result := '';
    StringLaenge := Length(S);
    if Start > StringLaenge then
      Exit;

    // Beginnt eine Zahl?
    IsNumber := IsDigit(S[Start]);
    Laenge := 1;

    for C := Start + 1 to StringLaenge do
    begin
      // Weiterhin eine Zahl/ein Wort?
      if IsDigit(S[C]) = IsNumber then
        Inc(Laenge)
      else
        Break;
    end;

    Result := Copy(S, Start, Laenge);
    Inc(Start, Laenge);
  end;

begin
  Result := 0;
  Item1 := List[Index1];
  Item2 := List[Index2];
  // Beide gleich -> Raus hier
  if Item1 = Item2 then
    Exit;

  Start1 := 1;
  Start2 := 1;
  // Alle Teile durchgehen
  repeat
    // Teile holen
    S1 := GetNext(Item1, Start1, N1);
    S2 := GetNext(Item2, Start2, N2);

    // Haben wir zwei Zahlen?
    if N1 and N2 then
    begin // Ja -> Zahlen Vergleichen
     Result := StrToInt(S1) - StrToInt(S2);
    end else
      begin // Nein -> Normaler Stringvergleich
        if List.CaseSensitive then
          Result := AnsiCompareStr(S1, S2)
        else
          Result := AnsiCompareText(S1, S2);
      end;

  until (Result <> 0) or
        (Start1 > Length(Item1)) or
        (Start2 > Length(Item2));
end;

Gruß
xaromz