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

第5回 RDBMSで使われるB木を学ぼう

はやしつとむ
アナハイムテクノロジー株式会社

2009/6/22

icon BTree.pasのソースコード

●BTreeのソースコード(BTree.pas)
unit BTree;

interface

uses
  SysUtils, Classes, StrUtils, Dialogs;

type

  TKeyVal = record
    Key: Integer;
    Val: Integer;
  end;

  TBTreeNode = class(TObject)
  private
    FCount: Integer;
    FMaxKeys: integer;
    FKeys: array of Integer;
    FVals: array of integer;
    FChildNodes: array of TBTreeNode;
    FOrder: integer;
    function GetChildNodes(Index: Integer): TBtreeNode;
    function GetKeys(Index: Integer): Integer;
    function GetVals(Index: Integer): Integer;
    procedure InsertKeyVal(Index: Integer; const new_key, new_val: Integer);
    procedure InsertChildNode(Index: Integer; const new_node: TBtreeNode);
    procedure SetChildNodes(Index: Integer; const Value: TBtreeNode);
    procedure SetKeys(Index: Integer; const Value: Integer);
    procedure SetVals(Index: Integer; const Value: Integer);
    function IsLeaf:Boolean;
  protected
    procedure DumpNodes(var S : String; depth : Integer);
    function InternalAdd(new_key, new_val:Integer; var new_node:TBtreeNode;var return_key, return_val:Integer):boolean;
    procedure SetCount(Value : Integer);
  public
    constructor Create(Order:Integer);
    destructor  Destroy;override;
    property Order    : Integer read FOrder;
    property MaxKeys  : Integer read FMaxKeys;
    property Keys[Index:Integer]:Integer read GetKeys write SetKeys;
    property Vals[Index:Integer]:Integer read GetVals write SetVals;
    property ChildNodes[Index:Integer]:TBtreeNode read GetChildNodes write SetChildNodes;
    property Count:Integer read FCount;
  end;

  TBtree = class(TObject)
  private
    FCount : Integer;
    FOrder : Integer;
    FRoot  : TBTreeNode;
  protected
  public
    function DumpNodes:String;
    procedure Add(new_key, new_val:Integer);
    constructor Create(Order:Integer);
    destructor Destroy;override;
    property Order : Integer read FOrder;
    property Count : Integer read FCount;
  end;

implementation

{ TBTreeNode }

//節点のコンストラクタ
constructor TBTreeNode.Create(Order:Integer);
begin
  inherited Create;

  FCount    := 0;
  FOrder    := Order;
  FMaxKeys  := Order * 2;

  //実装を簡易にするため、0..2*K、つまり要素数2K+1の配列とする
  SetLength(FKeys, FMaxKeys + 1);
  SetLength(FVals, FMaxKeys + 1);

  //子節点へのリンクは2K+1個を使用するので、余分を1つとる
  //こうしておくと、分割の際に、K+1個ずつ分配しやすい
  SetLength(FChildNodes, FMaxKeys + 2);

end;

//節点のデストラクタ
//子節点があれば、それを解放する
destructor TBTreeNode.Destroy;
var
  idx : Integer;
begin
  for idx := 0 to FCount do
  begin
    if (FChildNodes[idx] <> nil) then FChildNodes[idx].Free;
  end;

  inherited;
end;

//節点の状態を返す処理
procedure TBTreeNode.DumpNodes(var S: String; depth: Integer);
var
  idx : Integer;
begin
  //節点が葉かどうかで処理を分ける
  if (IsLeaf = True) then
  //葉である場合
  begin
    for idx := 0 to FCount -1 do
    begin
      S := S + DupeString('  ', depth) + IntToStr(FKeys[idx]) + #13#10;
    end;
  end else
  //葉でない場合
  begin
    for idx := 0 to FCount -1 do
    begin
      FChildNodes[idx].DumpNodes(S, depth + 1);
      S := S + DupeString('  ', depth) + IntToStr(FKeys[idx]) + #13#10;
    end;
    FChildNodes[FCount].DumpNodes(S, depth + 1);
  end;
