第3回 AVL木で木構造を学ぼう

unit avltree;

interface

uses
    SysUtils, Classes, RTLConsts;

type
  TBalance = (brLeft, brEqual, brRight);
  TDumpNodes = (dnPreorder, dnInorder, dnPostorder);
  TAVLNode = class;

  TAVLNode = class(TObject)
 	private
    FItem : Pointer;
  public
    ID : Integer;
    LeftChild, RightChild : TAVLNode;
    Balance               : TBalance;
    property Item : Pointer read FItem write FItem;
    constructor Create;
    destructor Destroy; override;
  end;

  TAVLTree = class(TObject)
  private
    FCount : integer;
    FRoot  : TAVLNode;
  protected
    procedure  AddNode(var parent : TAVLNode; newID : Integer; value : Pointer; var grow : Boolean);
    procedure  AdjustLeftGrow(var parent : TAVLNode);
    procedure  AdjustRightGrow(var parent : TAVLNode);
    function   Get(Index: Integer): Pointer;
    function   InternalGet(var parent: TAVLNode; index : integer; var bolFind:Boolean):pointer;
    procedure  InternalDumpNodes(var parent : TAVLNode; var s : string; search_algo:TDumpNodes);
  public
    procedure  Add(newID : Integer; value : Pointer);
    function   DumpNodes(search_algo:TDumpNodes):String;
    property   Count : Integer read FCount;
    property   Items[Index: Integer]: Pointer read Get; default;
    destructor Destroy; override;
  end;

implementation


{ TAVLNode }

constructor TAVLNode.Create;
begin
  //
end;

destructor TAVLNode.Destroy;
begin
  if (LeftChild <> nil) then LeftChild.Free;
  if (RightChild <> nil) then RightChild.Free;

  inherited;
end;

{ TAVLTree }

//ツリーに値を追加する処理
procedure TAVLTree.Add(newID: Integer; value: Pointer);
var
  grow : Boolean;
begin
  //Addメソッドは、まずRootから値を追加する先を探索する
  grow := False;
  AddNode(FRoot, newID, value, grow);
end;

//ノードの追加を再帰的に行う処理
procedure TAVLTree.AddNode(
  var parent: TAVLNode;
  newID: Integer;
  value : Pointer;
  var grow: Boolean
  );
begin
  //木の最深部まで降りた場合、そこにノードを追加する
  if (parent = nil) then
  begin
    parent := TAVLNode.Create;
    parent.ID := newID;
    parent.Balance := brEqual;
    parent.Item := value;
    grow := True;
    Inc(FCount);
    exit;
  end;

  //newIDが現在の節点のIDより小さい時の処理
  //左側に下っていく
  if (newID < parent.ID) then
  begin
    //左側へ節点を追加する
    AddNode(parent.LeftChild, newID, value, grow);

    //木が成長した＝高さが変わった場合、grow がTrueで返ってくる
    //Falseの場合、バランス調整は不要
    if (grow = False) then exit;

    if (parent.Balance = brRight) then
    begin
      //元々は右側の高さが大きかった場合
      //左に新しい節点が追加されたので、これでバランスした
      parent.Balance := brEqual;

      //上のノードには、深度が変化していないと通知する
      grow := False;
    end else if (parent.Balance = brEqual) then
    begin
      //元々がバランスしていたので、左側に節点が追加されたため
      //左側が深い状態になった
      parent.Balance := brLeft;
    end else
    begin
      //元々左側の高さが大きかったので、
      //左側に節点が追加されたため、バランス調整が必要となった
      AdjustLeftGrow(parent);
      grow := False;
    end;

  end else
  //newIDが現在の節点のIDより大きい場合の処理
  //右側に下っていく
  if (newID > parent.ID) then
  begin
    //右側に節点を追加する
    AddNode(parent.RightChild, newID, value,  grow);

    //木が成長した＝高さが変わった場合、grow がTrueで返ってくる
    //Falseの場合、バランス調整は不要
    if (grow = False) then exit;

    if (parent.Balance = brLeft) then
    begin
      //元々は左側の高さが大きかった場合
      //右に新しい節点が追加されたので、これでバランスした　
      parent.Balance := brEqual;
      grow := False;
    end else
    if (parent.Balance = brEqual) then
    begin
      //元々がバランスしていたので、右側に節点が追加されたため
      //右側が深い状態になった
      parent.Balance := brRight;
    end else
    begin
      //元々右側の高さが大きかったので
      //右側に節点が追加されたため、バランス調整が必要になった
      AdjustRightGrow(parent);
      grow := False;
    end;
  end else
  begin
    //newIDと現在の節点のIDが同じ場合は、ノードの値を書き換える
    parent.Item := value;
    grow := False;
  end;
end;

