第4回もっとAVL木で木構造を学ぼう

2009/5/25

AVLTree2.pasのソースコード

●avltree2.pas

unit AVLTree2;

interface

uses
    SysUtils, Classes, RTLConsts, avltree;

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

  TAVLTreeNode = class(TObject)
 	private
    FItemTree : TAVLTree;
  public
    ID : Integer;
    LeftChild, RightChild : TAVLTreeNode;
    Balance               : TBalance;
    property ItemTree : TAVLTree read FItemTree write FItemTree;
    constructor Create;
    destructor Destroy; override;
  end;


  TAVLTree2 = class(TObject)
  private
    FCount : integer;
    FRoot  : TAVLTreeNode;
  protected
    procedure  AddNode(var parent : TAVLTreeNode; newID : Integer; value : Pointer; var grow : Boolean);
    procedure  AdjustLeftGrow(var parent   : TAVLTreeNode);
    function   AdjustLeftCutdown(var node: TAVLTreeNode):Boolean;
    procedure  AdjustRightGrow(var parent  : TAVLTreeNode);
    function   AdjustRightCutdown(var node: TAVLTreeNode):Boolean;
    procedure  DeleteFromNode(var node : TAVLTreeNode; delID : Integer; var cutdown : Boolean);
    function   Get(Index: Integer): TAVLTree;
    procedure  InternalGet(var parent: TAVLTreeNode; index : integer; var bolFind:Boolean; var item:pointer);
    procedure  InternalDumpNodes(var parent: TAVLTreeNode; var s: string; search_algo: TDumpNodes; var depth: Integer);
    procedure  ReplaceRightMost(var targetNode, replNode : TAVLTreeNode; var cutdown : Boolean);
  public
    procedure  Add(newID : Integer; value : Pointer);
    procedure  Delete(delID : Integer);
    function   DumpNodes(search_algo:TDumpNodes):String;
    property   Count : Integer read FCount;
    property   ItemTree[Index:Integer]: TAVLTree read Get;
    destructor Destroy; override;
  end;

implementation


{ TAVLNode }

constructor TAVLTreeNode.Create;
begin
  FItemTree := TAVLTree.Create;
end;

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

  FItemTree.Free;
  inherited;
end;

{ TAVLTree }

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

//ノードの追加を再帰的に行う処理
procedure TAVLTree2.AddNode(
  var parent: TAVLTreeNode;
  newID: Integer;
  value : Pointer;
  var grow: Boolean
  );
begin
  //木の最深部まで降りた場合、そこにノードを追加する
  if (parent = nil) then
  begin
    parent := TAVLTreeNode.Create;
    parent.ID := newID;
    parent.Balance := brEqual;
    parent.ItemTree.Add(Integer(value), nil);
    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.ItemTree.Add(Integer(value), nil);
    grow := False;
    Inc(FCount);
  end;
end;

//削除時にツリーの左側が低くなった時の処理
function TAVLTree2.AdjustLeftCutdown(var node: TAVLTreeNode):Boolean;
var
  OrigRightChild, OrigGrandChild  : TAVLTreeNode;
  ChildBalance, GrandChildBalance : TBalance;
