右−左回転でバランスを回復させる
同様にA節点に着目したとき、右側が高く(Balance=brRight)、右側の子である節点Bの左側の子である節点Cを頂点とする部分木が、節点Bの右側の部分木よりも高い場合には、左回転ではバランスを回復できません。
この場合は、節点の追加時と同様に、右−左回転動作を行うことでバランスを回復します。ただし、節点Aでの部分木の高さが必ず1つ低くなるため、より上位でのバランスチェックが必要となります。

テストプログラムで検証してみよう
テストプログラムも新しいものを作ってみました。AVLTree_Test2.exeを実行してみて下さい。できることは単純です。
- ツリーにノードを適当な数だけ追加する
- ツリーから指定したノードを削除する
- ツリーの様子を行きがけ順で表示する
- ツリーを初期化する
いろいろいじってみてもらうと、どこを削除すると、どんな風に変わるのかが分かってもらえるかと思います。
AVLTreeの拡張
さて、前回から実装しているサンプルプログラムAVLTreeですが、通常の木構造の実装とはちょっと違うところがあります。今回のAVLTreeでは、通常であれば節点の左側へ節点自身以下の要素を渡して、右側へは節点を超える要素を渡すというところを、等しい場合については節点の値を書き換えるという動作にしてあります。
001: unit AVLTree2;
002:
003: interface
004:
005: uses
006: SysUtils, Classes, RTLConsts, avltree;
007:
008: type
009: TBalance = (brLeft, brEqual, brRight);
010: TDumpNodes = (dnPreorder, dnInorder, dnPostorder);
011: TAVLTreeNode = class;
012:
013: TAVLTreeNode = class(TObject)
014: private
015: FItemTree : TAVLTree;
016: public
017: ID : Integer;
018: LeftChild, RightChild : TAVLTreeNode;
019: Balance : TBalance;
020: property ItemTree : TAVLTree read FItemTree write FItemTree;
021: constructor Create;
022: destructor Destroy; override;
023: end;
024:
025:
026: TAVLTree2 = class(TObject)
027: private
028: FCount : integer;
029: FRoot : TAVLTreeNode;
030: protected
031: procedure AddNode(var parent : TAVLTreeNode; newID : Integer; value : Pointer; var grow : Boolean);
032: procedure AdjustLeftGrow(var parent : TAVLTreeNode);
033: function AdjustLeftCutdown(var node: TAVLTreeNode):Boolean;
034: procedure AdjustRightGrow(var parent : TAVLTreeNode);
035: function AdjustRightCutdown(var node: TAVLTreeNode):Boolean;
036: procedure DeleteFromNode(var node : TAVLTreeNode; delID : Integer; var cutdown : Boolean);
037: function Get(Index: Integer): TAVLTree;
038: procedure InternalGet(var parent: TAVLTreeNode; index : integer; var bolFind:Boolean; var item:pointer);
039: procedure InternalDumpNodes(var parent: TAVLTreeNode; var s: string; search_algo: TDumpNodes; var depth: Integer);
040: procedure ReplaceRightMost(var targetNode, replNode : TAVLTreeNode; var cutdown : Boolean);
041: public
042: procedure Add(newID : Integer; value : Pointer);
043: procedure Delete(delID : Integer);
044: function DumpNodes(search_algo:TDumpNodes):String;
045: property Count : Integer read FCount;
046: property ItemTree[Index:Integer]: TAVLTree read Get;
047: destructor Destroy; override;
048: end;
049:
050: implementation
051:
052:
053: { TAVLNode }
054:
055: constructor TAVLTreeNode.Create;
056: begin
057: FItemTree := TAVLTree.Create;
058: end;
059:
060: destructor TAVLTreeNode.Destroy;
061: begin
062: if (LeftChild <> nil) then LeftChild.Free;
063: if (RightChild <> nil) then RightChild.Free;
064:
065: FItemTree.Free;
066: inherited;
067: end;
068:
069: { TAVLTree }
070:
071: //ツリーに値を追加する処理
072: procedure TAVLTree2.Add(newID: Integer; value: Pointer);
073: var
074: grow : Boolean;
075: begin
076: //Addメソッドは、まずRootから値を追加する先を探索する
077: grow := False;
078: AddNode(FRoot, newID, value, grow);
079: end;
080:
081: //ノードの追加を再帰的に行う処理
082: procedure TAVLTree2.AddNode(
083: var parent: TAVLTreeNode;
084: newID: Integer;
085: value : Pointer;
086: var grow: Boolean
087: );
088: begin
089: //木の最深部まで降りた場合、そこにノードを追加する
090: if (parent = nil) then
091: begin
092: parent := TAVLTreeNode.Create;
093: parent.ID := newID;
094: parent.Balance := brEqual;
095: parent.ItemTree.Add(Integer(value), nil);
096: grow := True;
097: Inc(FCount);
098: exit;
099: end;
100:
101: //newIDが現在の節点のIDより小さい時の処理
102: //左側に下っていく
103: if (newID < parent.ID) then
104: begin
105: //左側へ節点を追加する
106: AddNode(parent.LeftChild, newID, value, grow);
107:
108: //木が成長した=高さが変わった場合、grow がTrueで返ってくる
109: //Falseの場合、バランス調整は不要
110: if (grow = False) then exit;
111:
112: if (parent.Balance = brRight) then
113: begin
114: //元々は右側の高さが大きかった場合
115: //左に新しい節点が追加されたので、これでバランスした
116: parent.Balance := brEqual;
117:
118: //上のノードには、深度が変化していないと通知する
119: grow := False;
120: end else if (parent.Balance = brEqual) then
121: begin
122: //元々がバランスしていたので、左側に節点が追加されたため
123: //左側が深い状態になった
124: parent.Balance := brLeft;
125: end else
126: begin
127: //元々左側の高さが大きかったので、
128: //左側に節点が追加されたため、バランス調整が必要となった
129: AdjustLeftGrow(parent);
130: grow := False;
131: end;
132:
133: end else
134: //newIDが現在の節点のIDより大きい場合の処理
135: //右側に下っていく
136: if (newID > parent.ID) then
137: begin
138: //右側に節点を追加する
139: AddNode(parent.RightChild, newID, value, grow);
140:
141: //木が成長した=高さが変わった場合、grow がTrueで返ってくる
142: //Falseの場合、バランス調整は不要
143: if (grow = False) then exit;
144:
145: if (parent.Balance = brLeft) then
146: begin
147: //元々は左側の高さが大きかった場合
148: //右に新しい節点が追加されたので、これでバランスした
149: parent.Balance := brEqual;
150: grow := False;
151: end else
152: if (parent.Balance = brEqual) then
153: begin
154: //元々がバランスしていたので、右側に節点が追加されたため
155: //右側が深い状態になった
156: parent.Balance := brRight;
157: end else
158: begin
159: //元々右側の高さが大きかったので
160: //右側に節点が追加されたため、バランス調整が必要になった
161: AdjustRightGrow(parent);
162: grow := False;
163: end;
164: end else
165: begin
166: //newIDと現在の節点のIDが同じ場合は、ノードの値を書き換える
167: parent.ItemTree.Add(Integer(value), nil);
168: grow := False;
169: Inc(FCount);
170: end;
171: end;
172:
173: //削除時にツリーの左側が低くなった時の処理
174: function TAVLTree2.AdjustLeftCutdown(var node: TAVLTreeNode):Boolean;
175: var
176: OrigRightChild, OrigGrandChild : TAVLTreeNode;
177: ChildBalance, GrandChildBalance : TBalance;
178: begin
179:
180: //ノードの左側が高い状態だったので、左が低くなってバランスした
181: //ということは、このノードでの左右の高さは1つ低くなっている
182: if (node.Balance = brLeft) then
183: begin
184: node.Balance := brEqual;
185: result := True;
186: end else
187:
188: //ノードはバランスしていたので、右が高くなる
189: //全体として、左右の高さは変化しない
190: if (node.Balance = brEqual) then
191: begin
192: node.Balance := brRight;
193: result := False;
194: end else
195:
196: //ノードは右側が高い状態だったので、右が2つ高くなってしまった
197: begin
198: OrigRightChild := node.RightChild;
199: ChildBalance := OrigRightChild.Balance;
200:
201: // 左部分木の左右の高さが等しい、または左が低い場合は、左回転
202: if (ChildBalance <> brLeft) then
203: begin
204: node.RightChild := OrigRightChild.LeftChild;
205: OrigRightChild.LeftChild := node;
206:
207: //T2とT3が同じ高さだった場合、部分木の高さは変わらない
208: if (ChildBalance = brEqual) then
209: begin
210: node.Balance := brRight;
211: OrigRightChild.Balance := brLeft;
212: result := False;
213: end else
214:
215: //T2よりT3が高かった場合、部分木は低くなる
216: begin
217: node.Balance := brEqual;
218: OrigRightChild.Balance := brEqual;
219: result := True;
220: end;
221:
222: node := OrigRightChild;
223: end else
224:
225: // 右部分木の左部分木が高い場合は、右−左回転
226: // 右−左回転の場合は、必ず部分木の高さが1つ低くなる
227: begin
228: OrigGrandChild := OrigRightChild.LeftChild;
229: GrandchildBalance := OrigGrandchild.Balance;
230: OrigRightChild.LeftChild := OrigGrandChild.RightChild;
231: OrigGrandChild.RightChild := OrigRightChild;
232: node.RightChild := OrigGrandChild.LeftChild;
233: OrigGrandChild.LeftChild := node;
234:
235: if (GrandChildBalance = brRight) then
236: node.Balance := brLeft
237: else
238: node.Balance := brEqual;
239:
240: if (GrandChildBalance = brLeft) then
241: OrigRightChild.Balance := brRight
242: else
243: OrigRightChild.Balance := brEqual;
244:
245: node := OrigGrandChild;
246: OrigGrandChild.Balance := brEqual;
247:
248: result := True;
249: end;
250: end;
251: end;
252:
253: //追加時にツリーの左側でバランスが崩れたときの処理
254: procedure TAVLTree2.AdjustLeftGrow(var parent: TAVLTreeNode);
255: var
256: OrgLeftChild, OrgGrandChild : TAVLTreeNode;
257: begin
258: OrgLeftChild := parent.LeftChild;
259: if (OrgLeftChild.Balance = brLeft) then
260: begin
261: //左側の左側でバランスが崩れたので、右回転する
262: parent.LeftChild := OrgLeftChild.RightChild;
263: OrgLeftChild.RightChild := parent;
264: parent.Balance := brEqual;
265: parent := OrgLeftChild;
266: end else
267: begin
268: //左側の右側でバランスが崩れたので、左−右回転する
269: OrgGrandchild := OrgLeftchild.RightChild;
270: OrgLeftchild.RightChild := OrgGrandChild.LeftChild;
271: OrgGrandchild.LeftChild := OrgLeftchild;
272: parent.LeftChild := OrgGrandChild.RightChild;
273: OrgGrandChild.RightChild := parent;
274: if (OrgGrandChild.Balance = brLeft) then
275: parent.Balance := brRight
276: else
277: parent.Balance := brEqual;
278: if (OrgGrandchild.Balance = brRight) then
279: OrgLeftchild.Balance := brLeft
280: else
281: OrgLeftchild.Balance := brEqual;
282: parent := OrgGrandChild;
283: end;
284: parent.Balance := brEqual;
285: end;
286:
287: //削除時にツリーの右側が低くなった時の処理
288: function TAVLTree2.AdjustRightCutdown(var node: TAVLTreeNode):Boolean;
289: var
290: OrigLeftChild, OrigGrandChild : TAVLTreeNode;
291: ChildBalance, GrandChildBalance : TBalance;
292: begin
293:
294: //ノードの右側が高い状態だったので、右が低くなってバランスした
295: //ということは、このノードでの左右の高さは1つ低くなっている
296: if (node.Balance = brRight) then
297: begin
298: node.Balance := brEqual;
299: result := True;
300: end else
301:
302: //ノードはバランスしていたので、左が高くなる
303: //全体として、左右の高さは変化しない
304: if (node.Balance = brEqual) then
305: begin
306: node.Balance := brLeft;
307: result := False;
308: end else
309:
310: //ノードは左側が高い状態だったので、左が2つ高くなってしまった
311: begin
312: OrigLeftChild := node.LeftChild;
313: ChildBalance := OrigLeftChild.Balance;
314:
315: // 左部分木の左右の高さが等しい、または右が低い場合は、右回転
316: if (ChildBalance <> brRight) then
317: begin
318: node.LeftChild := OrigLeftChild.RightChild;
319: OrigLeftChild.RightChild := node;
320:
321: //T2とT3が同じ高さだった場合、部分木の高さは変わらない
322: if (ChildBalance = brEqual) then
323: begin
324: node.Balance := brLeft;
325: OrigLeftChild.Balance := brRight;
326: result := False;
327: end else
328:
329: //T2よりT3が高かった場合、部分木は低くなる
330: begin
331: node.Balance := brEqual;
332: OrigLeftChild.Balance := brEqual;
333: result := True;
334: end;
335:
336: node := OrigLeftChild;
337: end else
338:
339: // 左部分木の右部分木が高い場合は、左−右回転
340: // 左−右回転の場合は、必ず部分木の高さが1つ低くなる
341: begin
342: OrigGrandChild := OrigLeftChild.RightChild;
343: GrandchildBalance := OrigGrandchild.Balance;
344: OrigLeftChild.RightChild := OrigGrandChild.LeftChild;
345: OrigGrandChild.LeftChild := OrigLeftChild;
346: node.LeftChild := OrigGrandChild.RightChild;
347: OrigGrandChild.RightChild := node;
348:
349: if (GrandChildBalance = brLeft) then
350: node.Balance := brRight
351: else
352: node.Balance := brEqual;
353:
354: if (GrandChildBalance = brRight) then
355: OrigLeftChild.Balance := brLeft
356: else
357: OrigLeftChild.Balance := brEqual;
358:
359: node := OrigGrandChild;
360: OrigGrandChild.Balance := brEqual;
361:
362: result := True;
363: end;
364: end;
365: end;
366:
367: //追加時にツリーの右側でバランスが崩れたときの処理
368: procedure TAVLTree2.AdjustRightGrow(var parent: TAVLTreeNode);
369: var
370: OrgRightChild, OrgGrandChild : TAVLTreeNode;
371: begin
372: OrgRightChild := parent.RightChild;
373: if (OrgRightChild.Balance = brRight) then
374: begin
375: //右側の右側でバランスが崩れたので、左回転する
376: parent.RightChild := OrgRightChild.LeftChild;
377: OrgRightChild.LeftChild := parent;
378: parent.Balance := brEqual;
379: parent := OrgRightChild;
380: end else
381: begin
382: //右側の左側でバランスが崩れたので、右−左回転する
383: OrgGrandchild := OrgRightchild.LeftChild;
384: OrgRightchild.LeftChild := OrgGrandChild.RightChild;
385: OrgGrandChild.RightChild := OrgRightChild;
386: parent.RightChild := OrgGrandChild.LeftChild;
387: OrgGrandChild.LeftChild := parent;
388: if (OrgGrandChild.Balance = brRight) then
389: parent.Balance := brLeft
390: else
391: parent.Balance := brEqual;
392: if (OrgGrandchild.Balance = brLeft) then
393: OrgRightChild.Balance := brRight
394: else
395: OrgRightChild.Balance := brEqual;
396: parent := OrgGrandChild;
397: end;
398: parent.Balance := brEqual;
399: end;
400:
401: destructor TAVLTree2.Destroy;
402: begin
403: if (FRoot <> nil) then FRoot.Free;
404:
405: inherited;
406: end;
407:
408: //ツリーの内部からIDを引き出して、文字列で返す
409: function TAVLTree2.DumpNodes(search_algo:TDumpNodes): String;
410: var
411: depth : integer;
412: begin
413: if (FRoot = nil) then
414: begin
415: result := 'This tree has nothing';
416: exit;
417: end;
418:
419: depth := 0;
420: InternalDumpNodes(FRoot, result, search_algo, depth);
421: end;
422:
423: //ツリーのインデックス参照による値の取得
424: function TAVLTree2.Get(Index: Integer): TAVLTree;
425: var
426: bolFind:Boolean;
427: item:pointer;
428: begin
429: InternalGet(FRoot, Index, bolFind, item);
430: if (bolFind = False) then raise EListError.Createfmt(LoadResString(@SListIndexError), [Index]);
431: result := TAVLTree(item);
432: end;
433:
434: //ツリーの内部状態をダンプする処理
435: procedure TAVLTree2.InternalDumpNodes(var parent: TAVLTreeNode; var s: string; search_algo: TDumpNodes; var depth: Integer);
436: procedure make_result;
437: begin
438: if (s <> '') then s := s + ', ';
439: if (parent = FRoot) then s := s + '[';
440: s := s + 'ID=' + IntToStr(parent.ID) + ':Count=' + IntToStr(parent.ItemTree.Count) + ':Depth=' + IntToStr(depth);
441: if (parent = FRoot) then s := s + ']';
442:
443: end;
444: begin
445: //行きがけ順はここで処理
446: if (search_algo = dnPreorder) then make_result;
447:
448: if (parent.LeftChild <> nil) then
449: begin
450: inc(depth);
451: InternalDumpNodes(parent.LeftChild, s, search_algo, depth);
452: dec(depth);
453: end;
454:
455: //通りがかけ順はここで処理
456: if (search_algo = dnInorder) then make_result;
457:
458: if (parent.RightChild <> nil) then
459: begin
460: inc(depth);
461: InternalDumpNodes(parent.RightChild, s, search_algo, depth );
462: dec(depth);
463: end;
464:
465: //帰りがけ順はここで処理
466: if (search_algo = dnPostorder) then make_result;
467:
468: end;
469:
470: //ツリーからのデータの取得を再帰的に行う処理
471: procedure TAVLTree2.InternalGet(var parent: TAVLTreeNode; index : integer; var bolFind:Boolean; var item:Pointer);
472: begin
473: if (parent.ID = Index) then
474: begin
475: item := parent.ItemTree;
476: bolFind := True;
477: exit;
478: end;
479: if (parent.LeftChild <> nil) then
480: begin
481: InternalGet(parent.LeftChild, index, bolFind, item);
482: if (bolFind = True) then exit;
483: end;
484: if (parent.RightChild <> nil) then
485: begin
486: InternalGet(parent.RightChild, index, bolFind, item);
487: if (bolFind = True) then exit;
488: end;
489: end;
490:
491: // ソート木の削除時にソートを崩さずに削除する処理
492: procedure TAVLTree2.ReplaceRightMost(var targetNode, replNode: TAVLTreeNode;
493: var cutdown: Boolean);
494: var
495: OrigReplNode : TAVLTreeNode;
496: begin
497:
498: // ここが、最右端のノード
499: if (replNode.RightChild = nil) then
500: begin
501: // replNode は、削除されるノードを置き換えるノード
502: // 置き換え元のノードを保持しておく
503: OrigReplNode := replNode;
504:
505: // 左側の子で置き換え元のノードを置き換える
506: // LeftChild が nil なら両方ないわけだが、結果的にnilになるのでよい
507: replNode := replNode.LeftChild;
508:
509: // 削除されるノードを置き換え用ノードで置き換える
510: OrigReplNode.LeftChild := targetNode.LeftChild;
511: OrigReplNode.RightChild := targetNode.RightChild;
512: OrigReplNode.Balance := targetNode.Balance;
513: targetNode := OrigReplNode;
514:
515: cutdown := True;
516: end else
517: begin
518: // 置き換え用ノードの再起探索
519: ReplaceRightMost(targetNode, replNode.RightChild, cutdown);
520: if (cutdown) then cutdown := AdjustRightCutdown(replNode);
521: end;
522: end;
523:
524: // Publicメソッド Delete の処理
525: procedure TAVLTree2.Delete(delID : Integer);
526: var
527: cutdown : Boolean;
528: begin
529: DeleteFromNode(FRoot, delID, cutdown);
530: end;
531:
532: // Delete処理の本体
533: procedure TAVLTree2.DeleteFromNode(var node : TAVLTreeNode; delID : Integer; var cutdown : Boolean);
534: var
535: targetNode : TAVLTreeNode;
536: begin
537: //一番下まで来てしまったので、ターゲットはなかった
538: if (node = nil) then
539: begin
540: Exception.CreateFmt('Not Find %d in the tree.', [delID]);
541: cutdown := False;
542: exit;
543: end;
544:
545: // ターゲットがノードのIDより小さいので左側へ下りる
546: if (delID < node.ID) then
547: begin
548: DeleteFromNode(node.LeftChild, delID, cutdown);
549: if (cutdown=True) then cutdown := AdjustLeftCutdown(node);
550: end else
551:
552: // ターゲットがノードのIDより大きいので右側へ下りる
553: if (delID > node.ID) then
554: begin
555: DeleteFromNode(node.RightChild, delID, cutdown);
556: if (cutdown=True) then cutdown := AdjustRightCutdown(node);
557:
558: end else
559:
560: // ターゲットとノードのIDが一致した場合
561: begin
562: targetNode := node;
563:
564: // ソート木でのノードの削除処理を実行する
565:
566: // ノードの右には子がないので、左の子を自分の位置と入れ替える
567: if (node.RightChild = nil) then
568: begin
569: // この操作で、木の高さは一つ低くなる
570: node := node.LeftChild;
571: cutdown := True;
572: end else
573:
574: // ノードには左の子がないので、右の子を自分の位置と入れ替える
575: if (node.LeftChild = nil) then
576: begin
577: // この操作で、木の高さは1つ低くなる
578: node := node.RightChild;
579: cutdown := True;
580:
581: // ノードには子が両側にある
582: end else
583: begin
584: ReplaceRightmost(node, node.LeftChild, cutdown);
585: if (cutdown=True) then cutdown := AdjustLeftCutdown(node);
586: end;
587:
588: // Free the target node.
589: targetNode.LeftChild := nil;
590: targetNode.RightChild := nil;
591: FCount := FCount - targetNode.ItemTree.Count;
592: targetNode.Free;
593: end;
594: end;
595:
596: end.考えれば分かることですが、これだと同じ値は1つしか存在しないことになるので、例えばデータベースのインデックスとして使おうと思った場合にはユニークキーとしてしか利用できないことになってしまいます。実は筆者が考えていたのは、以下のようなことでした。

