mwfixedrecsort.pas

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

  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;

{Non-recursive Mergesort.
 Very fast, if enough memory available.
 The number of comparisions used is nearly optimal, about 3/4 of QuickSort.
 If comparision plays a very more important role than exchangement,
 it outperforms QuickSort in any case.
 ( Large keys in pointer arrays, for example text with few short lines. )
 From all Algoritms with O(N lg N) it's the only stable, meaning it lefts
 equal keys in the order of input. This may be important in some cases. }
procedure TM3Array.MergeSort(SorCompare: TMergeCompare);
var
  a, b, c, N, todo: LongInt;
begin
  ReallocMem(TempArray, FCount * 4);
  FLeftArray:= TSub3Array.Create(FCount -1);
  FMidArray:= TSub3Array.Create(FCount -1);
  FRightArray:= TSub3Array.Create(FCount -1);
  N:= 1;
  repeat
      todo:= 0;
      repeat
        a:= todo;
        b:= a +N;
        c:= b +N;
        todo:= C +N;
        FLeftArray.Init(a, b -1);
        FMidArray.Init(b, c -1);
        FRightArray.Init(c, todo -1);
        Merge(SorCompare);
      until todo >= Fcount;
      SwapArray:= FM3Array; {Alternating use of the arrays.}
      FM3Array:= TempArray;
      TempArray:= SwapArray;
      N:= N+ N +N;
    until N >= Fcount;
    FLeftArray.Free;
    FMidArray.Free;
    FRightArray.Free;
    ReallocMem(TempArray, 0);
end;  { MergeSort }

procedure TM3Array.MergeSortEx(SorCompare: TMergeCompareEx);
var
  a, b, c, N, todo: LongInt;
begin
  ReallocMem(TempArray, FCount * 4);
  FLeftArray:= TSub3Array.Create(FCount -1);
  FMidArray:= TSub3Array.Create(FCount -1);
  FRightArray:= TSub3Array.Create(FCount -1);
  N:= 1;
  repeat
      todo:= 0;
      repeat
        a:= todo;
        b:= a +N;
        c:= b +N;
        todo:= C +N;
        FLeftArray.Init(a, b -1);
        FMidArray.Init(b, c -1);
        FRightArray.Init(c, todo -1);
        MergeEx(SorCompare);
      until todo >= Fcount;
      SwapArray:= FM3Array; {Alternating use of the arrays.}
      FM3Array:= TempArray;
      TempArray:= SwapArray;
      N:= N+ N +N;
    until N >= Fcount;
    FLeftArray.Free;
    FMidArray.Free;
    FRightArray.Free;
    ReallocMem(TempArray, 0);
end;  { MergeSort }

constructor TmIOBuffer.create(FileName: string; DataLen, BuffSize: Integer);
var
	fHandle: Integer;
begin
	inherited create;
	FDataLen:= DataLen;
	fFileName:= FileName;
	if not FileExists(FileName) then
	begin
		fHandle:= FileCreate(FileName);
		FileClose(fHandle);
	end;
	fBufferSize:= BuffSize;
	FRecCount:= BuffSize Div DataLen;
	fBufferSize:= DWORD(DataLen) * FRecCount;
	AssignFile(fBuffFile, FileName);
	Reset(fBuffFile, 1);
  fSize:= FileSize(fBuffFile);
  fNeedFill:= True;
  fEof:= False;
  fFileEof:= False;
  AllocBuffer(fBufferSize);
  fBufferPos:= 0;
end;  { create }

destructor TmIOBuffer.destroy;
begin
  ReallocMem(fBuffer, 0);
  CloseBuffFile;
  inherited destroy;
end;  { destroy }

procedure TmIOBuffer.AllocBuffer(NewValue:Longint);
begin
  fFilledSize:= fBufferSize;
  ReallocMem(fBuffer, fBufferSize);
end; { SetBufferSize }

procedure TmIOBuffer.FillBuffer;
var
  Readed: LongInt;
begin
  BlockRead(fBuffFile, fBuffer^, fBufferSize, Readed);
  if FilePos(FBuffFile) = FSize then fFileEof:= True;
  fBufferPos:= 0;
  fFilledSize:= Readed;
  fNeedFill:= False;
end;   { FillBuffer }

function TmIOBuffer.ReadData:Pointer;
begin
  fEof:= False;
  if fNeedFill then FillBuffer;
  Result:= Pointer(Integer(fBuffer) + fBufferPos);
  inc(fBufferPos, fDataLen);
  if fBufferPos >= fFilledSize then
  begin
    fNeedFill:= True;
    if FFileEof then FEof:= True;
  end;
end;   { ReadData }

procedure TmIOBuffer.WriteData(Var NewData);
var
  Pos: LongInt;