end;

function TBTreeNode.GetChildNodes(Index: Integer): TBtreeNode;
begin
  result := FChildNodes[Index];
end;

function TBTreeNode.GetKeys(Index: Integer): Integer;
begin
  result := FKeys[Index];
end;

function TBTreeNode.GetVals(Index: Integer): Integer;
begin
  result := FVals[Index];
end;

//節点への要素の追加
function TBTreeNode.InternalAdd(new_key, new_val:Integer; var new_node:TBtreeNode;var return_key, return_val:Integer):boolean;
var
  idx : Integer;
begin
  //新しいキーがバケット内のどの位置にあたるかをチェックしておく
  //idxには、new_key の位置が入る
  if (FCount = 0) then
    idx := 0
  else
    for idx := 0 to FCount - 1 do
      if (FKeys[idx] > new_key) then break;

  //葉の場合とそうでない場合で処理を分ける
  if (IsLeaf = True) then
  //節点が葉である場合
  begin
    //新しいキーより大きい値の左側へ新しいキーを挿入する
    //余分を1つ取ってあるので必ず挿入できる
    InsertKeyVal(idx, new_key, new_val);

    //すでにバケットがいっぱいかどうかで処理を分ける
    if (FCount > FMaxkeys) then
    begin
      //バケットの分割が発生する
      result := True;

      //分割用の新しい節点を生成
      new_node := TBTreeNode.Create(FOrder);

      //新節点へ値を移動する
      for idx := 0 to FOrder - 1 do
      begin
        //中央値はK番目にあたるので、K+1番目から上を新節点へ移動
        //(K-1)+(K+1)=2K
        new_node.Keys[idx] := FKeys[idx + FOrder + 1];
        new_node.Vals[idx] := FVals[idx + FOrder + 1];
      end;

      //親節点へ返すキーと値の組をセット
      return_key := FKeys[FOrder];
      return_val := FVals[FOrder];

      //分割によって、CountはKになる
      FCount := FOrder;
      new_node.SetCount(FOrder);

      exit;
    end else
    begin
      //分割は発生していない
      result := False;
      exit;
    end;
  //節点が葉でない場合の処理
  end else
  begin
    //新しいキーより大きいキーの左側の子節点へキーを追加する
    //idxには、キーの位置が入っているので、同じ位置のFChildNodesがそれにあたる

    //追加した結果分割が発生したかどうかで処理を分ける
    if (FChildNodes[idx].InternalAdd(new_key, new_val, new_node, return_key, return_val) = True) then
    //分割が発生した
    begin
      //分割の結果返されたキーを挿入するのも、idxの位置になるので
      //これを再度チェックする必要はない

      //新しいキーより大きい値の左側へ新しいキーを挿入する
      //余分を1つ取ってあるので必ず挿入できる
      InsertKeyVal(idx, return_key, return_val);

      //新しい子節点を追加する
      //位置としては、右側の子節点となるので、idx+1の位置へ挿入する
      InsertChildNode(idx + 1, new_node);

      //すでにバケットがいっぱいかどうかで処理を分ける
      if (FCount > FMaxkeys) then
      begin
        //バケットの分割が発生する
        result := True;

        //分割用の新しい節点を生成
        new_node := TBTreeNode.Create(FOrder);

        //新節点へ値を移動する
        for idx := 0 to FOrder - 1 do
        begin
          //中央値はK番目にあたるので、K+1番目から上を新節点へ移動
          //0+K+1=K+1 〜 (K-1)+(K+1)=2K を移動する
          new_node.Keys[idx] := FKeys[idx + FOrder + 1];
          new_node.Vals[idx] := FVals[idx + FOrder + 1];

          //子節点へのリンクも同様に移動し、移動元をnilで埋める
          new_node.ChildNodes[idx] := FChildNodes[idx + FOrder + 1];
          FChildNodes[idx + FOrder + 1] := nil;
        end;

        //子節点へのリンクは、一番右側がはみ出すのでこれを移動する
        new_node.ChildNodes[FOrder] := FChildNodes[FMaxKeys + 1];
        FChildNodes[FMaxKeys + 1] := nil;

        //親節点へ返すキーと値の組をセット
        return_key := FKeys[FOrder];
        return_val := FVals[FOrder];

        //分割によって、CountはKになる
        FCount := FOrder;
        new_node.SetCount(FOrder);

        exit;

      end else
      //分割は発生していない
      begin
        result := False;
        exit;
      end;
    end else
    //分割が発生していない
    begin
      result := False;
      exit;
    end;
  end;