//ツリーの左側でバランスが崩れたときの処理
procedure TAVLTree.AdjustLeftGrow(var parent: TAVLNode);
var
  OrgLeftChild, OrgGrandChild : TAVLNode;
begin
  OrgLeftChild := parent.LeftChild;
  if (OrgLeftChild.Balance = brLeft) then
    begin
      //左側の左側でバランスが崩れたので、右回転する
      parent.LeftChild := OrgLeftChild.RightChild;
      OrgLeftChild.RightChild := parent;
      parent.Balance := brEqual;
      parent := OrgLeftChild;
    end else
    begin
      //左側の右側でバランスが崩れたので、左−右回転する
      OrgGrandchild := OrgLeftchild.RightChild;
      OrgLeftchild.RightChild := OrgGrandChild.LeftChild;
      OrgGrandchild.LeftChild := OrgLeftchild;
      parent.LeftChild := OrgGrandChild.RightChild;
      OrgGrandChild.RightChild := parent;
      if (OrgGrandChild.Balance = brLeft) then
        parent.Balance := brRight
      else
        parent.Balance := brEqual;
      if (OrgGrandchild.Balance = brRight) then
        OrgLeftchild.Balance := brLeft
       else
        OrgLeftchild.Balance := brEqual;
       parent := OrgGrandChild;
    end;
    parent.Balance := brEqual;
end;

//ツリーの右側でバランスが崩れたときの処理
procedure TAVLTree.AdjustRightGrow(var parent: TAVLNode);
var
  OrgRightChild, OrgGrandChild : TAVLNode;
begin
  OrgRightChild := parent.RightChild;
  if (OrgRightChild.Balance = brRight) then
    begin
      //右側の右側でバランスが崩れたので、左回転する
      parent.RightChild := OrgRightChild.LeftChild;
      OrgRightChild.LeftChild := parent;
      parent.Balance := brEqual;
      parent := OrgRightChild;
    end else
    begin
      //右側の左側でバランスが崩れたので、右−左回転する
      OrgGrandchild := OrgRightchild.LeftChild;
      OrgRightchild.LeftChild := OrgGrandChild.RightChild;
      OrgGrandChild.RightChild := OrgRightChild;
      parent.RightChild := OrgGrandChild.LeftChild;
      OrgGrandChild.LeftChild := parent;
      if (OrgGrandChild.Balance = brRight) then
        parent.Balance := brLeft
      else
        parent.Balance := brEqual;
      if (OrgGrandchild.Balance = brLeft) then
        OrgRightChild.Balance := brRight
       else
        OrgRightChild.Balance := brEqual;
       parent := OrgGrandChild;
    end;
    parent.Balance := brEqual;
end;

destructor TAVLTree.Destroy;
begin
  if (FRoot <> nil) then FRoot.Free;

  inherited;
end;

//ツリーの内部からIDを引き出して、文字列で返す
function TAVLTree.DumpNodes(search_algo:TDumpNodes): String;
begin
  InternalDumpNodes(FRoot, result, search_algo);
end;

//ツリーのインデックス参照による値の取得
function TAVLTree.Get(Index: Integer): Pointer;
var
  bolFind:Boolean;
begin
  Result := InternalGet(FRoot, Index, bolFind);
  if (bolFind = False) then raise EListError.Createfmt(LoadResString(@SListIndexError), [Index]);
end;

//ツリーの内部状態をダンプする処理
procedure TAVLTree.InternalDumpNodes(var parent: TAVLNode; var s: string; search_algo:TDumpNodes);
  procedure make_result;
  begin
    if (s <> '') then s := s + ', ';
    s := s + 'ID=' + IntToStr(parent.ID);
  end;
begin
  //行きがけ順はここで処理
  if (search_algo = dnPreorder) then make_result;

  if (parent.LeftChild <> nil) then InternalDumpNodes(parent.LeftChild, s, search_algo);

  //通りがかけ順はここで処理
  if (search_algo = dnInorder) then make_result;

  if (parent.RightChild <> nil) then InternalDumpNodes(parent.RightChild, s, search_algo);

  //帰りがけ順はここで処理
  if (search_algo = dnPostorder) then make_result;
end;

//ツリーからのデータの取得を再帰的に行う処理
function TAVLTree.InternalGet(var parent: TAVLNode; index : integer; var bolFind:Boolean): pointer;
var
  tmp:Pointer;
begin
  if (parent.ID = Index) then
  begin
    result := parent.item;
    bolFind := True;
    exit;
  end;
  if (parent.LeftChild <> nil) then
  begin
    tmp := InternalGet(parent.LeftChild, index, bolFind);
    if (bolFind = True) then
    begin
      result := tmp;
      exit;
    end;
  end;
  if (parent.RightChild <> nil) then
  begin
    tmp := InternalGet(parent.RightChild, index, bolFind);
    if (bolFind = True) then
    begin
      result := tmp;
      exit;
    end;
  end;
end;

end.