Treesort

[Blup]

Delphi-Quellcode:

unit Treesort;

interface

uses
  Types;

function Sort(const AItems: TIntegerDynArray): TIntegerDynArray;

implementation

type
  TTreeItem = record
    Value: Integer;
    Index: Integer;
    class function New(const AValue, AIndex: Integer): TTreeItem; static;
    class function Min(const a, b: TTreeItem): TTreeItem; static;
    procedure Clear;
    function IsNull: Boolean;
  end;

class function TTreeItem.New(const AValue, AIndex: Integer): TTreeItem;
begin
  Result.Value := AValue;
  Result.Index := AIndex;
end;

class function TTreeItem.Min(const a, b: TTreeItem): TTreeItem;
begin
  if b.IsNull then
    Result := a
  else if a.IsNull then
    Result := b
  else if a.Value <= b.Value then
    Result := a
  else
    Result := b;
end;

procedure TTreeItem.Clear;
begin
  Value := 0;
  Index := 0;
end;

function TTreeItem.IsNull: Boolean;
begin
  Result := (Value = 0) and (Index = 0);
end;

function CalcDiv2(var AValue: Integer): Boolean;
begin
  AValue := (AValue div 2);
  Result := (AValue > 0);
end;

function Sort(const AItems: TIntegerDynArray): TIntegerDynArray;
var
  m: array of TTreeItem;
  n, i, j: Integer;
begin
  n := Length(AItems);
  SetLength(m, n * 2);
  {erste Hälfte initialisieren - eigentlich nicht notwendig}
  for i := 0 to n - 1 do
    m[i].Clear;
  {zweite Hälfte des Arrays verweist auf die unsortierten Elemente}
  for i := 0 to n - 1 do
    m[n + i] := TTreeItem.New(AItems[i], n + i);
  {erste Hälfte des Array durch Vergleich}
  for i := n - 1 downto 1 do
    m[i] := TTreeItem.Min(m[2 * i], m[2 * i + 1]);

  SetLength(Result, n);
  for j := 0 to n - 1 do
  begin
    Result[j] := m[1].Value;
    i := m[1].Index;
    m[i].Clear;
    while CalcDiv2(i) do
      m[i] := TTreeItem.Min(m[2 * i], m[2 * i + 1]);
  end;
end;

end.