begin
  if (fBufferPos >= 0) and (Pointer(NewData) <> nil) then
  begin
    Pos := fBufferPos + fDataLen;
    if Pos > 0 then
    begin
      if Pos >= FBufferSize then
        begin
           FlushBuffer;
        end;
      Move(NewData, Pointer(LongInt(fBuffer) + fBufferPos)^, fDataLen);
      inc(fBufferPos, fDataLen);
    end;
  end;
end;  { WriteData }

procedure TmIOBuffer.FlushBuffer;
var
  Written: LongInt;
begin
  BlockWrite(fBuffFile, fBuffer^, fBufferPos, Written);
  fBufferPos:= 0;
end;  { FlushBuffer }

procedure TmIOBuffer.CloseBuffFile;
begin
  CloseFile(fBuffFile);
end;  { CloseBuffFile }

procedure TmIOBuffer.DeleteBuffFile;
begin
  SysUtils.DeleteFile(fFileName);
end;  { DeleteBuffFile }

constructor TTempFile.Create;
begin
  inherited Create;
   fFull:= False;
end;  { Create }

procedure TTempFile.Init(FileName: String);
begin
  fFull:= False;
  fFileName:= FileName;
  if fFileName <> '' then
    begin
      Reader:= TmIOBuffer.create(fFileName, FRecLen, fBuffersSize);
      if not Reader.Eof then
        begin
          fLeft:= Reader.ReadData;
          fFull:= True;
        end
      else
        begin
          Reader.Free;
          SysUtils.DeleteFile(fFileName);
          fFileName:= '';
        end;
    end;
end; { Init }

procedure TTempFile.Next;
begin
  if not Reader.Eof then
    begin
      fLeft:= Reader.ReadData;
      fFull:= True;
    end
  else
    begin
      fFull:= False;
      if fFileName <> '' then
      begin
        Reader.Free;
        SysUtils.DeleteFile(fFileName);
        fFileName:= '';
      end;
    end
end;  { Next }

destructor TTempFile.Destroy;
begin
  if fFileName <> '' then
  begin
    Reader.Free;
    SysUtils.DeleteFile(fFileName);
  end;
  inherited Destroy;
end;  { Destroy }


constructor TMergeFile.Create(InList: TStringList);
begin
  inherited Create;
  fInList:= InList;
end;  { Create }

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

procedure TMergeFile.FileMerge(MergeCompare: TMergeCompare);
begin

  while ( FFileOne.Full ) and ( FFileTwo.Full ) and ( FFileThree.Full ) do
    begin
      if MergeCompare(FFileOne.FLeft, FFileTwo.FLeft) <= 0 then
        begin
          if MergeCompare(FFileOne.FLeft, FFileThree.FLeft) <= 0 then
            begin
              Writer.WriteData(FFileOne.fLeft^);
              FFileOne.Next;
            end
          else
            begin
              Writer.WriteData(FFileThree.fLeft^);
              FFileThree.Next;
            end;
        end
      else
        begin
          if MergeCompare(FFileTwo.FLeft, FFileThree.FLeft) <= 0 then
            begin
              Writer.WriteData(FFileTwo.fLeft^);
              FFileTwo.Next;
            end
          else
            begin
              Writer.WriteData(FFileThree.fLeft^);
              FFileThree.Next;
            end;
        end;
    end;

  while ( FFileOne.Full ) and ( FFileTwo.Full ) do
    begin
      if MergeCompare(FFileOne.FLeft, FFileTwo.FLeft) <= 0 then
        begin
          Writer.WriteData(FFileOne.fLeft^);
          FFileOne.Next;
        end
      else
        begin
          Writer.WriteData(FFileTwo.fLeft^);
          FFileTwo.Next;
        end;
    end;

  while ( FFileOne.Full ) and ( FFileThree.Full ) do
    begin
      if MergeCompare(FFileOne.FLeft, FFileThree.FLeft) <= 0 then
        begin
          Writer.WriteData(FFileOne.fLeft^);
          FFileOne.Next;
        end
      else
        begin
          Writer.WriteData(FFileThree.fLeft^);
          FFileThree.Next;
        end;
    end;

  while ( FFileTwo.Full ) and ( FFileThree.Full ) do
    begin
      if MergeCompare(FFileTwo.FLeft, FFileThree.FLeft) <= 0 then
        begin
          Writer.WriteData(FFileTwo.fLeft^);
          FFileTwo.Next;
        end
      else
        begin
          Writer.WriteData(FFileThree.fLeft^);
          FFileThree.Next;
        end;
    end;

  while FFileOne.Full do    { Write Rest of First SubFile }
    begin
      Writer.WriteData(FFileOne.fLeft^);
      FFileOne.Next;
    end;

  while FFileTwo.Full do    { Write Rest of Second SubFile }
    begin
      Writer.WriteData(FFileTwo.fLeft^);
      FFileTwo.Next;
    end;

  while FFileThree.Full do   { Write Rest of Third SubFile }
    begin
      Writer.WriteData(FFileThree.fLeft^);
      FFileThree.Next;
    end;