begin

  //ノードの左側が高い状態だったので、左が低くなってバランスした
  //ということは、このノードでの左右の高さは1つ低くなっている
  if (node.Balance = brLeft) then
  begin
    node.Balance := brEqual;
    result := True;
  end else

  //ノードはバランスしていたので、右が高くなる
  //全体として、左右の高さは変化しない
  if (node.Balance = brEqual) then
  begin
    node.Balance := brRight;
    result := False;
  end else

  //ノードは右側が高い状態だったので、右が2つ高くなってしまった
  begin
    OrigRightChild := node.RightChild;
    ChildBalance   := OrigRightChild.Balance;

    // 左部分木の左右の高さが等しい、または左が低い場合は、左回転
    if (ChildBalance <> brLeft) then
    begin
      node.RightChild := OrigRightChild.LeftChild;
      OrigRightChild.LeftChild := node;

      //T2とT3が同じ高さだった場合、部分木の高さは変わらない
      if (ChildBalance = brEqual) then
      begin
        node.Balance := brRight;
        OrigRightChild.Balance := brLeft;
        result := False;
      end else

      //T2よりT3が高かった場合、部分木は低くなる
      begin
        node.Balance := brEqual;
        OrigRightChild.Balance := brEqual;
        result := True;
      end;

      node := OrigRightChild;
    end else

    // 右部分木の左部分木が高い場合は、右－左回転
    // 右－左回転の場合は、必ず部分木の高さが1つ低くなる
    begin
      OrigGrandChild := OrigRightChild.LeftChild;
      GrandchildBalance := OrigGrandchild.Balance;
      OrigRightChild.LeftChild := OrigGrandChild.RightChild;
      OrigGrandChild.RightChild := OrigRightChild;
      node.RightChild := OrigGrandChild.LeftChild;
      OrigGrandChild.LeftChild := node;

      if (GrandChildBalance = brRight) then
        node.Balance := brLeft
      else
        node.Balance := brEqual;

      if (GrandChildBalance = brLeft) then
        OrigRightChild.Balance := brRight
      else
        OrigRightChild.Balance := brEqual;

      node := OrigGrandChild;
      OrigGrandChild.Balance := brEqual;

      result := True;
    end;
  end;
end;

//追加時にツリーの左側でバランスが崩れたときの処理
procedure TAVLTree2.AdjustLeftGrow(var parent: TAVLTreeNode);
var
  OrgLeftChild, OrgGrandChild : TAVLTreeNode;
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;

//削除時にツリーの右側が低くなった時の処理
function TAVLTree2.AdjustRightCutdown(var node: TAVLTreeNode):Boolean;
var
  OrigLeftChild, OrigGrandChild   : TAVLTreeNode;
  ChildBalance, GrandChildBalance : TBalance;
begin

  //ノードの右側が高い状態だったので、右が低くなってバランスした
  //ということは、このノードでの左右の高さは1つ低くなっている
  if (node.Balance = brRight) then
  begin
    node.Balance := brEqual;
    result := True;
  end else

  //ノードはバランスしていたので、左が高くなる
  //全体として、左右の高さは変化しない
  if (node.Balance = brEqual) then
  begin
    node.Balance := brLeft;
    result := False;
  end else

  //ノードは左側が高い状態だったので、左が2つ高くなってしまった
  begin
    OrigLeftChild := node.LeftChild;
    ChildBalance  := OrigLeftChild.Balance;

    // 左部分木の左右の高さが等しい、または右が低い場合は、右回転
    if (ChildBalance <> brRight) then
    begin
      node.LeftChild := OrigLeftChild.RightChild;
      OrigLeftChild.RightChild := node;

      //T2とT3が同じ高さだった場合、部分木の高さは変わらない
      if (ChildBalance = brEqual) then
      begin
        node.Balance := brLeft;
        OrigLeftChild.Balance := brRight;
        result := False;
      end else

      //T2よりT3が高かった場合、部分木は低くなる
      begin
        node.Balance := brEqual;
        OrigLeftChild.Balance := brEqual;
        result := True;
      end;

      node := OrigLeftChild;
    end else

    // 左部分木の右部分木が高い場合は、左－右回転
    // 左－右回転の場合は、必ず部分木の高さが1つ低くなる
    begin
      OrigGrandChild := OrigLeftChild.RightChild;
      GrandchildBalance := OrigGrandchild.Balance;
      OrigLeftChild.RightChild := OrigGrandChild.LeftChild;
      OrigGrandChild.LeftChild := OrigLeftChild;
      node.LeftChild := OrigGrandChild.RightChild;
      OrigGrandChild.RightChild := node;

      if (GrandChildBalance = brLeft) then
        node.Balance := brRight
      else
        node.Balance := brEqual;

      if (GrandChildBalance = brRight) then
        OrigLeftChild.Balance := brLeft
      else
        OrigLeftChild.Balance := brEqual;

      node := OrigGrandChild;
      OrigGrandChild.Balance := brEqual;

      result := True;
    end;
  end;
end;

