Sortierung von Stringlisten ab unbestimmter Position

[nahpets]

Hallo,

habe folgendes Problem:

Es sollen Stringlisten sortiert werden, die ähnlich zu CSV-Dateien über ein Trennzeichen getrennte Spalten haben. Die einzelnen Zeilen verfügen nicht über die gleiche Länge, so dass die Trennzeichen an jeder beliebigen Stelle der Zeile vorkommen können. Die Aufgabe ist nun, die Stringliste ab z. B. dem 4. Trennzeichen aufsteigend zu sortieren.
Dies funktioniert mit einem Nachfahren von TStringList und einer eigenen Vergleichsroutine, die über CustomSort aufgerufen wird. Die dort aufzurufende Funktion benötigt als ersten Parameter eine Stringliste, was mit dem Nachfahren problemlos funktioniert. In der eigenen Vergleichsfunktion kann man aber nicht anstelle des ersten Parameter = TStringList die eigene Klasse übergeben, da hier vom Compiler und dem Vorfahren nur TStringList akzeptiert wird. Die Vergleichsfunktion als Funktion der Klasse zu implementieren funktioniert nicht, da CustomSort eine "klassenlose" Funktion erwartet.

Was mich stört: In der Vergleichsfunktion ist ein Typecast auf den Typ des Nachfahren, also auf die eigene Klasse, zu der die Vergleichsfunktion eigentlich gehört (gehören sollte). Ohne den Typecast bekommt jemand, der die Vergleichsfunktion nur mit einer Stringliste aufruft, ein Problem.
Läßt sich der Typecast irgendwie umgehen? Mir sieht das nicht wirklich objektorientiert aus.

Delphi-Quellcode:

.
.
.
interface
.
.
.
type
  tSortStringList = class(TStringList)
  private
    fSortColumn : Integer;
  protected
  public
    procedure Compare;
  published
    property SortColumn : Integer Read FSortColumn Write fSortColumn Default 0;
  end;
.
.
.
implementation
.
.
.
// Stelle im String ermitteln, ab der sortiert werden soll.
Function GetStartPos(s : String; Delimiter : Char; SortColumn : Integer) : Integer;
Var
         iPos     : Integer;
         iCount   : Integer;
begin
  iPos := 0;
  for iCount := 1 to SortColumn Do iPos := PosEx(Delimiter,s,iPos + 1);
  Inc(iPos);
  Result := iPos;
end;

// Länge des zu sortierenden Strings ermitteln.
Function GetNextPos(s : String; Delimiter : Char; iStartPos : Integer) : Integer;
Var
         iNextPos : Integer;
begin
  iNextPos := PosEx(Delimiter,s,iStartPos);
  case iNextPos of 0 : iNextPos := Length(s); end;
  Result := iNextPos;
end;

function MyCompare(List: TStringList; Index1, Index2: Integer): Integer;
var
         iPos1          : Integer;
         iPos2          : Integer;
         iPosLast1      : Integer;
         iPosLast2      : Integer;
         iColumn        : Integer;
begin
  if List is TSortStringList then begin  // <-- das stört mich
    iColumn := TSortStringList(List).SortColumn;
  end else begin
    iColumn := 0;
  end;
  // Startposition der Sortierung im ersten String ermitteln.
  iPos1     := GetStartPos(List[Index1],List.Delimiter,iColumn);
  // Startposition der Sortierung im zweiten String ermitteln.
  iPos2     := GetStartPos(List[Index2],List.Delimiter,iColumn);
  // Länge des zu sortierenden (Teil)Strings ermitteln.
  iPosLast1 := GetNextPos(List[Index1],List.Delimiter,iPos1);
  iPosLast2 := GetNextPos(List[Index2],List.Delimiter,iPos2);
  // Groß-/Kleinschreibung beim Vergleich beachten?
  if List.CaseSensitive then begin
    Result  := AnsiCompareStr(Copy(List[Index1],
                                   iPos1,
                                   iPosLast1),
                              Copy(List[Index2],
                                   iPos2,
                                   iPosLast2)
                             );
  end else begin
    Result := AnsiCompareText(Copy(List[Index1],
                                   iPos1,
                                   iPosLast1),
                              Copy(List[Index2],
                                   iPos2,
                                   iPosLast2)
                             );
  end;
end;

procedure TSortStringList.Compare;
begin
  Self.CustomSort(MyCompare);
