/packages/fcl-stl/src/gtree.pp
Puppet | 139 lines | 114 code | 25 blank | 0 comment | 8 complexity | 7fdcbb651f6cfff9fff83dd58441f80e MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
1{ 2 This file is part of the Free Pascal FCL library. 3 Copyright 2013 Mario Ray Mahardhika 4 5 Implements a generic Tree. 6 7 See the file COPYING.FPC, included in this distribution, 8 for details about the copyright. 9 10 This program is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY;without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 13 14**********************************************************************} 15unit gtree; 16 17{$mode objfpc}{$H+} 18 19interface 20 21uses 22 gvector,gstack,gqueue; 23 24type 25 26 { TTreeNode } 27 28 generic TTreeNode<T> = class 29 public type 30 TTreeNodeList = specialize TVector<TTreeNode>; 31 protected 32 FData: T; 33 FChildren: TTreeNodeList; 34 public 35 constructor Create; 36 constructor Create(const AData: T); 37 destructor Destroy; override; 38 property Data: T read FData write FData; 39 property Children: TTreeNodeList read FChildren; 40 end; 41 42 generic TDepthFirstCallback<T> = procedure (const AData: T); 43 generic TBreadthFirstCallback<T> = procedure (const AData: T); 44 45 generic TTree<T> = class 46 public type 47 TTreeNodeType = specialize TTreeNode<T>; 48 TDepthFirstCallbackType = specialize TDepthFirstCallback<T>; 49 TBreadthFirstCallbackType = specialize TBreadthFirstCallback<T>; 50 private type 51 type 52 TStackType = specialize TStack<TTreeNodeType>; 53 TQueueType = specialize TQueue<TTreeNodeType>; 54 private 55 FRoot: TTreeNodeType; 56 public 57 constructor Create; 58 destructor Destroy; override; 59 procedure DepthFirstTraverse(Callback: TDepthFirstCallbackType); 60 procedure BreadthFirstTraverse(Callback: TBreadthFirstCallbackType); 61 property Root: TTreeNodeType read FRoot write FRoot; 62 end; 63 64implementation 65 66 67{ TTreeNode } 68 69constructor TTreeNode.Create; 70begin 71 FChildren := TTreeNodeList.Create; 72end; 73 74constructor TTreeNode.Create(const AData: T); 75begin 76 FData := AData; 77 FChildren := TTreeNodeList.Create; 78end; 79 80destructor TTreeNode.Destroy; 81var 82 Child: TTreeNode; 83begin 84 for Child in FChildren do begin 85 Child.Free; 86 end; 87 FChildren.Free; 88end; 89 90{ TTree } 91 92constructor TTree.Create; 93begin 94 FRoot := nil; 95end; 96 97destructor TTree.Destroy; 98begin 99 FRoot.Free; 100end; 101 102procedure TTree.DepthFirstTraverse(Callback: TDepthFirstCallbackType); 103var 104 Stack: TStackType; 105 Node,Child: TTreeNodeType; 106begin 107 if Assigned(FRoot) then begin 108 Stack := TStackType.Create; 109 Stack.Push(FRoot); 110 while Stack.Size > 0 do begin 111 Node := Stack.Top; 112 Stack.Pop; 113 Callback(Node.Data); 114 for Child in Node.Children do Stack.Push(Child); 115 end; 116 Stack.Free; 117 end; 118end; 119 120procedure TTree.BreadthFirstTraverse(Callback: TBreadthFirstCallbackType); 121var 122 Queue: TQueueType; 123 Node,Child: TTreeNodeType; 124begin 125 if Assigned(FRoot) then begin 126 Queue := TQueueType.Create; 127 Queue.Push(FRoot); 128 while Queue.Size > 0 do begin 129 Node := Queue.Front; 130 Queue.Pop; 131 Callback(Node.Data); 132 for Child in Node.Children do Queue.Push(Child); 133 end; 134 Queue.Free; 135 end; 136end; 137 138end. 139