快速的正整数排序

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

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.