end;

Ein Aufruf könnte so aussehen: (Sortierung ab dem 4. | aufsteigend und Groß-/Kleinschreibung ignorieren)

Delphi-Quellcode:

Stringliste.Delimiter := '|';
Stringliste.SortColumn := 4;
Stringliste.CaseSensitive := false;
Stringliste.Compare;

Wer hat da eine Idee, wie man's besser machen könnte?

[alzaimar]

1. Ermittle die Delimiter-Positionen (GetStartPos und GetNextPos) je Zeile einmal im Vorfeld und speichere die Ergebnisse zwischen. Dadurch werden redundante Mehrfachaufrufe vermieden.

2. Die Funktionen GetStartPos und GetNextPos sollten private Methoden deiner Klasse werden

3. Deine Sorge bezüglich des 'MyCompare'-Funktion ist unbegründet. Keiner wird je diese Funktion zu Gesicht bekommen, sie ist doch lokal in der Unit und damit unsichtbar. Entferne die Prüfung 'If item is...', denn das brauchst Du doch nicht und es frisst Performance.

[nahpets]

Hallo alzaimar,

Zitat:

Zitat von alzaimar

1. Ermittle die Delimiter-Positionen (GetStartPos und GetNextPos) je Zeile einmal im Vorfeld und speichere die Ergebnisse zwischen. Dadurch werden redundante Mehrfachaufrufe vermieden.

2. Die Funktionen GetStartPos und GetNextPos sollten private Methoden deiner Klasse werden

3. Deine Sorge bezüglich des 'MyCompare'-Funktion ist unbegründet. Keiner wird je diese Funktion zu Gesicht bekommen, sie ist doch lokal in der Unit und damit unsichtbar. Entferne die Prüfung 'If item is...', denn das brauchst Du doch nicht und es frisst Performance.

da komm' ich jetzt nicht so ganz mit:

Zitat:

2. Die Funktionen GetStartPos und GetNextPos sollten private Methoden deiner Klasse werden

dann kenne ich sie in MyCompare nicht mehr. In MyCompare müsste ich dann mit einem Konstrukt wie

Delphi-Quellcode:

with List as TSortStringList do begin
.
.
.
end;

arbeiten, um doch an GetStartPos und GetNextPos zu kommen.

Für die vorab ermittelten Positionen brauche ich also entsprechende Attribute in der Klasse, in denen ich die Ergebnisse der Funktionen GetStartPos und GetNextPos vorhalte, die entsprechend Deinem Vorschlag vorher ermittelt wurden. Hier könnte dann ein dynamisches Array mit 'nem Record der Form

Delphi-Quellcode:

type
  rPosData = record
    StartPos : Word;
    NextPos  : Word;
  end;
.
.
.
  fPosData = Array of rPosData;
.
.
.

herhalten und in

Delphi-Quellcode:

procedure TSortStringList.Compare;
Var
          i        : Integer;
          iPos     : Integer;
          iPosLast : Integer;
begin
  SetLength(fPosData,Self.Count);
  for i := 0 To Self.Count - 1 Do begin
    iPos     := GetStartPos(Self[i],Self.Delimiter,fSortColumn);
    iPosLast := GetNextPos(Self[i],Self.Delimiter,iPos)
    fPosData[i].StartPos := iPos;
    fPosData[i].NextPos  := iPosLast;
  end;
  Self.CustomSort(MyCompare);
end;

füllen wir das Array.
Als Ergebnis von MyCompare werden von CustomSort Einträge der Stringliste vertauscht. Wie bekomme ich denn da eine Synchronisation der vertauschen Einträge mit den vorab ermittelten Positionen hin? Dann müsste ich ja quasi in MyCompare so 'ne Art Swap für den Vertausch der zu Index1 und Index2 gehörenden Positionsangaben machen.

zu 3: Prinzipiell hast Du recht, eigentlich kann von "draussen" keiner an die Funktion ran, nur weitere Klassen innerhalb der gleichen Unit könnten Probleme bekommen. An dem Typecast selbst komme ich aber wohl nicht vorbei.

Momentan sieht das dann jetzt so aus:

Delphi-Quellcode:

type
  rPosData = record
    StartPos : Word;
    NextPos  : Word;
  end;

  arPosData = Array of rPosData;

