From e7d629c667704f3247ebcd9cae32bc5db5e892dc Mon Sep 17 00:00:00 2001
From: michael <michael@3ad0048d-3df7-0310-abae-a5850022a9f2>
Date: Sun, 20 Jan 2013 10:09:48 +0000
Subject: * Added generic tree from Mario Ray Mahardhika (bug ID 33654)

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@23453 3ad0048d-3df7-0310-abae-a5850022a9f2
---
 packages/fcl-stl/fpmake.pp          |   1 +
 packages/fcl-stl/src/gtree.pp       | 139 ++++++++++++++++++++++++++++++++++++
 packages/fcl-stl/tests/gtreetest.pp |  50 +++++++++++++
 3 files changed, 190 insertions(+)
 create mode 100755 packages/fcl-stl/src/gtree.pp
 create mode 100755 packages/fcl-stl/tests/gtreetest.pp

(limited to 'packages/fcl-stl')

diff --git a/packages/fcl-stl/fpmake.pp b/packages/fcl-stl/fpmake.pp
index e63407481d..0df8b2a452 100644
--- a/packages/fcl-stl/fpmake.pp
+++ b/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
diff --git a/packages/fcl-stl/src/gtree.pp b/packages/fcl-stl/src/gtree.pp
new file mode 100755
index 0000000000..cc94625430
--- /dev/null
+++ b/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.
+
diff --git a/packages/fcl-stl/tests/gtreetest.pp b/packages/fcl-stl/tests/gtreetest.pp
new file mode 100755
index 0000000000..b026b97d59
--- /dev/null
+++ b/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.
-- 
cgit v1.2.1