//追加時にツリーの右側でバランスが崩れたときの処理
procedure TAVLTree2.AdjustRightGrow(var parent: TAVLTreeNode);
var
  OrgRightChild, OrgGrandChild : TAVLTreeNode;
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 TAVLTree2.Destroy;
begin
  if (FRoot <> nil) then FRoot.Free;

  inherited;
end;

//ツリーの内部からIDを引き出して、文字列で返す
function TAVLTree2.DumpNodes(search_algo:TDumpNodes): String;
var
  depth : integer;
begin
  if (FRoot = nil) then
  begin
    result := 'This tree has nothing';
    exit;
  end;

  depth := 0;
  InternalDumpNodes(FRoot, result, search_algo, depth);
end;

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

//ツリーの内部状態をダンプする処理
procedure TAVLTree2.InternalDumpNodes(var parent: TAVLTreeNode; var s: string; search_algo: TDumpNodes; var depth: Integer);
  procedure make_result;
  begin
    if (s <> '') then s := s + ', ';
    if (parent = FRoot) then s := s + '[';
    s := s + 'ID=' + IntToStr(parent.ID) + ':Count=' + IntToStr(parent.ItemTree.Count) + ':Depth=' + IntToStr(depth);
    if (parent = FRoot) then s := s + ']';

  end;
begin
  //行きがけ順はここで処理
  if (search_algo = dnPreorder) then make_result;

  if (parent.LeftChild <> nil) then
  begin
    inc(depth);
    InternalDumpNodes(parent.LeftChild, s, search_algo, depth);
    dec(depth);
  end;

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

  if (parent.RightChild <> nil) then
  begin
    inc(depth);
    InternalDumpNodes(parent.RightChild, s, search_algo, depth );
    dec(depth);
  end;

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

end;

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

// ソート木の削除時にソートを崩さずに削除する処理
procedure TAVLTree2.ReplaceRightMost(var targetNode, replNode: TAVLTreeNode;
  var cutdown: Boolean);
var
  OrigReplNode : TAVLTreeNode;
begin

  // ここが、最右端のノード
  if (replNode.RightChild = nil) then
  begin
    // replNode は、削除されるノードを置き換えるノード
    // 置き換え元のノードを保持しておく
    OrigReplNode := replNode;

    // 左側の子で置き換え元のノードを置き換える
    // LeftChild が nil　なら両方ないわけだが、結果的にnilになるのでよい
    replNode := replNode.LeftChild;

    // 削除されるノードを置き換え用ノードで置き換える
    OrigReplNode.LeftChild  := targetNode.LeftChild;
    OrigReplNode.RightChild := targetNode.RightChild;
    OrigReplNode.Balance    := targetNode.Balance;
    targetNode := OrigReplNode;

    cutdown := True;
  end else
  begin
    // 置き換え用ノードの再起探索
    ReplaceRightMost(targetNode, replNode.RightChild, cutdown);
    if (cutdown) then cutdown := AdjustRightCutdown(replNode);
  end;
end;

// Publicメソッド Delete の処理
procedure TAVLTree2.Delete(delID : Integer);
var
  cutdown : Boolean;
begin
  DeleteFromNode(FRoot, delID, cutdown);
end;

// Delete処理の本体
procedure TAVLTree2.DeleteFromNode(var node : TAVLTreeNode; delID : Integer; var cutdown : Boolean);
var
  targetNode : TAVLTreeNode;
