极快的正整数排序函数

实现原理: 对比二进制位.

unit　Unit1;

interface

uses
　Windows,　Messages,　SysUtils,　Variants,　Classes,　Graphics,　Controls,　Forms,
　Dialogs,　StdCtrls;

type
　TForm1　=　class(TForm)
　　Button1:　TButton;
　　Memo1:　TMemo;
　　procedure　Button1Click(Sender:　TObject);
　　procedure　FormCreate(Sender:　TObject);
　end;

var
　Form1:　TForm1;

implementation

{$R　*.dfm}

type
　TIntArr　=　array　of　Integer;

{极快的正整数排序函数}
procedure　IntSort(arr:TIntArr;　low:Integer=0;　high:Integer=-1;　k:Cardinal=$80000000;　c:Cardinal=1);
var
　i,j,x:　Integer;
begin
　if　high　=　-1　then　high　:=　Length(arr)　-1;
　i　:=　low;
　j　:=　high;
　while　(i　<　j)　do
　begin
　　while　(arr[j]　and　k　<>　0)　and　(i　<　j)　do　Dec(j);
　　while　(arr[i]　and　k　=　0)　and　(i　<　j)　do　Inc(i);
　　if　i　<　j　then
　　begin
　　　x　:=　arr[j];
　　　arr[j]　:=　arr[i];
　　　arr[i]　:=　x;
　　end　else　begin
　　　if　arr[j]　and　k　<>　0　then　Dec(i)　else　Inc(j);
　　　Break;
　　end;
　end;
　if　k　>　c　then
　begin
　　if　low　<　i　then　IntSort(arr,　low,　i,　k　div　2);
　　if　j　<　high　then　IntSort(arr,　j,　high,　k　div　2);
　end;
end;

{测试}
procedure　TForm1.Button1Click(Sender:　TObject);
var
　MyArr:　TIntArr;
　i:　Integer;
　t:　Int64;
begin
　SetLength(MyArr,　MAXWORD);
　for　i　:=　Low(MyArr)　to　High(MyArr)　do　MyArr[i]　:=　Random(MaxInt);
　
　t　:=　GetTickCount;
　
　IntSort(MyArr);　//调用排序函数
　
　Text　:=　IntToStr(GetTickCount　-　t);

　Memo1.Clear;
　for　i　:=　0　to　Length(MyArr)-1　do
　begin
　　if　i　mod　1000　=　0　then
　　　Memo1.Lines.Add(IntToStr(MyArr[i]));
　end;
end;

procedure　TForm1.FormCreate(Sender:　TObject);
begin
　Memo1.Clear;
　Memo1.Align　:=　alLeft;
　Memo1.ScrollBars　:=　ssVertical;
end;

end.

程序员特区

http://coderarea.net/html/bianchengyuyan/DELPHIyuyan/DELPHIzonghe/2009/0506/93046.html