mwfixedrecsort.pas

C++中的STL真的让人爱不释手,如果你使用DELPHI,现在你也有了类似于STL的标准库,还不赶快下载啊!

{+--------------------------------------------------------------------------+
 | Unit:        mwFixedRecSort
 | Created:     11.97
 | Author:      Martin Waldenburg
 | Copyright    1997, all rights reserved.
 | Description: A buffered sorter for an unlimmited amount of records with a fixed
 |              length using a three-way merge for memory and a buffered
 |              three-way merge  for files.
 | Version:     1.2
 | Status       FreeWare
 | It's provided as is, without a warranty of any kind.
 | You use it at your own risc.
 | E-Mail me at [e-mail]

{--------------------------------------------------------------------}
{ Martin Waldenburg
	Landaeckerstrasse 27
	71642 Ludwigsburg
	Germany
	Share your Code
 +--------------------------------------------------------------------------+}

unit mwFixedRecSort;

{$R-}



interface

uses SysUtils, Windows, Classes;

type
	TMergeCompare = function (Item1, Item2: Pointer): Integer;
	TMergeCompareEx = function (Item1, Item2: Pointer): Integer of object;
	PMergeArray = ^TMergeArray;
	TMergeArray = array[0..0] of Pointer;

{ TSub3Array defines the boundaries of a SubArray and determines if
	the SubArray is full or not.
	The MergeSort Algorithm is easier readable with this class.}
	TSub3Array = class(TObject)
	private
		FMax: LongInt;
	protected
	public
		FLeft: LongInt;  { - Initialized to 0. }
		FRight: LongInt;  { - Initialized to 0. }
		Full: Boolean;
		constructor Create(MaxValue: LongInt);
		destructor Destroy; override;
		procedure Init(LeftEnd, RightEnd: LongInt);
		procedure Next;
	end;  { TSub3Array }

{ TM3Array class }
	TM3Array = class(TObject)
	private
		FLeftArray, FMidArray, FRightArray: TSub3Array;
		FM3Array, TempArray, SwapArray: PMergeArray;
		FCount: Integer;
		fCapacity:Integer;
		procedure SetCapacity(NewCapacity:Integer);
		procedure Expand;
	protected
		function Get(Index: Integer): Pointer;
		procedure Put(Index: Integer; Item: Pointer);
		procedure Merge(SorCompare: TMergeCompare);
		procedure MergeEx(SorCompare: TMergeCompareEx);
	public
		destructor Destroy; override;
		function Add(Item: Pointer): Integer;
    procedure Clear;
    function Last: Pointer;
    procedure MergeSort(SorCompare: TMergeCompare);
    procedure QuickSort(SorCompare: TMergeCompare);
    procedure MergeSortEx(SorCompare: TMergeCompareEx);
    procedure QuickSortEx(SorCompare: TMergeCompareEx);
    property Count: Integer read FCount write FCount;
    property Items[Index: Integer]: Pointer read Get write Put; default;
    property M3Array: PMergeArray read FM3Array;
    property Capacity:Integer read fCapacity write SetCapacity;
  published
  end;   { TM3Array }

  TmIOBuffer = class(TObject)
  private
    fBuffFile: File;
    fFileName: String;
    fFilledSize:Longint;
    fBufferSize: LongInt;
    fBufferPos: LongInt;
    fBuffer: Pointer;
    fNeedFill: Boolean;
    fEof:Boolean;
    fFileEof: Boolean;
		FRecCount: Cardinal;
		fSize:Longint;
		fDataLen:Longint;
    procedure AllocBuffer(NewValue:Longint);
  protected
  public
    constructor create(FileName: string; DataLen, BuffSize: Integer);
    destructor destroy;override;
    procedure FillBuffer;
    function ReadData:Pointer;
    procedure WriteData(Var NewData);
    procedure FlushBuffer;
    procedure CloseBuffFile;
    procedure DeleteBuffFile;
    property Eof:Boolean read fEof;
    property RecCount: Cardinal read FRecCount;
    property Size:Longint read fSize;
    property DataLen:Longint read fDataLen;
  published
  end;  { TmIOBuffer }

  TTempFile = class(TObject)
  private
    fFileName: String;
    Reader: TmIOBuffer;
    fFull:Boolean;
  protected
  public
    FLeft: Pointer;
    constructor Create;
    destructor Destroy; override;
    procedure Next;
    procedure Init(FileName: String);
    property Full:Boolean read fFull;
  published
  end;  { TTempFile }

  TMergeFile = class(TObject)
  private
    FFileOne, FFileTwo, FFileThree: TTempFile;
    Writer: TmIOBuffer;
    fInList, fOutList, TempList: TStringList;
    fFileName:String;
  protected
  public
    constructor Create(InList: TStringList);
    destructor Destroy; override;
    procedure FileMerge(MergeCompare: TMergeCompare);
    procedure MergeSort(MergeCompare: TMergeCompare);
    property FileName:String read fFileName;
  published
  end;  { TMergeFile }

  TFixRecSort = class(TObject)
  private
    Reader, Writer: TmIOBuffer;
    FMaxLines: LongInt;
    fMerArray: TM3Array;
    MergeFile: TMergeFile;
    fFileName: String;
    fTempFileList: TStringList;
    fCompare: TMergeCompare;
    fMaxMem:LongInt;
    fUseMergesort:Boolean;
    function GetMaxMem:LongInt;
    procedure SetMaxMem(value:LongInt);
  protected
  public
    constructor Create(RecLen: LongInt);
    destructor Destroy; override;
    procedure Start(Compare: TMergeCompare);
    procedure Init(FileName: String);
    property MaxLines: LongInt read FMaxLines write FMaxLines default 60000;
    property MaxMem:LongInt read GetMaxMem write SetMaxMem;
    property UseMergesort:Boolean read fUseMergesort write fUseMergesort;
  published
  end;   { TFixRecSort }

Var FRecLen, fBuffersSize: Integer;

implementation

constructor TSub3Array.Create(MaxValue: LongInt);
  begin
    FLeft := 0;
    FRight := 0;
    Full := False;
    FMax := MaxValue;
  end;  { Create }

procedure TSub3Array.Init(LeftEnd, RightEnd: LongInt);  { public }
  begin
    FLeft:= LeftEnd;
    FRight:= RightEnd;
    if FLeft > FMax then Full:= False else Full:= True;
  end;  { Init }

procedure TSub3Array.Next;
  begin
    inc(FLeft);
    if (FLeft > FRight) or (FLeft > FMax) then Full:= False;
  end;  { Next }

destructor TSub3Array.Destroy;
  begin
    inherited Destroy;
  end;  { Destroy }

{ TM3Array }
destructor TM3Array.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TM3Array.Add(Item: Pointer): Integer;
begin
  Result := FCount;
  if Result = FCapacity then Expand;
  FM3Array[Result] := Item;
  Inc(FCount);
end;

procedure TM3Array.Expand;
begin
  SetCapacity(FCapacity + 8192);
end;

procedure TM3Array.SetCapacity(NewCapacity:Integer);
begin
  FCapacity:= NewCapacity;
  ReallocMem(FM3Array, FCapacity * 4);
end;

procedure TM3Array.Clear;
begin
  FCount:= 0;
  ReallocMem(TempArray, 0);
  ReallocMem(FM3Array, 0);
  FCapacity:= 0;
end;

function TM3Array.Get(Index: Integer): Pointer;
begin
  Result := FM3Array[Index];
end;

function TM3Array.Last: Pointer;
begin
  Result := Get(FCount - 1);
end;

procedure TM3Array.Put(Index: Integer; Item: Pointer);
begin
  FM3Array[Index] := Item;
end;

{ Based on a non-recursive QuickSort from the SWAG-Archive.
  ( TV Sorting Unit by Brad Williams ) }
procedure TM3Array.QuickSort(SorCompare: TMergeCompare);
var Left, Right, SubArray, SubLeft, SubRight:LongInt;
    Temp, Pivot: Pointer;
    Stack : array[1..32] of record First, Last : LongInt; end;
begin
  SubArray := 1;
  Stack[SubArray].First := 0;
  Stack[SubArray].Last := Count - 1;
    repeat
      Left := Stack[SubArray].First;
      Right := Stack[SubArray].Last;
      Dec(SubArray);
      repeat
        SubLeft := Left;
        SubRight := Right;
        Pivot := FM3Array[(Left + Right) shr 1];
        repeat
          while SorCompare(FM3Array[SubLeft], Pivot) < 0 do Inc(SubLeft);
          while SorCompare(FM3Array[SubRight], Pivot) > 0 do Dec(SubRight);
          IF SubLeft <= SubRight then
            begin
              Temp := FM3Array[SubLeft];
              FM3Array[SubLeft] := FM3Array[SubRight];
              FM3Array[SubRight] := Temp;
              Inc(SubLeft);
              Dec(SubRight);
            end;
        until SubLeft > SubRight;
        IF SubLeft < Right then
          begin
            Inc(SubArray);
            Stack[SubArray].First := SubLeft;
            Stack[SubArray].Last := Right;
          end;
          Right := SubRight;
      until Left >= Right;
    until SubArray = 0;
end;  { QuickSort }

procedure TM3Array.QuickSortEx(SorCompare: TMergeCompareEx);
var Left, Right, SubArray, SubLeft, SubRight:LongInt;
    Temp, Pivot: Pointer;
    Stack : array[1..32] of record First, Last : LongInt; end;
begin
  SubArray := 1;
  Stack[SubArray].First := 0;
  Stack[SubArray].Last := Count - 1;
    repeat
      Left := Stack[SubArray].First;
      Right := Stack[SubArray].Last;
      Dec(SubArray);
      repeat
        SubLeft := Left;
        SubRight := Right;
        Pivot := FM3Array[(Left + Right) shr 1];
        repeat
          while SorCompare(FM3Array[SubLeft], Pivot) < 0 do Inc(SubLeft);
          while SorCompare(FM3Array[SubRight], Pivot) > 0 do Dec(SubRight);
          IF SubLeft <= SubRight then
            begin
              Temp := FM3Array[SubLeft];
              FM3Array[SubLeft] := FM3Array[SubRight];
              FM3Array[SubRight] := Temp;
              Inc(SubLeft);
              Dec(SubRight);
            end;
        until SubLeft > SubRight;
        IF SubLeft < Right then
          begin
            Inc(SubArray);
            Stack[SubArray].First := SubLeft;
            Stack[SubArray].Last := Right;
          end;
          Right := SubRight;
      until Left >= Right;
    until SubArray = 0;
end;  { QuickSort }

{This is a three way merge routine.
 Unfortunately the " Merge " routine needs additional memory}
procedure TM3Array.Merge(SorCompare: TMergeCompare);
var
  TempPos : integer;
begin
  TempPos := FLeftArray.FLeft;
   while ( FLeftArray.Full ) and ( FMidArray.Full ) and ( FRightArray.Full ) do  {Main Loop}
    begin
      if SorCompare(FM3Array[FLeftArray.FLeft], FM3Array[FMidArray.FLeft]) <= 0 then
        begin
          if SorCompare(FM3Array[FLeftArray.FLeft], FM3Array[FRightArray.FLeft]) <= 0 then
            begin
              TempArray[ TempPos ] := FM3Array[ FLeftArray.FLeft ];
              FLeftArray.Next;
            end
          else
            begin
              TempArray[ TempPos ] := FM3Array[ FRightArray.FLeft ];
              FRightArray.Next;
            end;
        end
      else
        begin
          if SorCompare(FM3Array[FMidArray.FLeft], FM3Array[FRightArray.FLeft]) <= 0 then
            begin
              TempArray[ TempPos ] := FM3Array[ FMidArray.FLeft ];
              FMidArray.Next;
            end
          else
            begin
              TempArray[ TempPos ] := FM3Array[ FRightArray.FLeft ];
              FRightArray.Next;
            end;
        end;
          inc(TempPos);
    end;

   while ( FLeftArray.Full ) and ( FMidArray.Full ) do
    begin
      if SorCompare(FM3Array[FLeftArray.FLeft], FM3Array[FMidArray.FLeft]) <= 0 then
        begin
          TempArray[ TempPos ] := FM3Array[ FLeftArray.FLeft ];
          FLeftArray.Next;
        end
      else
        begin
          TempArray[ TempPos ] := FM3Array[ FMidArray.FLeft ];
          FMidArray.Next;
        end;
          inc(TempPos);
    end;

  while ( FMidArray.Full ) and ( FRightArray.Full ) do
    begin
      if SorCompare(FM3Array[FMidArray.FLeft], FM3Array[FRightArray.FLeft]) <= 0 then
        begin
          TempArray[ TempPos ] := FM3Array[ FMidArray.FLeft ];
          FMidArray.Next;
        end
      else
        begin
          TempArray[ TempPos ] := FM3Array[ FRightArray.FLeft ];
          FRightArray.Next;
        end;
          inc(TempPos);
    end;

  while ( FLeftArray.Full ) and ( FRightArray.Full ) do
    begin
      if SorCompare(FM3Array[FLeftArray.FLeft], FM3Array[FRightArray.FLeft]) <= 0 then
        begin
          TempArray[ TempPos ] := FM3Array[ FLeftArray.FLeft ];
          FLeftArray.Next;
        end
      else
        begin
          TempArray[ TempPos ] := FM3Array[ FRightArray.FLeft ];
          FRightArray.Next;
        end;
          inc(TempPos);
    end;

 while FLeftArray.Full do    { Copy Rest of First Sub3Array }
    begin
      TempArray[ TempPos ] := FM3Array[ FLeftArray.FLeft ];
      inc(TempPos); FLeftArray.Next;
    end;

  while FMidArray.Full do    { Copy Rest of Second Sub3Array }
    begin
      TempArray[ TempPos ] := FM3Array[ FMidArray.FLeft ];
      inc(TempPos); FMidArray.Next;
    end;

 while FRightArray.Full do   { Copy Rest of Third Sub3Array }
    begin
      TempArray[ TempPos ] := FM3Array[ FRightArray.FLeft ];
      inc(TempPos); FRightArray.Next;
    end;

end;  { Merge }

procedure TM3Array.MergeEx(SorCompare: TMergeCompareEx);
var
  TempPos : integer;
begin
  TempPos := FLeftArray.FLeft;
   while ( FLeftArray.Full ) and ( FMidArray.Full ) and ( FRightArray.Full ) do  {Main Loop}
    begin
      if SorCompare(FM3Array[FLeftArray.FLeft], FM3Array[FMidArray.FLeft]) <= 0 then
        begin
          if SorCompare(FM3Array[FLeftArray.FLeft], FM3Array[FRightArray.FLeft]) <= 0 then
            begin
              TempArray[ TempPos ] := FM3Array[ FLeftArray.FLeft ];
              FLeftArray.Next;
            end
          else
            begin
              TempArray[ TempPos ] := FM3Array[ FRightArray.FLeft ];
              FRightArray.Next;
            end;
        end
      else
        begin
          if SorCompare(FM3Array[FMidArray.FLeft], FM3Array[FRightArray.FLeft]) <= 0 then
            begin
              TempArray[ TempPos ] := FM3Array[ FMidArray.FLeft ];
              FMidArray.Next;
            end
          else
            begin
              TempArray[ TempPos ] := FM3Array[ FRightArray.FLeft ];
              FRightArray.Next;
            end;
        end;
          inc(TempPos);
    end;

   while ( FLeftArray.Full ) and ( FMidArray.Full ) do
    begin
      if SorCompare(FM3Array[FLeftArray.FLeft], FM3Array[FMidArray.FLeft]) <= 0 then
        begin
          TempArray[ TempPos ] := FM3Array[ FLeftArray.FLeft ];
          FLeftArray.Next;
        end
      else
        begin
          TempArray[ TempPos ] := FM3Array[ FMidArray.FLeft ];
          FMidArray.Next;
        end;
          inc(TempPos);
    end;

  while ( FMidArray.Full ) and ( FRightArray.Full ) do
    begin
      if SorCompare(FM3Array[FMidArray.FLeft], FM3Array[FRightArray.FLeft]) <= 0 then
        begin
          TempArray[ TempPos ] := FM3Array[ FMidArray.FLeft ];
          FMidArray.Next;
        end
      else
        begin
          TempArray[ TempPos ] := FM3Array[ FRightArray.FLeft ];
          FRightArray.Next;
        end;
          inc(TempPos);
    end;