/packages/fcl-stl/src/gtree.pp

  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