極めて速い正の整数ソート関数

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.