* Added generic tree from Mario Ray Mahardhika (bug ID 33654)

git-svn-id: trunk@23453 -

.gitattributes

@@ -2611,6 +2611,7 @@ packages/fcl-stl/src/gpriorityqueue.pp svneol=native#text/plain
 packages/fcl-stl/src/gqueue.pp svneol=native#text/plain
 packages/fcl-stl/src/gset.pp svneol=native#text/plain
 packages/fcl-stl/src/gstack.pp svneol=native#text/plain
+packages/fcl-stl/src/gtree.pp svneol=native#text/plain
 packages/fcl-stl/src/gutil.pp svneol=native#text/plain
 packages/fcl-stl/src/gvector.pp svneol=native#text/plain
 packages/fcl-stl/tests/clean svneol=native#text/plain
@@ -2626,6 +2627,7 @@ packages/fcl-stl/tests/gqueuetest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gsetrefcounttest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gsettest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gstacktest.pp svneol=native#text/plain
+packages/fcl-stl/tests/gtreetest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gvectortest.pp svneol=native#text/plain
 packages/fcl-stl/tests/run-all-tests svneol=native#text/plain
 packages/fcl-stl/tests/suiteconfig.pp svneol=native#text/plain

packages/fcl-stl/fpmake.pp

@@ -47,6 +47,7 @@ begin
           AddUnit('gdeque');
         end;
     T:=P.Targets.AddUnit('gset.pp');
+    T:=P.Targets.AddUnit('gtree.pp');
     T:=P.Targets.AddUnit('gstack.pp');
       with T.Dependencies do
         begin

packages/fcl-stl/src/gtree.pp

@@ -0,0 +1,139 @@
+{
+   This file is part of the Free Pascal FCL library.
+   Copyright 2013 Mario Ray Mahardhika
+ 
+   Implements a generic Tree.
+ 
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+unit gtree;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  gvector,gstack,gqueue;
+
+type
+
+  { TTreeNode }
+
+  generic TTreeNode<T> = class
+  public type
+    TTreeNodeList = specialize TVector<TTreeNode>;
+  protected
+    FData: T;
+    FChildren: TTreeNodeList;
+  public
+    constructor Create;
+    constructor Create(const AData: T);
+    destructor Destroy; override;
+    property Data: T read FData write FData;
+    property Children: TTreeNodeList read FChildren;
+  end;
+
+  generic TDepthFirstCallback<T> = procedure (const AData: T);
+  generic TBreadthFirstCallback<T> = procedure (const AData: T);
+
+  generic TTree<T> = class
+  public type
+    TTreeNodeType = specialize TTreeNode<T>;
+    TDepthFirstCallbackType = specialize TDepthFirstCallback<T>;
+    TBreadthFirstCallbackType = specialize TBreadthFirstCallback<T>;
+  private type
+  type
+    TStackType = specialize TStack<TTreeNodeType>;
+    TQueueType = specialize TQueue<TTreeNodeType>;
+  private
+    FRoot: TTreeNodeType;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure DepthFirstTraverse(Callback: TDepthFirstCallbackType);
+    procedure BreadthFirstTraverse(Callback: TBreadthFirstCallbackType);
+    property Root: TTreeNodeType read FRoot write FRoot;
+  end;
+
+implementation
+
+
+{ TTreeNode }
+
+constructor TTreeNode.Create;
+begin
+  FChildren := TTreeNodeList.Create;
+end;
+
+constructor TTreeNode.Create(const AData: T);
+begin
+  FData := AData;
+  FChildren := TTreeNodeList.Create;
+end;
+
+destructor TTreeNode.Destroy;
+var
+  Child: TTreeNode;
+begin
+  for Child in FChildren do begin
+    Child.Free;
+  end;
+  FChildren.Free;
+end;
+
+{ TTree }
+
+constructor TTree.Create;
+begin
+  FRoot := nil;
+end;
+
+destructor TTree.Destroy;
+begin
+  FRoot.Free;
+end;
+
+procedure TTree.DepthFirstTraverse(Callback: TDepthFirstCallbackType);
+var
+  Stack: TStackType;
+  Node,Child: TTreeNodeType;
+begin
+  if Assigned(FRoot) then begin
+    Stack := TStackType.Create;
+    Stack.Push(FRoot);
+    while Stack.Size > 0 do begin
+      Node := Stack.Top;
+      Stack.Pop;
+      Callback(Node.Data);
+      for Child in Node.Children do Stack.Push(Child);
+    end;
+    Stack.Free;
+  end;
+end;
+
+procedure TTree.BreadthFirstTraverse(Callback: TBreadthFirstCallbackType);
+var
+  Queue: TQueueType;
+  Node,Child: TTreeNodeType;
+begin
+  if Assigned(FRoot) then begin
+    Queue := TQueueType.Create;
+    Queue.Push(FRoot);
+    while Queue.Size > 0 do begin
+      Node := Queue.Front;
+      Queue.Pop;
+      Callback(Node.Data);
+      for Child in Node.Children do Queue.Push(Child);
+    end;
+    Queue.Free;
+  end;
+end;
+
+end.
+

packages/fcl-stl/tests/gtreetest.pp

@@ -0,0 +1,50 @@
+program gtreetest;
+
+{$mode objfpc}{$H+}
+
+uses
+  gtree;
+
+procedure WriteIntegerCallback(const i: Integer);
+begin
+  Write(i,' ');
+end;
+
+type
+  TIntegerTreeNode = specialize TTreeNode<Integer>;
+  TIntegerTree = specialize TTree<Integer>;
+var
+  Tree: TIntegerTree;
+  Node,Tmp: TIntegerTreeNode;
+  i: Integer;
+begin
+  Node := TIntegerTreeNode.Create(0);
+  for i := 1 to 3 do begin
+    Tmp := TIntegerTreeNode.Create(i);
+    Node.Children.PushBack(Tmp);
+  end;
+  Tmp := Node;
+  Node := TIntegerTreeNode.Create(4);
+  Node.Children.PushBack(Tmp);
+  for i := 5 to 7 do begin
+    Tmp := TIntegerTreeNode.Create(i);
+    Node.Children.PushBack(Tmp);
+  end;
+  Tmp := Node;
+  Node := TIntegerTreeNode.Create(8);
+  Node.Children.PushBack(Tmp);
+  for i := 9 to 10 do begin
+    Tmp := TIntegerTreeNode.Create(i);
+    Node.Children.PushBack(Tmp);
+  end;
+
+  Tree := TIntegerTree.Create;
+  Tree.Root := Node;
+
+  WriteLn('Depth first:');
+  Tree.DepthFirstTraverse(@WriteIntegerCallback);WriteLn;
+  WriteLn('Breadth first:');
+  Tree.BreadthFirstTraverse(@WriteIntegerCallback);WriteLn;
+
+  Tree.Free;
+end.