FileQuickSort (Dateien mit wenig Speicherlast sortieren)

[Satty67]

http://www.delphipraxis.net/internal...t.php?t=153933

In diesem Thread gab es die Frage, wie man am Besten sehr große Textdateien sortieren könnte, ohne den Arbeits-Speicher zu sehr zu belasten. Im Thread wurde die Methode entwickelt und erste kleine Code-Beispiele gepostet. Für kleinere Dateien ist wohl TStringList eleganter, aber eben auch nicht immer geeignet.

Hier ist nun meine fertige Version, die die Vorschläge zum größten Teil umsetzt. Auszug aus dem Interface:

Delphi-Quellcode:

const
  CancelFileQuickSort : Boolean = False;

type
  TFileQuickSortCallBack = procedure(Status : String; PercentDone : Integer);

procedure FileQuickSort(const SourceFileName, TargetFileName: AnsiString;
                        PrefetchSize : Word;
                        CallBackProcedure : TFileQuickSortCallBack = NIL);

Das meiste ist selbsterklärend:

CancelFileQuickSort auf True, bricht die Routine (leicht verzögert) ab.

TFileQuickSortCallBack kann zum Anzeigen des Fortschitts und für Application.ProcessMessages verwendet werden. (Wird alle 0,1% aufgerufen)

SourceFileName & TargetFileName sollte klar sein. Textdateien bevorzugt

PrefetchSize ist der interessanteste Wert. Hier wird festgelegt, wieviel einer Zeile zum Vergleich beim sortieren im Arbeitsspeicher abgelegt wird. Bei PrefetchSize = 0 werden die Textzeilen jedesmal komplett aus der Quell-Datei geladen. Bei PrefetchSize > 0 wird nur dann beim Sortieren wieder auf die Quell-Datei zugegriffen, wenn der Ausschnitt nicht eindeutig zu vergleichen ist. Je kleiner die zu sortierenden Dateien, desto größer sollte man PrefetchSize wählen (max. 1024 Zeichen/Zeile). Als ausreichender Kompromiss war bei meinen Tests aber schon ein Wert von 16.

Probleme:

Die Zieldatei-Größe kann um zwei Zeichen abweichen, da das letzte CR/LF unterschiedlich behandelt wird. Sollte aber kein großes Problem sein.

Umlaute werden nicht Normgerecht behandelt. Umlaute werden nach "Z" einsortiert. ich weis schon wie und wo ich ansetzen müsste, aber das kommt evtl. in einer späteren Version.

Ziel-Datei schreiben wird nicht in den Fortschritts-Wert einbezogen. Bei kleinen Prefetch-Werten bleibt es etwas länger auf 99% stehen.

Benchmark Ergebnisse:

Core2Duo E8200, 7200 SATA Harddisk,
Wörterbuchdatei 8,5 MB (teilsortiert: Nomen vor Verben/Adjektive statt alphanumerisch)

PrefetchSize = 0 : 40.500 ms
PrefetchSize = 4 : 17.400 ms
PrefetchSize = 8 : 8.460 ms
PrefetchSize = 16 : 3.950 ms
PrefetchSize = 1024 : 3.765 ms


Hier die komplette Unit zum analysieren:

Delphi-Quellcode:

(******************************************************************************
  Text-Datei sortieren (ganz oder zum Teil im Arbeitsspeicher)
******************************************************************************)
unit UFileQuickSort;

interface

uses SysUtils, Classes, Dialogs;

resourcestring
  txt_SourceFileError = 'Quell-Datei kann nicht geöffnet werden!';
  txt_TargetFileError = 'Ziel-Datei kann nicht geöffnet werden!';
  txt_StatusIndex     = 'Index wird aufgebaut...';
  txt_StatusSort      = 'Sortiere Datei (%d%%)';
  txt_StatusWrite     = 'Schreibe Ziel-Datei...';
  txt_StatusDone      = 'Fertig.';

const
  CancelFileQuickSort : Boolean = False;

type
  TFileQuickSortCallBack = procedure(Status : String; PercentDone : Integer);

procedure FileQuickSort(const SourceFileName, TargetFileName: AnsiString;
                        PrefetchSize : Word;
                        CallBackProcedure : TFileQuickSortCallBack = NIL);

implementation

procedure FileQuickSort(const SourceFileName, TargetFileName: AnsiString;
                        PrefetchSize : Word;
                        CallBackProcedure : TFileQuickSortCallBack = NIL);
const
  FileIndexBlock = 100000;
