Spaltengenau sortieren

[Bjoerk]

Uwe, dein Code ist nicht korrekt. :oops:

[Uwe Raabe]

Zitat:

Zitat von Bjoerk (Beitrag 1286248)

Uwe, dein Code ist nicht korrekt. :oops:

Deswegen meine Frage, ob ich die Aufgabe nicht richtig verstanden habe. Mein Code liefert bei 'NOTEBOOK' nämlich dein ursprünglich genanntes Ergebnis. Das bekommt übrigens auch dein eigener Code raus, der allerdings noch eine 0 am Anfang der Liste davor stellt. Deine Liste hat daher auch 9 anstatt 8 Einträge.

[Bjoerk]

Ja. Sorry. Dann stimmt's. Thanx! Hatte ich übersehen. Brauch die Inidces später string kompatibel.

Delphi-Quellcode:

procedure SortKey(const Key: string; Dest: TIntegerList); 
var
  Ch: Char;
  I: Integer;
  LastKey: Char;
  MinKey: Char;
  MinPos: Integer;
begin
  Dest.Clear;
  if Length(Key) > 0 then
  begin
    Dest.Add(0); // 1 Basiert weil String kompatibel;
    LastKey := #0;
    MinKey := #0;
    while Dest.Count <= Length(Key) do
    begin
      MinPos := 0;
      for I := 1 to Length(Key) do
      begin
        Ch := Key[I];
        if (Ch > LastKey) and ((MinPos = 0) or (Ch < MinKey)) then
        begin
          MinKey := Ch;
          MinPos := I;
        end;
      end;
      Dest.Add(MinPos);
      LastKey := MinKey;
      for I := MinPos + 1 to Length(Key) do
        if Key[I] = LastKey then
          Dest.Add(I);
    end;
    // for I := 1 to Dest.Count - 1 do ShowMessage(IntToStr(Dest[I])); 
  end;
end;

[Dejan Vu]

Wenn es um kleine Listen geht, ist ein Insertion oder Bubble vermutlich das schnellste (kA, was jetzt stabil ist). Handelt es sich um längere Listen, bildet man eine totale Ordnung auf den Elementen und verwendet dann z.B. Quicksort.

Eine totale Ordnung kann man z.B. einfach dadurch erreichen, das jedes Element neben dem Primärkriterum 'Buchstabe' noch ein Sekundärkriterium 'Position' bekommt, anhand derer zwei bezüglich des Primärkriteriums identischer Elemente entsprechend Ihres Sekundärkriteriums korrekt sortiert werden. Anhand des Beispiels 'NOTEBOOK' wären die Elemente also
N1,O2,T3,E4,B5,O6,O7,K8. und damit wäre die Sortierung B5,E4,K8,N1,O2,O6,O7,T3. Mit diesem Zwischenschritt (Erstellen der Primär- und Sekundärkriterien) kann man dann in der Sortierten Liste direkt die Indexe ablesen.

Wenn man schon beim Erstellen der Kriterien ist, könnte man die Elemente auch in eine Skiplist einfügen und dann auslesen. Das ist auch erstaunlich schnell.

[Sir Rufo]

Zur Reihenfolge, ich hatte die Ziffernfolge einfach falsch interpretiert.

Erwähnte ich schon mal, dass ich faul bin?

Delphi-Quellcode:

TSortRec = record
  C : Char;
  Pos : Integer;
end;

Jetzt aus dem String ein Array mit diesem Record füllen und das Array mit einem entsprechenden Comparer sortieren lassen. Ist quasi ein 4-5 Zeiler und selbst mit einem instabilen Sortierverfahren wird eine stabile Sortierung erreicht.

[Dejan Vu]

Das entspricht dem, was ich umständlich versucht habe, zu beschreiben. Nur als 5-Zeiler. Elegant.

[Sir Rufo]

Zitat:

Zitat von Dejan Vu (Beitrag 1286258)

Das entspricht dem, was ich umständlich versucht habe, zu beschreiben. Nur als 5-Zeiler. Elegant.

Erwähnte ich schon mal, dass ich faul bin? :mrgreen:

[Bjoerk]

Gut, das geht natürlich. Auf die Idee bin ich nicht gekommen. Bin mit Uwes Algo aber eigentlich zufrieden und die Keys sind nicht sooo lang.

BTW, wie kriegt man den TSortRec in eine TList ohne New und Dispose zu verwenden?

Delphi-Quellcode:

  TSortRec = record
    C: Char;
    Pos: Integer;
  end;

  TSortRecList = class
  private
    FItems: array of TSortRec;
    function Compare(Const A, B: TSortRec): integer;
    function GetCount: integer;
    procedure SetCount(const Value: integer);
    function GetItems(Index: integer): TSortRec;
    procedure QuickSort(L, R: integer);
    procedure Exchange(const I, J: integer);
  public
    procedure Add(const S: string);
    procedure Sort;
    procedure Clear;
    property Count: integer read GetCount;
    property Items[Index: integer]: TSortRec read GetItems; default;
    destructor Destroy; override;
  end;

..

{ TSortRecList }

destructor TSortRecList.Destroy;
begin
  Clear;
  inherited;
end;

procedure TSortRecList.Clear;
begin
  SetCount(0);
end;

function TSortRecList.GetItems(Index: integer): TSortRec;
begin
  Result := FItems[Index];
end;

function TSortRecList.GetCount: integer;
begin
  Result := Length(FItems);
end;

procedure TSortRecList.SetCount(const Value: integer);
begin
  SetLength(FItems, Value);
end;

procedure TSortRecList.Add(const S: string);
var
  I, OldCount: integer;
begin
  OldCount := Count;
  SetCount(Count + Length(S));
  for I := 1 to Length(S) do
  begin
    FItems[OldCount + I - 1].C := S[I];
    FItems[OldCount + I - 1].Pos := OldCount + I;
  end;
end;

procedure TSortRecList.Exchange(const I, J: integer);
var
  Temp: TSortRec;
begin
  Temp := FItems[I];
  FItems[I] := FItems[J];
  FItems[J] := Temp;
end;

function TSortRecList.Compare(const A, B: TSortRec): integer;
begin
  if A.C > B.C then
    Result := 1
  else
    if A.C < B.C then
      Result := -1
    else
      if A.Pos > B.Pos then
        Result := 1
      else
        if A.Pos < B.Pos then
          Result := -1
        else
          Result := 0;
end;

procedure TSortRecList.QuickSort(L, R: integer);
var
  I, J, K: integer;
  Pivot: TSortRec;
begin
  repeat
    I := L;
    J := R;
    K := (L + R) shr 1;
    Pivot := FItems[K];
    repeat
      while Compare(FItems[I], Pivot) < 0 do
        Inc(I);
      while Compare(FItems[J], Pivot) > 0 do
        Dec(J);
      if I <= J then
      begin
        Exchange(I, J);
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort(L, J);
    L := I;
  until I >= R;
end;

procedure TSortRecList.Sort;
begin
  if Count > 1 then
    QuickSort(0, Count - 1);
end;

..

procedure TSomeForm.Button1Click(Sender: TObject);
var
  O: TSortRecList;
  I: integer;
begin
  O := TSortRecList.Create;
  try
    O.Add('NOTEBOOK');
    O.Sort;
    for I := 0 to O.Count - 1 do
      ShowMessage(Format('%s: %d', [O[I].C, O[I].Pos]));
  finally
    O.Free;
  end;
end;

[Bjoerk]

Ich glaub, ich werd für Listen überhaupt keine Records mehr verwenden.

Delphi-Quellcode:

procedure TDiceEncryptionSortKey.SetKey(const Value: string);
var
  I, J: integer;
begin
  FKey := Value;
  FItems.Clear;
  for I := 1 to Length(FKey) do
  begin
    J := FItems.Add(TDiceEncryptionKeyChar.Create);
    Items[J].Value := FKey[I];
    Items[J].Pos := I;
  end;
  if Count > 1 then
    FItems.Sort(@SortCompare);
end;

[Uwe Raabe]

Übergib doch die Werte gleich mit an das TDiceEncryptionKeyChar.Create.