begin
  //一番下まで来てしまったので、ターゲットはなかった
  if (node = nil) then
  begin
    Exception.CreateFmt('Not Find %d in the tree.', [delID]);
    cutdown := False;
    exit;
  end;

  // ターゲットがノードのIDより小さいので左側へ下りる
  if (delID < node.ID) then
    begin
    DeleteFromNode(node.LeftChild, delID, cutdown);
    if (cutdown=True) then cutdown := AdjustLeftCutdown(node);
  end else

  // ターゲットがノードのIDより大きいので右側へ下りる
  if (delID > node.ID) then
  begin
    DeleteFromNode(node.RightChild, delID, cutdown);
    if (cutdown=True) then cutdown := AdjustRightCutdown(node);

  end else

  // ターゲットとノードのIDが一致した場合
  begin
    targetNode := node;

    // ソート木でのノードの削除処理を実行する

    // ノードの右には子がないので、左の子を自分の位置と入れ替える
    if (node.RightChild = nil) then
    begin
      // この操作で、木の高さは1つ低くなる
      node := node.LeftChild;
      cutdown := True;
    end else 

    // ノードには左の子がないので、右の子を自分の位置と入れ替える
    if (node.LeftChild = nil) then
    begin
      // この操作で、木の高さは1つ低くなる
      node := node.RightChild;
      cutdown := True;

    // ノードには子が両側にある
    end else 
    begin
      ReplaceRightmost(node, node.LeftChild, cutdown);
      if (cutdown=True) then cutdown := AdjustLeftCutdown(node);
    end;

    // Free the target node.
    targetNode.LeftChild := nil;
    targetNode.RightChild := nil;
    FCount := FCount - targetNode.ItemTree.Count;
    targetNode.Free;
  end;
end;

end.

Index
もっとAVL木で木構造を学ぼう
	Page1 AVL木からの節点の削除左回転でバランスを回復させる
	Page2 右－左回転でバランスを回復させる AVLTreeの拡張 AVL木はいろいろなところで使われている
	Appendix1 AVLTree2.pasのソースコード
	Appendix2 avllisttree.pasのソースコード

Delphiアルゴリズムトレーニング

　Coding Edgeお勧め記事

	いまさらアルゴリズムを学ぶ意味コーディングに役立つ！アルゴリズムの基本（1）　コンピュータに「3の倍数と3の付く数字」を判断させるにはどうしたらいいか。発想力を鍛えよう
	Zope 3の魅力に迫る Zope 3とは何ぞや？（1）　Pythonで書かれたWebアプリケーションフレームワーク「Zope 3」。ほかのソフトウェアとは一体何が違っているのか？
	貧弱環境プログラミングのススメ柴田淳のコーディング天国　高性能なIT機器に囲まれた環境でコンピュータの動作原理に触れることは可能だろうか。貧弱なPC上にビットマップの直線をどうやって引く？
	Haskellプログラミングの楽しみ方のんびりHaskell（1）　関数型言語に分類されるHaskell。C言語などの手続き型言語とまったく異なるプログラミングの世界に踏み出してみよう
	ちょっと変わったLisp入門 Gaucheでメタプログラミング（1）　Lispの一種であるScheme。いくつかある処理系の中でも気軽にスクリプトを書けるGaucheでLispの世界を体験してみよう
	more

　　Coding Edgeフォーラム

フィード　 2.0／1.0／0.91

Coding Edge フォーラム新着記事

プログラムの実行はどのようにして行われるのか、Linuxカーネルのコードから探る （2017/7/20）
　C言語の「Hello World！」プログラムで使われる、「printf()」「main()」関数の中身を、デバッガによる解析と逆アセンブル、ソースコード読解などのさまざまな側面から探る連載。最終回は、Linuxカーネルの中では、プログラムの起動時にはどのような処理が行われているのかを探る
エンジニアならC言語プログラムの終わりに呼び出されるexit()の中身分かってますよね？ （2017/7/13）
　C言語の「Hello World！」プログラムで使われる、「printf()」「main()」関数の中身を、デバッガによる解析と逆アセンブル、ソースコード読解などのさまざまな側面から探る連載。今回は、プログラムの終わりに呼び出されるexit()の中身を探る
VBAにおけるFileDialog操作の基本＆ドライブの空き容量、ファイルのサイズやタイムスタンプの取得方法 （2017/7/10）
　指定したドライブの空き容量、ファイルのタイムスタンプや属性を取得する方法、FileDialog／エクスプローラー操作の基本を紹介します
さらば残業！　面倒くさいエクセル業務を楽にする「Excel VBA」とは （2017/7/6）
　日頃発生する“面倒くさい業務”。簡単なプログラミングで効率化できる可能性がある。本稿では、業務で使うことが多い「Microsoft Excel」で使えるVBAを紹介する。※ショートカットキー、アクセスキーの解説あり