type
  tSortStringList = class(TStringList)
  private
    fSortColumn : Integer;
    fPosData    : arPosData;
  protected
    function GetStartPos(s : String; Delimiter : Char; SortColumn : Integer) : Integer;
    function GetNextPos(s : String; Delimiter : Char; iStartPos : Integer) : Integer;
  public
    procedure Compare;
  published
    property SortColumn : Integer Read FSortColumn Write fSortColumn Default 0;
  end;
.
.
.
implementation
.
.
.
// Stelle im String ermitteln, ab der sortiert werden soll.
Function TSortStringList.GetStartPos(s : String; Delimiter : Char; SortColumn : Integer) : Integer;
Var
         iPos     : Integer;
         iCount   : Integer;
begin
  iPos := 0;
  for iCount := 1 to SortColumn Do iPos := PosEx(Delimiter,s,iPos + 1);
  Inc(iPos);
  Result := iPos;
end;

// Länge des zu sortierenden Strings ermitteln.
Function TSortStringList.GetNextPos(s : String; Delimiter : Char; iStartPos : Integer) : Integer;
Var
         iNextPos : Integer;
begin
  iNextPos := PosEx(Delimiter,s,iStartPos);
  case iNextPos of 0 : iNextPos := Length(s); end;
  Result := iNextPos;
end;

function MyCompare(List: TStringList; Index1, Index2: Integer): Integer;
var
         iPos           : Integer;
begin
  with List As TSortStringList do begin
    if List.CaseSensitive then begin
      Result  := AnsiCompareStr(Copy(List[Index1],
                                     fPosData[Index1].StartPos,
                                     fPosData[Index1].NextPos),
                                Copy(List[Index2],
                                     fPosData[Index2].StartPos,
                                     fPosData[Index2].NextPos)
                               );
    end else begin
      Result  := AnsiCompareText(Copy(List[Index1],
                                      fPosData[Index1].StartPos,
                                      fPosData[Index1].NextPos),
                                 Copy(List[Index2],
                                      fPosData[Index2].StartPos,
                                      fPosData[Index2].NextPos)
                                );
    end;
    case Result of
      0 : ; // hier brauchen wir nichts tuten, beide String sind gleich
    else
      iPos := fPosData[Index1].StartPos;
      fPosData[Index1].StartPos := fPosData[Index2].StartPos;
      fPosData[Index2].StartPos := iPos;
      iPos := fPosData[Index1].NextPos;
      fPosData[Index1].NextPos := fPosData[Index2].NextPos;
      fPosData[Index2].NextPos := iPos;
    end;
  end;
end;

procedure TSortStringList.Compare;
Var
          i        : Integer;
          iPos     : Integer;
          iPosLast : Integer;
begin
  SetLength(fPosData,Self.Count);
  for i := 0 To Self.Count - 1 Do begin
    iPos     := GetStartPos(Self[i],Self.Delimiter,fSortColumn);
    iPosLast := GetNextPos(Self[i],Self.Delimiter,iPos);
    fPosData[i].StartPos := iPos;
    fPosData[i].NextPos  := iPosLast;
  end;
  Self.CustomSort(MyCompare);
end;


// Aufruf im Programm
procedure TForm1.Button1Click(Sender: TObject);
Var
          StringListe : TSortStringList;
begin
  Stringliste := TSortStringList.Create;
  Stringliste.LoadFromFile('20081010.log');
  Stringliste.Delimiter := '|';
  Stringliste.SortColumn := 1;
  Stringliste.CaseSensitive := false;
  Stringliste.Compare;
  StringListe.SaveToFile('20081010.log.Sort');
  Stringliste.Free;
end;

Geschwindigkeitstechnisch kann ich bei den kleinen Dateien, die ich momentan habe, keinen Unterschied merken, aber bei großen Mengen dürfte das schon was ausmachen.

Vielen Dank für Deine Ideen und Anregungen.

[alzaimar]

Du hast Recht, mein Punkt 2 ist Blödsinn.

Delphi-Quellcode:

MyVar as TSomeType; //  erzeugt Overhead und eine Exception, wenns nicht passt.
TSomeType(MyVar); // ist schneller, aber gefährlich, wenns nicht passt.
...
If MyVar is TSomeType Then
  With MyVar as TSomeType Do // Ist doppeltgemoppelt, hier reicht der einfache Typecast

...
If MyVar is TSomeType Then
  With TSomeType(MyVar) Do

