# 极快的正整数排序函数

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
end;
end;

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

end.


posted on 2009-05-01 01:22  万一  阅读(...)  评论(...编辑  收藏