end; { FileMerge }

procedure TMergeFile.MergeSort(MergeCompare: TMergeCompare);
var
  a, b, c: String;
  N, todo: LongInt;
begin
  fOutList:= TStringList.Create;
  fOutList.Clear;
  todo:= 0;
  N:= fInList.Count;
  fFileOne:= TTempFile.Create;
  fFileTwo:= TTempFile.Create;
  fFileThree:= TTempFile.Create;
  while fInList.Count > 1 do
  begin
    while todo < fInList.Count do
    begin
      fFileName:= 'Temp' + IntToStr(N);
      inc(N);
      Writer:= TmIOBuffer.create(fFileName, fRecLen, fBuffersSize*3);
      fOutList.Add(fFileName);
      a:= fInList.Strings[todo]; inc(todo);
      if todo < fInList.Count then begin b:= fInList.Strings[todo]; inc(todo) end else b:= '';
      if todo < fInList.Count then begin c:= fInList.Strings[todo]; inc(todo) end else c:= '';
      FFileOne.Init(a);
      FFileTwo.Init(b);
      FFileThree.Init(c);
      FileMerge(MergeCompare);
      Writer.FlushBuffer;
      Writer.Free;
      if todo = fInList.Count -1 then
        begin
          fOutList.Add(fInList.Strings[todo]);
          inc(todo);
        end;
    end;
      todo:= 0;
      TempList:= fInList;
      fInList:= fOutList;
      fOutList:= TempList;
      fOutList.Clear;
  end;
    fFileOne.Free;
    fFileTwo.Free;
    fFileThree.Free;
    fOutList.Free
end;  { MergeSort }

constructor TFixRecSort.Create(RecLen: LongInt);
begin
  inherited Create;
  FRecLen:= RecLen;
  fFileName:= '';
  FMaxLines := 60000;
  FUseMergesort:= True;
end;  { Create }

procedure TFixRecSort.Init(FileName: String);
begin
  fFileName:= FileName;
  fTempFileList:= TStringList.Create;
end;

function TFixRecSort.GetMaxMem:LongInt;
begin
  Result:= fMaxMem;
end;   { GetMaxMem }

procedure TFixRecSort.SetMaxMem(value:LongInt);
var
  RecLenPlus, CountRec: Integer;
begin
  if Value < 100000 then Value:= 100000;
  fBuffersSize:= value div 6;
  RecLenPlus:= FRecLen +8;
  CountRec:= fBuffersSize div RecLenPlus;
  fBuffersSize:= CountRec *FRecLen;
  fMaxMem:= Value;
end;  { SetMaxMem }

procedure TFixRecSort.Start(Compare: TMergeCompare);
var
  TempFileName, BackFileName, InFileName: String;
  I, K: Integer;
begin
  FCompare:= Compare;
  I:= 0;
  InFileName:= fFileName;
  BackFileName:= ChangeFileExt(fFileName, '.bak');
  if FileExists(BackFileName) then DeleteFile(PChar(BackFileName));
  Reader:= TmIOBuffer.create(FFileName, fRecLen, fBuffersSize *5);
  while not Reader.Eof do
  begin
    fMerArray:= TM3Array.Create;
    TempFileName:= 'Temp' + IntToStr(I);
    fTempFileList.Add(TempFileName);
    Writer:= TmIOBuffer.create(TempFileName, fRecLen, fBuffersSize);
    inc(I);
		while (fMerArray.Count < fMaxLines) and (DWORD(fMerArray.Count) <= Reader.RecCount) and (not Reader.Eof) do
    begin
      fMerArray.Add(Reader.ReadData);
    end;        { while }
    if UseMergesort then fMerArray.MergeSort(fCompare)
    else fMerArray.QuickSort(fCompare);
    for K := 0 to  fMerArray.Count -1 do       { Iterate }
    begin
      Writer.WriteData(fMerArray[K]^);
    end;        { for }
    Writer.FlushBuffer;
    Writer.Free;
    fMerArray.Free;
  end;        { while }
  Reader.Free;
  if fTempFileList.Count > 1 then
  begin
    MergeFile:= TMergeFile.Create(fTempFileList);
    MergeFile.MergeSort(fCompare);
    RenameFile(InFileName, BackFileName);
    RenameFile(MergeFile.FileName, FFileName);
    MergeFile.Free;
  end else
  begin
    RenameFile(InFileName, BackFileName);
    RenameFile(TempFileName, FFileName);
  end;
end;  { Start }

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

end.