Gegen Typecasting ist übrigens Nichts einzuwenden.

[nahpets]

Hallo alzaimar,

habe mich nochmal drangesetzt, herausgekommen ist dabei dieses:

Delphi-Quellcode:

unit Sort;

interface

uses StrUtils, SysUtils;

type
  rPosData = record
    StartPos  : Word;
    NextPos   : Word;
    // SubString : String;
  end;

  arPosData = Array of rPosData;

type
  tSortStringList = class(TStringList)
  private
    fSortColumn : Integer;
    fPosData    : arPosData;
  protected
    function GetStartPos(s : String; Delimiter : Char; SortColumn : Integer) : Integer;
    function GetNextPos(s : String; Delimiter : Char; iStartPos : Integer) : Integer;
  public
    procedure Compare;
  published
    property SortColumn : Integer Read FSortColumn Write fSortColumn Default 0;
  end;

implementation

// Stelle im String ermitteln, ab der sortiert werden soll.
Function TSortStringList.GetStartPos(s : String; Delimiter : Char; SortColumn : Integer) : Integer;
Var
         iCount   : Integer;
begin
  Result := 0;
  for iCount := 1 to SortColumn Do Result := PosEx(Delimiter,s,Result + 1);
end;

// Länge des zu sortierenden Strings ermitteln.
Function TSortStringList.GetNextPos(s : String; Delimiter : Char; iStartPos : Integer) : Integer;
begin
  Result := PosEx(Delimiter,s,iStartPos);
end;

function MyCompare(List: TStringList; Index1, Index2: Integer): Integer;
Var
         iPos           : Integer;
//       sSubString     : String;
begin
  Result := 0;
  with List As TSortStringList do begin
    if List.CaseSensitive then begin
      Result  := AnsiCompareStr(Copy(List[Index1],
                                     fPosData[Index1].StartPos,
                                     fPosData[Index1].NextPos),
                                Copy(List[Index2],
                                     fPosData[Index2].StartPos,
                                     fPosData[Index2].NextPos)
                               );
      // Das funktioniert nicht, hat aus irgendeinem Grund keine Auswirkung
      // auf die Sortierung, schade, müssen wir beim Copy bleiben.
      // Result := AnsiCompareStr(fPosData[Index1].SubString,fPosData[Index2].SubString);
    end else begin
      Result  := AnsiCompareText(Copy(List[Index1],
                                      fPosData[Index1].StartPos,
                                      fPosData[Index1].NextPos),
                                 Copy(List[Index2],
                                      fPosData[Index2].StartPos,
                                      fPosData[Index2].NextPos)
                                );
      // Result := AnsiCompareText(fPosData[Index1].SubString,fPosData[Index2].SubString);
    end;
    case Result of
      0 : ; // hier brauchen wir nichts tuten, beide Strings sind gleich
    else
      iPos                       := fPosData[Index1].StartPos;
      fPosData[Index1].StartPos  := fPosData[Index2].StartPos;
      fPosData[Index2].StartPos  := iPos;
      iPos                       := fPosData[Index1].NextPos;
      fPosData[Index1].NextPos   := fPosData[Index2].NextPos;
      fPosData[Index2].NextPos   := iPos;
      // sSubString                 := fPosData[Index1].SubString;
      // fPosData[Index1].SubString := fPosData[Index2].SubString;
      // fPosData[Index2].SubString := sSubString;
    end;
  end;
end;

procedure TSortStringList.Compare;
Var
          i        : Integer;
          iPos     : Integer;
          iPosLast : Integer;
begin
  SetLength(fPosData,Self.Count);
  for i := 0 To Self.Count - 1 Do begin
    iPos := GetStartPos(Self[i],Self.Delimiter,fSortColumn);
    if iPos > 0 Then begin
      iPosLast := GetNextPos(Self[i],Self.Delimiter,iPos);
      fPosData[i].StartPos  := iPos;
      fPosData[i].NextPos   := iPosLast;
      // fPosData[i].SubString := Copy(Self[i],iPos, iPosLast - iPos);
    end else begin
      fPosData[i].StartPos  := Length(Self[i]);
      fPosData[i].NextPos   := Length(Self[i]);
      // fPosData[i].SubString := '';
    end;
  end;
  Self.CustomSort(MyCompare);
end;

end.

