radixsort.pas

来自「用delphi实现的一些排序算法」· PAS 代码 · 共 206 行

{-----------------------------------------------------------------------------



  作者：hujiping 2006.05.30
  备注：
  审核：RadixSort 基数排序

  Copyright (c) 1994-2006 GrandSoft Corporation

-----------------------------------------------------------------------------}
unit RadixSort;

interface

uses
  Classes;

type
  PNode = ^TNode;
  TNode = record
    Data: Pointer;
    Next: PNode;
  end;

  TRadixSort = class
  private
    FHead: PNode;
    FTail: PNode;
    FNodeArr: array of PNode;
    ENodeArr: array of PNode;
    procedure FreeNodes;
    procedure RadixSortA(ASequence: Integer; ARadix: Integer; ADigit: Integer);
  public
    destructor Destroy; override;
    procedure RadixSort(AList: TList; ARadix: Integer; ADigit: Integer);

  end;
implementation

uses SysUtils;

{ TRadixSort }
destructor TRadixSort.Destroy;
begin
  FreeNodes;
  inherited;
end;

{-----------------------------------------------------------------------------
  作者：hujp 2006.05.31
  参数：
  返回：
  功能：释放分配的内存
-----------------------------------------------------------------------------}
procedure TRadixSort.FreeNodes;
var
  pNext: PNode;
begin
  if FHead = nil then Exit;
  pNext := FHead.Next;
  while FHead <> nil do
  begin
    Dispose(FHead);
    FHead := pNext;
    if FHead <> nil then
      pNext := FHead.Next
  end;
end;

{-----------------------------------------------------------------------------
  作者：hujp 2006.05.31
  参数：
  返回：
  功能：基数排序
-----------------------------------------------------------------------------}
procedure TRadixSort.RadixSort(AList: TList; ARadix, ADigit: Integer);

  {-----------------------------------------------------------------------------
    作者：hujp 2006.05.31
    参数：
    返回：
    功能：根据AList建立队列
  -----------------------------------------------------------------------------}
  procedure BuildQueue;
  var
    I: Integer;
    Node, NextNode: PNode;
  begin
    if AList.Count = 0 then Exit;
    New(FHead);
    FHead.Data := AList.Items[0];
    Node := FHead;
    for I := 1 to AList.Count - 1 do
    begin
      NextNode := AllocMem(Sizeof(TNode));
      NextNode.Data := AList.Items[I];
      Node.Next := NextNode;
      Node := NextNode;
    end;
    FTail := Node;
  end;

  {-----------------------------------------------------------------------------
    作者：hujp 2006.05.31
    参数：
    返回：
    功能：根据队列返回AList
  -----------------------------------------------------------------------------}
  procedure OutputQueue;
  var
    Node: PNode;
  begin
    AList.Clear;
    Node := FHead;
    while Node <> nil do
    begin
      AList.Add(Node.Data);
      Node := Node.Next;
    end;
  end;

var
  I: Integer;
begin
  SetLength(FNodeArr, ARadix);
  SetLength(ENodeArr, ARadix);
  BuildQueue;
  for I := ADigit downto 1 do
    RadixSortA(I, ARadix, ADigit);
  OutputQueue;
end;

{-----------------------------------------------------------------------------
  作者：hujp 2006.05.31
  参数：
  返回：
  功能：对第ASequence位进行排序
-----------------------------------------------------------------------------}
procedure TRadixSort.RadixSortA(ASequence, ARadix, ADigit: Integer);

  {-----------------------------------------------------------------------------
    作者：hujiping 2006.05.30
    参数：
    返回：
    功能：得到ANode中Data的第ASequence位所对应的数字(0<= Result < Radix)
  -----------------------------------------------------------------------------}
  function GetDigitNumber(ASequence: Integer; ADigit: Integer; ANode: PNode): Integer;
  var
    I: Integer;
    sNum: string;
    sZeros: string;
  begin
    sNum := IntToStr(Integer(ANode.Data));
    //位数不足，在前面补0
    if Length(sNum) < ADigit then
    begin
      SetLength(sZeros, ADigit - Length(sNum));
      for I := 1 to ADigit - Length(sNum) do
        sZeros[I] := '0';
    end;
    sNum := sZeros + sNum;
    Result := StrToInt(sNum[ASequence]);
  end;

var
  I: Integer;
  CircleNode: PNode;
  nDigitNum: Integer;
begin
  //清除辅助数组
  for I := 0 to ARadix - 1 do
    FNodeArr[I] := nil;
  //把主队列中节点加入到辅助数组中
  CircleNode := FHead;
  while CircleNode <> nil do
  begin
    nDigitNum := GetDigitNumber(ASequence, ADigit, CircleNode);
    if FNodeArr[nDigitNum] = nil then
      FNodeArr[nDigitNum] := CircleNode
    else
      ENodeArr[nDigitNum].Next := CircleNode;
    ENodeArr[nDigitNum] := CircleNode;
    CircleNode := CircleNode.Next;
  end;
  //把辅助数组中节点按序加回到主队列中
  I := 0;
  while FNodeArr[I] = nil do
    Inc(I);
  FHead := FNodeArr[I];
  FTail := ENodeArr[I];
  FNodeArr[I] := nil;
  for nDigitNum := I + 1 to ARadix - 1 do
  begin
    if FNodeArr[nDigitNum] <> nil then
    begin
      FTail.Next := FNodeArr[nDigitNum];
      FTail := ENodeArr[nDigitNum];
      FNodeArr[nDigitNum] := nil;
    end;
  end;
  FTail.Next := nil;
end;

end.