データベース用語だと選択度(Selectivity)が低いとか、重複値が多い(Large Duplicate Value)といいますが、ユニークでないインデックスに多数の同じ値が入っているときに、インデックスの検索性能が落ちるという現象があります。
例を挙げると、男女の別を識別するカラムにインデックスを作成して100万人のデータを作成した場合などがこの状態になるわけです。
本来、木構造の特徴として節点の左右で値の大小が決まっているため、特定の値を探す際に最短経路を取ることで時間を節約したいわけですが、同じ値がたくさん入っていると結局のところ、行ったり来たり、かなりの節点をたどっていくことになります。
最近ではこうしたDuplicate Valueがたくさんはいるようなインデックスとして、Bitmapインデックスを利用するという流れもありますが、例えば各節点に値ではなくリストや配列へのポインタを格納して重複値はそこへ格納していくようにしたらどうかと考えました。これをAVL-List-Treeと呼ぶことにします。


この考えをさらに進めて、AVL木の節点の先にもう1つAVL木を接続してみたらどうでしょうか。これをAVL-Tree-Treeと呼ぶことにします。


例えば、先ほどの例では男女の違いを挙げましたが、都道府県をインデックス化した場合、AVL木の節点に都道府県(のコードなど)が入り、その先のAVL木に各データを識別するレコード番号が入るというイメージです。
こうすると、例えば、ある特定のデータを消したい場合に、都道府県ごとのデータをツリーとして取得し、そこから二段階目のAVL木で値を探索して削除するという手続きになります。二段階目のAVL木にはレコード番号をインデックスとしてデータが格納されているので、これを探索・削除するのは容易ですね。
001: unit avllisttree;
002:
003: interface
004:
005: uses
006: SysUtils, Classes, RTLConsts;
007:
008: type
009: TBalance = (brLeft, brEqual, brRight);
010: TDumpNodes = (dnPreorder, dnInorder, dnPostorder);
011: TAVLListNode = class;
012:
013: TAVLListNode = class(TObject)
014: private
015: FItemList : TList;
016: public
017: ID : Integer;
018: LeftChild, RightChild : TAVLListNode;
019: Balance : TBalance;
020: property ItemList : TList read FItemList write FItemList;
021: constructor Create;
022: destructor Destroy; override;
023: end;
024:
025:
026: TAVLListTree = class(TObject)
027: private
028: FCount : integer;
029: FRoot : TAVLListNode;
030: protected
031: procedure AddNode(var parent : TAVLListNode; newID : Integer; value : Pointer; var grow : Boolean);
032: procedure AdjustLeftGrow(var parent : TAVLListNode);
033: function AdjustLeftCutdown(var node: TAVLListNode):Boolean;
034: procedure AdjustRightGrow(var parent : TAVLListNode);
035: function AdjustRightCutdown(var node: TAVLListNode):Boolean;
036: procedure DeleteFromNode(var node : TAVLListNode; delID : Integer; var cutdown : Boolean);
037: function Get(Index: Integer): TList;
038: procedure InternalGet(var parent: TAVLListNode; index : integer; var bolFind:Boolean; var item:pointer);
039: procedure InternalDumpNodes(var parent: TAVLListNode; var s: string; search_algo: TDumpNodes; var depth: Integer);
040: procedure ReplaceRightMost(var targetNode, replNode : TAVLListNode; var cutdown : Boolean);
041: public
042: procedure Add(newID : Integer; value : Pointer);
043: procedure Delete(delID : Integer);
044: function DumpNodes(search_algo:TDumpNodes):String;
045: property Count : Integer read FCount;
046: property ItemList[Index:Integer]: TList read Get;
047: destructor Destroy; override;
048: end;
049:
050: implementation
051:
052:
053: { TAVLNode }
054:
055: constructor TAVLListNode.Create;
056: begin
057: FItemList := TList.Create;
058: end;
059:
060: destructor TAVLListNode.Destroy;
061: begin
062: if (LeftChild <> nil) then LeftChild.Free;
063: if (RightChild <> nil) then RightChild.Free;
064:
065: FItemList.Free;
066: inherited;
067: end;
068:
069: { TAVLTree }
070:
071: //ツリーに値を追加する処理
072: procedure TAVLListTree.Add(newID: Integer; value: Pointer);
073: var
074: grow : Boolean;
075: begin
076: //Addメソッドは、まずRootから値を追加する先を探索する
077: grow := False;
078: AddNode(FRoot, newID, value, grow);
079: end;
080:
081: //ノードの追加を再帰的に行う処理
082: procedure TAVLListTree.AddNode(
083: var parent: TAVLListNode;
084: newID: Integer;
085: value : Pointer;
086: var grow: Boolean
087: );
088: begin
089: //木の最深部まで降りた場合、そこにノードを追加する
090: if (parent = nil) then
091: begin
092: parent := TAVLListNode.Create;
093: parent.ID := newID;
094: parent.Balance := brEqual;
095: parent.ItemList.Add(value);
096: grow := True;
097: Inc(FCount);
098: exit;
099: end;
100:
101: //newIDが現在の節点のIDより小さい時の処理
102: //左側に下っていく
103: if (newID < parent.ID) then
104: begin
105: //左側へ節点を追加する
106: AddNode(parent.LeftChild, newID, value, grow);
107:
108: //木が成長した=高さが変わった場合、grow がTrueで返ってくる
109: //Falseの場合、バランス調整は不要
110: if (grow = False) then exit;
111:
112: if (parent.Balance = brRight) then
113: begin
114: //元々は右側の高さが大きかった場合
115: //左に新しい節点が追加されたので、これでバランスした
116: parent.Balance := brEqual;
117:
118: //上のノードには、深度が変化していないと通知する
119: grow := False;
120: end else if (parent.Balance = brEqual) then
121: begin
122: //元々がバランスしていたので、左側に節点が追加されたため
123: //左側が深い状態になった
124: parent.Balance := brLeft;
125: end else
126: begin
127: //元々左側の高さが大きかったので、
128: //左側に節点が追加されたため、バランス調整が必要となった
129: AdjustLeftGrow(parent);
130: grow := False;
131: end;
132:
133: end else
134: //newIDが現在の節点のIDより大きい場合の処理
135: //右側に下っていく
136: if (newID > parent.ID) then
137: begin
138: //右側に節点を追加する
139: AddNode(parent.RightChild, newID, value, grow);
140:
141: //木が成長した=高さが変わった場合、grow がTrueで返ってくる
142: //Falseの場合、バランス調整は不要
143: if (grow = False) then exit;
144:
145: if (parent.Balance = brLeft) then
146: begin
147: //元々は左側の高さが大きかった場合
148: //右に新しい節点が追加されたので、これでバランスした
149: parent.Balance := brEqual;
150: grow := False;
151: end else
152: if (parent.Balance = brEqual) then
153: begin
154: //元々がバランスしていたので、右側に節点が追加されたため
155: //右側が深い状態になった
156: parent.Balance := brRight;
157: end else
158: begin
159: //元々右側の高さが大きかったので
160: //右側に節点が追加されたため、バランス調整が必要になった
161: AdjustRightGrow(parent);
162: grow := False;
163: end;
164: end else
165: begin
166: //newIDと現在の節点のIDが同じ場合は、ノードの値を書き換える
167: parent.ItemList.Add(value);
168: grow := False;
169: Inc(FCount);
170: end;
171: end;
172:
173: //削除時にツリーの左側が低くなった時の処理
174: function TAVLListTree.AdjustLeftCutdown(var node: TAVLListNode):Boolean;
175: var
176: OrigRightChild, OrigGrandChild : TAVLListNode;
177: ChildBalance, GrandChildBalance : TBalance;
178: begin
179:
180: //ノードの左側が高い状態だったので、左が低くなってバランスした
181: //ということは、このノードでの左右の高さは一つ低くなっている
182: if (node.Balance = brLeft) then
183: begin
184: node.Balance := brEqual;
185: result := True;
186: end else
187:
188: //ノードはバランスしていたので、右が高くなる
189: //全体として、左右の高さは変化しない
190: if (node.Balance = brEqual) then
191: begin
192: node.Balance := brRight;
193: result := False;
194: end else
195:
196: //ノードは右側が高い状態だったので、右が2つ高くなってしまった
197: begin
198: OrigRightChild := node.RightChild;
199: ChildBalance := OrigRightChild.Balance;
200:
201: // 左部分木の左右の高さが等しい、または左が低い場合は、左回転
202: if (ChildBalance <> brLeft) then
203: begin
204: node.RightChild := OrigRightChild.LeftChild;
205: OrigRightChild.LeftChild := node;
206:
207: //T2とT3が同じ高さだった場合、部分木の高さは変わらない
208: if (ChildBalance = brEqual) then
209: begin
210: node.Balance := brRight;
211: OrigRightChild.Balance := brLeft;
212: result := False;
213: end else
214:
215: //T2よりT3が高かった場合、部分木は低くなる
216: begin
217: node.Balance := brEqual;
218: OrigRightChild.Balance := brEqual;
219: result := True;
220: end;
221:
222: node := OrigRightChild;
223: end else
224:
225: // 右部分木の左部分木が高い場合は、右−左回転
226: // 右−左回転の場合は、必ず部分木の高さがひとつ低くなる
227: begin
228: OrigGrandChild := OrigRightChild.LeftChild;
229: GrandchildBalance := OrigGrandchild.Balance;
230: OrigRightChild.LeftChild := OrigGrandChild.RightChild;
231: OrigGrandChild.RightChild := OrigRightChild;
232: node.RightChild := OrigGrandChild.LeftChild;
233: OrigGrandChild.LeftChild := node;
234:
235: if (GrandChildBalance = brRight) then
236: node.Balance := brLeft
237: else
238: node.Balance := brEqual;
239:
240: if (GrandChildBalance = brLeft) then
241: OrigRightChild.Balance := brRight
242: else
243: OrigRightChild.Balance := brEqual;
244:
245: node := OrigGrandChild;
246: OrigGrandChild.Balance := brEqual;
247:
248: result := True;
249: end;
250: end;
251: end;
252:
253: //追加時にツリーの左側でバランスが崩れたときの処理
254: procedure TAVLListTree.AdjustLeftGrow(var parent: TAVLListNode);
255: var
256: OrgLeftChild, OrgGrandChild : TAVLListNode;
257: begin
258: OrgLeftChild := parent.LeftChild;
259: if (OrgLeftChild.Balance = brLeft) then
260: begin
261: //左側の左側でバランスが崩れたので、右回転する
262: parent.LeftChild := OrgLeftChild.RightChild;
263: OrgLeftChild.RightChild := parent;
264: parent.Balance := brEqual;
265: parent := OrgLeftChild;
266: end else
267: begin
268: //左側の右側でバランスが崩れたので、左−右回転する
269: OrgGrandchild := OrgLeftchild.RightChild;
270: OrgLeftchild.RightChild := OrgGrandChild.LeftChild;
271: OrgGrandchild.LeftChild := OrgLeftchild;
272: parent.LeftChild := OrgGrandChild.RightChild;
273: OrgGrandChild.RightChild := parent;
274: if (OrgGrandChild.Balance = brLeft) then
275: parent.Balance := brRight
276: else
277: parent.Balance := brEqual;
278: if (OrgGrandchild.Balance = brRight) then
279: OrgLeftchild.Balance := brLeft
280: else
281: OrgLeftchild.Balance := brEqual;
282: parent := OrgGrandChild;
283: end;
284: parent.Balance := brEqual;
285: end;
286:
287: //削除時にツリーの右側が低くなった時の処理
288: function TAVLListTree.AdjustRightCutdown(var node: TAVLListNode):Boolean;
289: var
290: OrigLeftChild, OrigGrandChild : TAVLListNode;
291: ChildBalance, GrandChildBalance : TBalance;
292: begin
293:
294: //ノードの右側が高い状態だったので、右が低くなってバランスした
295: //ということは、このノードでの左右の高さは一つ低くなっている
296: if (node.Balance = brRight) then
297: begin
298: node.Balance := brEqual;
299: result := True;
300: end else
301:
302: //ノードはバランスしていたので、左が高くなる
303: //全体として、左右の高さは変化しない
304: if (node.Balance = brEqual) then
305: begin
306: node.Balance := brLeft;
307: result := False;
308: end else
309:
310: //ノードは左側が高い状態だったので、左が2つ高くなってしまった
311: begin
312: OrigLeftChild := node.LeftChild;
313: ChildBalance := OrigLeftChild.Balance;
314:
315: // 左部分木の左右の高さが等しい、または右が低い場合は、右回転
316: if (ChildBalance <> brRight) then
317: begin
318: node.LeftChild := OrigLeftChild.RightChild;
319: OrigLeftChild.RightChild := node;
320:
321: //T2とT3が同じ高さだった場合、部分木の高さは変わらない
322: if (ChildBalance = brEqual) then
323: begin
324: node.Balance := brLeft;
325: OrigLeftChild.Balance := brRight;
326: result := False;
327: end else
328:
329: //T2よりT3が高かった場合、部分木は低くなる
330: begin
331: node.Balance := brEqual;
332: OrigLeftChild.Balance := brEqual;
333: result := True;
334: end;
335:
336: node := OrigLeftChild;
337: end else
338:
339: // 左部分木の右部分木が高い場合は、左−右回転
340: // 左−右回転の場合は、必ず部分木の高さがひとつ低くなる
341: begin
342: OrigGrandChild := OrigLeftChild.RightChild;
343: GrandchildBalance := OrigGrandchild.Balance;
344: OrigLeftChild.RightChild := OrigGrandChild.LeftChild;
345: OrigGrandChild.LeftChild := OrigLeftChild;
346: node.LeftChild := OrigGrandChild.RightChild;
347: OrigGrandChild.RightChild := node;
348:
349: if (GrandChildBalance = brLeft) then
350: node.Balance := brRight
351: else
352: node.Balance := brEqual;
353:
354: if (GrandChildBalance = brRight) then
355: OrigLeftChild.Balance := brLeft
356: else
357: OrigLeftChild.Balance := brEqual;
358:
359: node := OrigGrandChild;
360: OrigGrandChild.Balance := brEqual;
361:
362: result := True;
363: end;
364: end;
365: end;
366:
367: //追加時にツリーの右側でバランスが崩れたときの処理
368: procedure TAVLListTree.AdjustRightGrow(var parent: TAVLListNode);
369: var
370: OrgRightChild, OrgGrandChild : TAVLListNode;
371: begin
372: OrgRightChild := parent.RightChild;
373: if (OrgRightChild.Balance = brRight) then
374: begin
375: //右側の右側でバランスが崩れたので、左回転する
376: parent.RightChild := OrgRightChild.LeftChild;
377: OrgRightChild.LeftChild := parent;
378: parent.Balance := brEqual;
379: parent := OrgRightChild;
380: end else
381: begin
382: //右側の左側でバランスが崩れたので、右−左回転する
383: OrgGrandchild := OrgRightchild.LeftChild;
384: OrgRightchild.LeftChild := OrgGrandChild.RightChild;
385: OrgGrandChild.RightChild := OrgRightChild;
386: parent.RightChild := OrgGrandChild.LeftChild;
387: OrgGrandChild.LeftChild := parent;
388: if (OrgGrandChild.Balance = brRight) then
389: parent.Balance := brLeft
390: else
391: parent.Balance := brEqual;
392: if (OrgGrandchild.Balance = brLeft) then
393: OrgRightChild.Balance := brRight
394: else
395: OrgRightChild.Balance := brEqual;
396: parent := OrgGrandChild;
397: end;
398: parent.Balance := brEqual;
399: end;
400:
401: destructor TAVLListTree.Destroy;
402: begin
403: if (FRoot <> nil) then FRoot.Free;
404:
405: inherited;
406: end;
407:
408: //ツリーの内部からIDを引き出して、文字列で返す
409: function TAVLListTree.DumpNodes(search_algo:TDumpNodes): String;
410: var
411: depth : integer;
412: begin
413: if (FRoot = nil) then
414: begin
415: result := 'This tree has nothing';
416: exit;
417: end;
418:
419: depth := 0;
420: InternalDumpNodes(FRoot, result, search_algo, depth);
421: end;
422:
423: //ツリーのインデックス参照による値の取得
424: function TAVLListTree.Get(Index: Integer): TList;
425: var
426: bolFind:Boolean;
427: item:pointer;
428: begin
429: InternalGet(FRoot, Index, bolFind, item);
430: if (bolFind = False) then raise EListError.Createfmt(LoadResString(@SListIndexError), [Index]);
431: result := TList(item);
432: end;
433:
434: //ツリーの内部状態をダンプする処理
435: procedure TAVLListTree.InternalDumpNodes(var parent: TAVLListNode; var s: string; search_algo: TDumpNodes; var depth: Integer);
436: procedure make_result;
437: begin
438: if (s <> '') then s := s + ', ';
439: if (parent = FRoot) then s := s + '[';
440: s := s + 'ID=' + IntToStr(parent.ID) + ':Count=' + IntToStr(parent.ItemList.Count) + ':Depth=' + IntToStr(depth);
441: if (parent = FRoot) then s := s + ']';
442:
443: end;
444: begin
445: //行きがけ順はここで処理
446: if (search_algo = dnPreorder) then make_result;
447:
448: if (parent.LeftChild <> nil) then
449: begin
450: inc(depth);
451: InternalDumpNodes(parent.LeftChild, s, search_algo, depth);
452: dec(depth);
453: end;
454:
455: //通りがかけ順はここで処理
456: if (search_algo = dnInorder) then make_result;
457:
458: if (parent.RightChild <> nil) then
459: begin
460: inc(depth);
461: InternalDumpNodes(parent.RightChild, s, search_algo, depth );
462: dec(depth);
463: end;
464:
465: //帰りがけ順はここで処理
466: if (search_algo = dnPostorder) then make_result;
467:
468: end;
469:
470: //ツリーからのデータの取得を再帰的に行う処理
471: procedure TAVLListTree.InternalGet(var parent: TAVLListNode; index : integer; var bolFind:Boolean; var item:pointer);
472: var
473: tmp:Pointer;
474: begin
475: if (parent.ID = Index) then
476: begin
477: item := parent.ItemList;
478: bolFind := True;
479: exit;
480: end;
481: if (parent.LeftChild <> nil) then
482: begin
483: InternalGet(parent.LeftChild, index, bolFind, item);
484: if (bolFind = True) then exit;
485: end;
486: if (parent.RightChild <> nil) then
487: begin
488: InternalGet(parent.RightChild, index, bolFind, item);
489: if (bolFind = True) then exit;
490: end;
491: end;
492:
493: // ソート木の削除時にソートを崩さずに削除する処理
494: procedure TAVLListTree.ReplaceRightMost(var targetNode, replNode: TAVLListNode;
495: var cutdown: Boolean);
496: var
497: OrigReplNode : TAVLListNode;
498: begin
499:
500: // ここが、最右端のノード
501: if (replNode.RightChild = nil) then
502: begin
503: // replNode は、削除されるノードを置き換えるノード
504: // 置き換え元のノードを保持しておく
505: OrigReplNode := replNode;
506:
507: // 左側の子で置き換え元のノードを置き換える
508: // LeftChild が nil なら両方ないわけだが、結果的にnilになるのでよい
509: replNode := replNode.LeftChild;
510:
511: // 削除されるノードを置き換え用ノードで置き換える
512: OrigReplNode.LeftChild := targetNode.LeftChild;
513: OrigReplNode.RightChild := targetNode.RightChild;
514: OrigReplNode.Balance := targetNode.Balance;
515: targetNode := OrigReplNode;
516:
517: cutdown := True;
518: end else
519: begin
520: // 置き換え用ノードの再起探索
521: ReplaceRightMost(targetNode, replNode.RightChild, cutdown);
522: if (cutdown) then cutdown := AdjustRightCutdown(replNode);
523: end;
524: end;
525:
526: // Publicメソッド Delete の処理
527: procedure TAVLListTree.Delete(delID : Integer);
528: var
529: cutdown : Boolean;
530: begin
531: DeleteFromNode(FRoot, delID, cutdown);
532: end;
533:
534: // Delete処理の本体
535: procedure TAVLListTree.DeleteFromNode(var node : TAVLListNode; delID : Integer; var cutdown : Boolean);
536: var
537: targetNode : TAVLListNode;
538: begin
539: //一番下まで来てしまったので、ターゲットは無かった
540: if (node = nil) then
541: begin
542: Exception.CreateFmt('Not Find %d in the tree.', [delID]);
543: cutdown := False;
544: exit;
545: end;
546:
547: // ターゲットがノードのIDより小さいので左側へ下りる
548: if (delID < node.ID) then
549: begin
550: DeleteFromNode(node.LeftChild, delID, cutdown);
551: if (cutdown=True) then cutdown := AdjustLeftCutdown(node);
552: end else
553:
554: // ターゲットがノードのIDより大きいので右側へ下りる
555: if (delID > node.ID) then
556: begin
557: DeleteFromNode(node.RightChild, delID, cutdown);
558: if (cutdown=True) then cutdown := AdjustRightCutdown(node);
559:
560: end else
561:
562: // ターゲットとノードのIDが一致した場合
563: begin
564: targetNode := node;
565:
566: // ソート木でのノードの削除処理を実行する
567:
568: // ノードの右には子がないので、左の子を自分の位置と入れ替える
569: if (node.RightChild = nil) then
570: begin
571: // この操作で、木の高さは一つ低くなる
572: node := node.LeftChild;
573: cutdown := True;
574: end else
575:
576: // ノードには左の子が無いので、右の子を自分の位置と入れ替える
577: if (node.LeftChild = nil) then
578: begin
579: // この操作で、木の高さは一つ低くなる
580: node := node.RightChild;
581: cutdown := True;
582:
583: // ノードには子が両側にある
584: end else
585: begin
586: ReplaceRightmost(node, node.LeftChild, cutdown);
587: if (cutdown=True) then cutdown := AdjustLeftCutdown(node);
588: end;
589:
590: // Free the target node.
591: targetNode.LeftChild := nil;
592: targetNode.RightChild := nil;
593: FCount := FCount - targetNode.ItemList.Count;
594: targetNode.Free;
595: end;
596: end;
597:
598: end.さて、筆者が実装した変形AVL木、AVL-List-Tree、AVL-Tree-Treeのそれぞれをベンチマークしてみました。10万件、100万件でのInsertとDelete、10で割った剰余でInsert(つまりノードは10個しかできない)とその状態での検索性能、そこから削除という5つの指標でテストしてみました。
| 変形AVL木 | AVL-List-Tree | AVL-Tree-Tree | |
|---|---|---|---|
| Insert | 0.03 |
0.03 |
0.05 |
| Delete | 0.02 |
0.03 |
0.03 |
| Duplicate Insert | 0 |
0 |
0.03 |
| Duplicate Search | - |
0.74 |
0.02 |
| Duplicate Delete | 0.05 |
0.03 |
0.05 |
| 変形AVL木 | AVL-List-Tree | AVL-Tree-Tree | |
|---|---|---|---|
| Insert | 0.33 |
0.47 |
0.52 |
| Delete | 0.22 |
0.3 |
0.33 |
| Duplicate Insert | 0.05 |
0.06 |
0.36 |
| Duplicate Search | - |
72.22 |
0.25 |
| Duplicate Delete | 0.44 |
0.42 |
0.55 |
ベンチマーク結果をみると、やはりTAVLTreeの方がTListよりも検索性能が高いことがよく分かります。TListも値が少ないうちはいいのですが、値が多くなってくると指数関数的に遅くなってきます。TListを内部的に利用したAVL-List-Treeよりも、TAVLTreeを内部的に使用した、AVL-Tree-Treeの方が断然安定しています。
AVL木はいろいろなところで使われている
さて、今回も前回同様に“編み物”でしたが、前回と大体同じような流れなので理解しやすかったのではないかと思います。ところで、紹介したAVL木は有名なところではJavaのTreeMap classで利用されているほか、実はオープンソースのリレーショナルデータベースであるFirebirdでも内部的に使っています。
Firebird 2.1以降ではより単純なqueを使った管理に変更されてしまいましたが、Firebird 2.0系列までのDisk cache managerではDirty Page(つまり内容が変更されているが、Diskに書き戻されていないページ)を管理するのにAVL木が使用されていました。「こんなところに、こんなものが利用されているんだなぁ」と思いつつ、ソースコードを読んでいくと楽しいですね。
さて、次回はデータベースのインデックスとしてもメジャーなB+木にチャレンジします。ご期待下さい。
2/2 |
| 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の世界を体験してみよう |
|
- プログラムの実行はどのようにして行われるのか、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を紹介する。※ショートカットキー、アクセスキーの解説あり
|
|