Es bleibt jetzt noch ein Problem: Sofern die zu sortierende Datei auch noch Zeilen enthält, die nicht über einen Delimiter verfügen, so sind die im Ergebnis "irgendwo" verteilt, aber das ist nachrangig.

[alzaimar]

Zitat:

Zitat von nahpets

Es bleibt jetzt noch ein Problem: Sofern die zu sortierende Datei auch noch Zeilen enthält, die nicht über einen Delimiter verfügen, so sind die im Ergebnis "irgendwo" verteilt, aber das ist nachrangig.

Nun, die entsprechende 'Spalte' ist dann NULL. Definiere einfach, ob NULL-Werte am Anfang oder am Ende auftauchen sollen (totale Ordnung auf die Daten).

Eine andere Möglichkeit wäre die Verwendung einer CSV-Klasse, die die Strings beim Einlesen sofort in eine Matrix überführt, über die mit 'MyCSV.Cells[Rownumber, Columnindex]' zugegriffen werden kann.


So eine Klasse gibt es z.B. hier: http://www.delphipraxis.net/internal...ght=tcsvreader

[nahpets]

Hallo,

nach einigem Rumprobieren und Fehlersuche ist nun folgendes übriggeblieben:

Delphi-Quellcode:

unit SortStringList;

interface

uses Classes;

type
  rPosData = record
    StartPos  : integer;
    NextPos   : integer;
  end;

  arPosData = Array of rPosData;

type
  tSortStringList = class(TStringList)
  private
    fSortColumn     : Integer;
    fSortDescending : Boolean;
  protected
    function GetStartPos(s : String; Delimiter : Char; SortColumn : Integer) : Integer;
    function GetNextPos (s : String; Delimiter : Char; iStartPos  : Integer) : Integer;
  public
    procedure Compare;
  published
    property SortColumn     : Integer Read FSortColumn     Write fSortColumn     Default 0;
    property SortDescending : Boolean Read fSortDescending Write fSortDescending Default False;
  end;

implementation

uses StrUtils, SysUtils;

// Stelle im String ermitteln, ab der sortiert werden soll.
Function TSortStringList.GetStartPos(s : String; Delimiter : Char; SortColumn : Integer) : Integer;
Var
         iCount   : Integer;
         iPos     : Integer;
begin 
  iCount := 0;
  iPos   := 0;
  Repeat
    iPos := PosEx(Delimiter,s,iPos + 1);
    Inc(iCount);
  until (iCount = SortColumn) or (iPos = 0);
  Result := iPos;
end;

// Länge des zu sortierenden Strings ermitteln.
Function TSortStringList.GetNextPos(s : String; Delimiter : Char; iStartPos : Integer) : Integer;
begin
  Result := PosEx(Delimiter,s,iStartPos);
  If Result = 0 Then Result := Length(s) Else Result := Result - iStartPos + 2;
end;

function MyCompare(List: TStringList; Index1, Index2: Integer): Integer;
Var
         iStartPos1     : Integer;
         iNextPos1      : Integer;
         iStartPos2     : Integer;
         iNextPos2      : Integer;
begin
  with List As TSortStringList do begin
    iStartPos1 := GetStartPos(List[Index1],Delimiter,SortColumn);
    iNextPos1  := GetNextPos(List[Index1],Delimiter,iStartPos1 + 1);
    iStartPos2 := GetStartPos(List[Index2],Delimiter,SortColumn);
    iNextPos2  := GetNextPos(List[Index2],Delimiter,iStartPos2 + 1);
    if List.CaseSensitive then begin
      Result  := AnsiCompareStr(Copy(List[Index1],iStartPos1,iNextPos1),
                                Copy(List[Index2],iStartPos2,iNextPos2));
    end else begin
      Result  := AnsiCompareText(Copy(List[Index1],iStartPos1,iNextPos1),
                                 Copy(List[Index2],iStartPos2,iNextPos2));
    end;
    If Result <> 0 then begin
      if SortDescending then Result := Result * (-1);
    end;
  end;
end;

procedure TSortStringList.Compare;
begin
  Self.CustomSort(MyCompare);
end;

end.

Den Aufbau eines Array mit Startpos... habe ich wieder entfernt, da der Inhalt dieses Arrays nicht immer mit der Reihenfolge der Einträge in der Stringliste synchron zu halten war. Wo da die Ursache liegt, habe ich nicht herausfinden können. Dafür kann man in dieser Fassung nun auch absteigend sortieren lassen.