end;

function TBTreeNode.IsLeaf: Boolean;
begin
  result := (FChildNodes[0] = nil);
end;

procedure TBTreeNode.SetChildNodes(Index: Integer; const Value: TBtreeNode);
begin
  FChildNodes[index] := Value;
end;

procedure TBTreeNode.SetCount(Value: Integer);
begin
  FCount := Value;
end;

procedure TBTreeNode.SetKeys(Index: Integer; const Value: Integer);
begin
  FKeys[Index] := Value;
end;

//Indexを指定した位置に、ChildNodeを挿入する
procedure TBTreeNode.InsertChildNode(Index: Integer;
  const new_node: TBtreeNode);
var
  idx : Integer;
begin
  //追加するキーのために場所を確保する
  for idx := FCount + 1 downto index + 1 do
  begin
    FChildNodes[idx] := FChildNodes[idx - 1];
  end;

  FChildNodes[index] := new_node;


end;

//Indexを指定した位置に、キー=Valueを挿入する
procedure TBTreeNode.InsertKeyVal(Index: Integer; const new_key, new_val: Integer);
var
  idx : Integer;
begin

  //追加するキーのために場所を確保する
  for idx := FCount downto index + 1 do
  begin
    FKeys[idx] := FKeys[idx - 1];
    FVals[idx] := FVals[idx - 1];
  end;

  FKeys[index] := new_key;
  FVals[index] := new_val;

  Inc(FCount);
end;

procedure TBTreeNode.SetVals(Index: Integer; const Value: Integer);
begin
  FVals[Index] := Value;
end;

{ TBtree }

procedure TBtree.Add(new_key, new_val: Integer);
var
  created_node, old_root : TBTreeNode;
  return_key, return_val : Integer;
begin
  //ルートに対して新しいキーを追加した結果、ルートが分割されるかどうかで処理を分ける
  if(FRoot.InternalAdd(new_key, new_val, created_node, return_key, return_val)=True) then
  begin
    old_root := FRoot;
    FRoot := TBTreeNode.Create(FOrder);
    FRoot.Keys[0] := return_key;
    FRoot.Vals[0] := return_val;
    FRoot.ChildNodes[0] := old_root;
    FRoot.ChildNodes[1] := created_node;
    FRoot.SetCount(1);
  end;
end;

//B木のコンストラクタ
constructor TBtree.Create(Order: Integer);
begin
  inherited Create;

  FOrder := Order;
  FRoot  := TBtreeNode.Create(Order);
end;

//B木のデストラクタ
destructor TBtree.Destroy;
begin
  FRoot.Free;

  inherited;
end;

//ツリーの内部状態を返す
function TBtree.DumpNodes: String;
begin
  FRoot.DumpNodes(Result, 0);
end;

end.
prev
 

Index
RDBMSで使われるB木を学ぼう
  Page1
B木とは何か
B木の成長
  Page2
B木への要素の追加(葉の場合)
B木への要素の追加(葉でない場合)
B木の実装の工夫
  Page3
B木のテストプログラム
Appendix
BTree.pasのソースコード

index 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の世界を体験してみよう
  Coding Edgeフォーラムフィード  2.01.00.91


Coding Edge フォーラム 新着記事
@ITメールマガジン 新着情報やスタッフのコラムがメールで届きます(無料)

注目のテーマ

>

Coding Edge 記事ランキング

本日 月間