type
  TGetLineTyp = (glt_File, glt_FileUpper, glt_Prefetch);
  TLineIndex = record
    offset,
    size     : Integer;
    prefetch : AnsiString;
  end;
  TFileIndex = array of TLineIndex;
var
  Promille, LastPromille : Integer;
  FileIndex : TFileIndex;
  SourceFStream : TFileStream;

  {<--- Index aufbauen --->}
  procedure LoadFileIndex;
  var
    i, Offset, Reserved : Integer;
    InFile : TextFile;
    TmpStr : AnsiString;
  begin
    i := 0;
    Offset := 0;
    Reserved := FileIndexBlock;
    SetLength(FileIndex, Reserved);
    if PrefetchSize > 1024 then PrefetchSize := 1024;

    AssignFile(InFile, SourceFileName);
    {$I-}
    Reset(InFile);
    {$I+}
    if IOResult = 0 then begin
      while not eof(InFile) do begin
        ReadLN(InFile, TmpStr);

        FileIndex[i].offset := Offset;
        FileIndex[i].size := Length(TmpStr);
        FileIndex[i].prefetch := AnsiUpperCase(Copy(TmpStr,1,PrefetchSize));
        Offset := Offset + FileIndex[i].size + 2;
        inc(i);

        // Mehr Index-Speicher reservieren
        if i >= Reserved then begin
          Reserved := Reserved + FileIndexBlock;
          SetLength(FileIndex, Reserved);
        end;
      end;
      CloseFile(InFile);

    end else ShowMessage(txt_SourceFileError);

    SetLength(FileIndex, i);
  end;

  {<--- Holt eine Textzeile via Index --->}
  function GetLine(Idx : Integer; LineTyp : TGetLineTyp): AnsiString;

    function LineFromFile: AnsiString;
    var
      CharStr : PAnsiChar;
      index : TLineIndex;
    begin
      index := FileIndex[Idx];
      CharStr := StrAlloc(Index.size +1);
      FillChar(CharStr^, Index.size +1, #0);
      SourceFStream.Seek(Index.offset, soFromBeginning);
      SourceFStream.Read(CharStr^, Index.size);
      Result := CharStr;
      StrDispose(CharStr);
    end;

  begin
    case LineTyp of
      glt_File      : Result := LineFromFile;
      glt_FileUpper : Result := AnsiUpperCase(LineFromFile);
      glt_Prefetch  : Result := FileIndex[Idx].prefetch;
    end;
  end;

  {<--- Index Sortieren --->}
  procedure QuickSort(LoIndex, HiIndex: Integer; LineTyp : TGetLineTyp);
  var
    LoIdx, HiIdx: Integer;
    Pivot: String;
    Swap : TLineIndex;
  begin
    if CancelFileQuickSort then Exit;

    // Lokalen Indexbereich bilden
    LoIdx := LoIndex;
    HiIdx := HiIndex;
    // Mittelwert muss noch optimiert werden
    Pivot := GetLine((LoIndex + HiIndex) div 2, LineTyp);

    repeat
      while GetLine(LoIdx, LineTyp) < Pivot do Inc(LoIdx);
      while Pivot < GetLine(HiIdx, LineTyp) do Dec(HiIdx);

      if LoIdx <= HiIdx then begin
        if LoIdx < HiIdx then begin
          Swap := FileIndex[LoIdx];
          FileIndex[LoIdx] := FileIndex[HiIdx];
          FileIndex[HiIdx] := Swap;
        end;
        Inc(LoIdx);
        Dec(HiIdx);
      end;

    until LoIdx > HiIdx;

    // CallBack nur alle 0,1% aufrufen
    if Assigned(CallBackProcedure) then begin
      Promille := (LoIndex * 1000) div Length(FileIndex);
      if Promille > LastPromille then begin
        LastPromille := Promille;
        CallBackProcedure(Format(txt_StatusSort,[Promille div 10]), Promille div 10);
      end;
    end;

    if LoIndex < HiIdx then QuickSort(LoIndex, HiIdx, LineTyp);
    if LoIdx < HiIndex then QuickSort(LoIdx, HiIndex, LineTyp);
  end;

  {<--- Zieldatei schreiben --->}
  procedure WriteTargetFile;
  var
    OutFile : TextFile;
    i,i2, LoIdx, HiIdx : Integer;
  begin
    AssignFile(OutFile, TargetFileName);
    {$I-}
    Rewrite(OutFile);
    {$I+}
    if IOResult = 0 then begin

      // An Index ein zum Letzten ungleichen Prefetch anhängen
      i := Length(FileIndex);
      SetLength(FileIndex, i+1);
      FileIndex[i].prefetch := FileIndex[i-1].prefetch + 'X';

      i := 0;
      repeat

        // Wenn Index[n] <> Index[n+1] dann schreiben
        if (PrefetchSize = 0)
        or (FileIndex[i].prefetch <> FileIndex[i+1].prefetch) then begin

          WriteLN(OutFile, GetLine(i, glt_File));
          inc(i);

        // Ansonsten erstes gleiches merken und erstes ungleiches suchen
        end else begin
          LoIdx := i;
          HiIdx := i+1;
          while FileIndex[LoIdx].prefetch = FileIndex[HiIdx].prefetch do Inc(HiIdx);
          // Nachsortieren, diesmal mit ganzer Zeile
          QuickSort(LoIdx,HiIdx, glt_FileUpper);
          // Schreiben
          for i2 := LoIdx to HiIdx do
            WriteLN(OutFile, GetLine(i2, glt_File));

          i := HiIdx +1;
        end;

        if CancelFileQuickSort then i := Length(FileIndex);

      until i > Length(FileIndex)-2;
      CloseFile(OutFile);

    end else ShowMessage(txt_SourceFileError);
  end;

{<--- Haupt Routine --->}
begin
  CancelFileQuickSort := False;

  // Index aufbauen
  if Assigned(CallBackProcedure) then CallBackProcedure(txt_StatusIndex, 0);
  LoadFileIndex;

  try
    // Quelldatei exclusiv öffnen, wir wollen ja keine verfälschten Ergebnisse
    SourceFStream := TFileStream.Create(SourceFileName,fmOpenRead or fmShareExclusive);
    try

      If (Length(FileIndex) > 0) and not CancelFileQuickSort then begin

        // Index (Vor-)Sortieren
        LastPromille := 0;
        // Wenn PrefetchSize > 0 muss bei schreiben evtl. nachsortiert werden!
        if PrefetchSize > 0 then QuickSort(0, Length(FileIndex)-1, glt_Prefetch)
          else QuickSort(0, Length(FileIndex)-1, glt_FileUpper);

        // Zieldatei schreiben
        if Assigned(CallBackProcedure) then CallBackProcedure(txt_StatusWrite, 99);
        if not CancelFileQuickSort then WriteTargetFile;

      end;

    finally
      SourceFStream.Free;
    end;
  // Quelldatei Fehler
  except
    on EFOpenError do ShowMessage(txt_SourceFileError);
  end;

  // Wer hätte das im Vorfeld erwartet? Fertig!
  if Assigned(CallBackProcedure) then CallBackProcedure(txt_StatusDone, 100);
end;

end.

In der Anlage ist das komplette Projekt mit kleinem Frontend zum Testen (incl. EXE-Datei).

Die Wörterbuch-Datei (zum Testen) ist nicht dabei, da ich mir nicht 100% sicher bin, ob ich hier als Anlage weitergeben darf. Ist ein Wörterbuch aus einem freien PlugIn von Firefox. Ein Moderator kann sich ja dazu äußern, dann liefere ich die nach (sind 1,8 MByte gepackt).

[Apollonius]

Ich finde, dass die Abbruchmöglichkeit eher durch den Callback gegeben werden sollte. Beschreibbare Konstanten sind nicht gut (hier entsteht auch kein Vorteil gegenüber globalen Variablen - sieht man davon ab, dass es geeignet ist, die OOP-Fetischisten so zu verwirren, dass sie nicht gleich mit dem Geschrei anfangen ). Hier entstehen Probleme bei mehreren Threads.

[Satty67]

Ja, die Pseudo-Konstanten nehme ich auch immer dann, wenn einer Variablen sowieso im Code ein Defaultwert zugewiesen wird. Ist mehr eine Hilfe für mich, das gleich im Interface zu sehen.

Aber ich probiere aus, wie ich es mit einer rein lokalen Variable via Callback-Funktion hin bekomme. Klingt für mich auch eleganter, bin halt nur nicht auf die Idee gekommen

[alzaimar]

Du kannst Dir das Nachsortieren komplett sparen, indem Du Die Vergleichsroutine mit einem optionalen Nachladen ausstattest, etwa so:

Delphi-Quellcode:

Function CompareTextlines (aIdx1, aIdx2 : TLineIndex) : Shortint; // -1: aIdx1<aIdx2, 0: beide gleich
Begin
  Result := CompareString (aIdx1.prefetch, aIdx2.prefetch);
  If Result = 0 Then  // prefetch-Strings sind identisch, also nachladen, um sicher zu sein
     Result := CompareString (ReadLine (aIdx1), ReadLine (aIdx2));
End;

Damit genügt es, Quicksort einmalig aufzurufen. Du müsstest Nur die Vergleiche '<' durch einen Aufruf von 'CompareTextLines' ersetzen. In dieser Funktion könntest Du auch eine andere Vergleichsroutine implementieren, die z.B. Umlaute so einsortiert, wie Du es für richtig hältst.

Um das nochmals zu optimieren, kannst Du einen Cache in die Funktion 'ReadLine' packen.

Zu der Callbackroutine: Verpasse der Parameterliste einfach einen Var-Parameter 'Cancel', den man einfach auf True setzt. Den Status würde ich als Enum-Wert (stStart, stRunning, stDone usw.) übergeben, dann kann das auch ein Finne verwenden.

Was mich ein wenig an der Vorgehensweise stört, ist die Tatsache, das sie bei einer wirklich großen Datei wegen Speicherüberlauf einfach nicht funktioniert.

[sx2008]

Du könntest aus der Funktion eine Klasse machen.
Funktionen, deren Code mehrere Bildschirmseiten bedecken und ausserdem eingeschachtelte Unterfunktionen haben, sind ein klares Indiz dafür, dass hier eigentlich eine Klasse hingehört.
Auf neudeutsch wäre das ein "Code smell".

[Apollonius]

Ich sehe keinen Block, der länger als eine Bildschirmseite ist. Was wäre hier der Vorteil einer Klasse?

[Satty67]

Zitat von alzaimar:

Du kannst Dir das Nachsortieren komplett sparen

Top Vorschlag, löst dann auch mein Problem mit dem u.U. langsameren Speichern. Da hatte ich einen Denkfehler beim Entwurf, aber es wird ja so auch nicht mehr Speicher belastet und die Dateizugriffe bleiben gleich.

Abbruch im Callback ist jetzt klar und leicht umzusetzen.

Zitat von alzaimar:

Was mich ein wenig an der Vorgehensweise stört, ist die Tatsache, das sie bei einer wirklich großen Datei wegen Speicherüberlauf einfach nicht funktioniert.

Über die Grenzen bin ich mir nicht 100% klar. bei einer Datei unter 2 GByte kann es auch zu Problemen kommen?
(die Grenze von 2 GByte sollte ich natürlich abfangen)

[sx2008]

Zitat von Apollonius:

Ich sehe keinen Block, der länger als eine Bildschirmseite ist. Was wäre hier der Vorteil einer Klasse?

Ich weiss ja nicht wie gross dein Bildschirm ist, aber die Hauptfunktion (inkl. geschachtelten Unterfunktionen) hat über 210 Zeilen.
Der Code ist sozusagen "verklumpt" und schwer zu testen.
Man kann nicht einfach ein Teilstück (z.B. Aufbau des Index) rausnehmen und für sich testen.

Die Vorteile einer Klasse sind (unter anderem):
* man kann Teilaufgaben übersichtlich in Methoden verpacken
* man kann Teilaufgaben an anderen Klassen deligieren
* Klassen können abgeleitet und so erweitert werden
Zum Beispiel könnte man die Klasse so schreiben, dass Ein- und Ausgabe TStream-Objekte sind.
Das wäre flexibler als nur über Dateien zu sortieren.

[Luckie]

Zitat von sx2008:

Du könntest aus der Funktion eine Klasse machen.
Funktionen, deren Code mehrere Bildschirmseiten bedecken und ausserdem eingeschachtelte Unterfunktionen haben, sind ein klares Indiz dafür, dass hier eigentlich eine Klasse hingehört.
Auf neudeutsch wäre das ein "Code smell".

Hhe, da hat schon jemand sein Buch gelesen. Auch ich würde eine Klasse raus machen und mit Ereignissen arbeieten anstatt mit Callbacks. Dann hast du auch das Problem mit deiner Abbruchvariablen gelöst.

[Satty67]

Den Smiley's fehlt eines, das wie ein gerupftes Hühnchen aussieht.

Das ganze in eine Klasse zu packen, das dauert bei mir dann aber etwas länger. Die ganzen Mechanismen sitzen bei mir noch nicht (ohne OH). Werde es aber wohl dann als Übung nehmen, das ganze besser zu verstehen.

Danke für die konstruktive Kritik. Perfekten Code, mit all den neuen Möglichkeiten von Delphi, werde ich aber wohl nicht hinbekommen.