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).