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