Delphi-PRAXiS - Delphi FileQuickSort (Dateien mit wenig Speicherlast sortieren)

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