{$I main.inc}
unit tree;

interface

uses
  constants, ComCtrls;
type
  TDataObject = Integer;

  TNode = class
    parent: TNode;
    child: TNode;
    sibling: TNode;
  private
  public
    data: TDataObject;
    size: Integer;
    outdegree: Integer;
    level: Integer;
    height: Integer;
    index: Integer;
    tag: Integer;
    constructor create(d: TDataObject);
    function toString: xString;
  end;

  TWalkFunction = function (node: TNode): boolean;

  TTree = class
    root: TNode;
//    forrest: array of TNode;
  private
  public
    constructor create(rootnode: TNode);
    destructor Destroy; override;
    function addChild(node,ch: TNode): boolean;
    function addSibling(node,s: TNode): boolean;
    function calculateSizeInSubTree(root: TNode; startnum: Integer): boolean;
    function calculateLevelsInSubTree(node: TNode): boolean;
    function calculateHeightInSubTree(node: TNode): boolean;
    function preorderWalk(root: TNode; func: TWalkFunction): boolean;
    function postorderWalk(root: TNode; func: TWalkFunction): boolean;
    function postorderSafeWalk(root: TNode; func: TWalkFunction): boolean;
    function preorderlistSubTreeInTreeView(root: TNode; view: TTreeView; viewroot: TTreeNode): boolean;
    function preorderfillSubTreeToArray(root: TNode; var a: array of TNode): boolean;

    function destroyNode(node: TNode): boolean;         //TWalkFunction
    function listNode(node: TNode): boolean;            //TWalkFunction
    function listindentedNode(node: TNode): boolean;    //TWalkFunction

    function destroySubTree(root: TNode): boolean;
    function listSubTree(root: TNode): boolean;
    function listindentedSubTree(root: TNode): boolean;

    function getSize: Integer;
  end;

implementation

uses
  SysUtils;

function WF_destroyNode(node: TNode): boolean;          //TWalkFunction
begin
  node.free;
  result := true;
end;

function WF_listNode(node: TNode): boolean;             //TWalkFunction
begin
  //ShowMessage(IntToStr(node.data));
{$IFDEF DEBUG2}
  writeln(node.toString);
{$ENDIF}
  result := true;
end;

function WF_listindentedNode(node: TNode): boolean;     //TWalkFunction
{$IFDEF DEBUG2}
var i: Integer;
{$ENDIF}
begin
{$IFDEF DEBUG2}
  i := 0;
  while (i < node.level) do begin
    write('|');
    i := i + 1;
  end;
{$ENDIF}
  result := WF_listNode(node);
end;

function WF_level(node: TNode): boolean;             //TWalkFunction
begin
  if (node.parent = nil) then
    node.level := 0
  else
    node.level := node.parent.level + 1;
  result := true;
end;

function WF_height(node: TNode): boolean;             //TWalkFunction
begin
  if (node.child = nil) then
    node.height := 0
  else
    node.height := node.child.height + 1;
  result := true;
end;

constructor TNode.create(d: TDataObject);
begin
  inherited create;
  data := d;
  size := 1;
  outdegree := 0;  //size of the child's sibling list
  level := 0;
  height := 0;
  index := -1;
  tag := -1;
end;

function TNode.toString: xString;
begin
  result := IntToStr(data);
end;

constructor TTree.create(rootnode: TNode);
begin
  inherited create;
  root := rootnode;
end;

destructor TTree.destroy;
begin
  destroySubTree(root);
  inherited destroy;
end;

function TTree.addChild(node,ch: TNode): boolean;
begin
  addChild := true;
  if (ch = nil) then begin
    addChild := false;
  end
  else if (node.child = nil) then begin
    node.child := ch;
    node.child.parent := node;
    node.outdegree := node.outdegree + 1;
    node.size := node.size + node.child.size;
  end
  else begin
    addSibling(node.child,ch);
  end;
end;

function TTree.addSibling(node,s: TNode): boolean;
var currentNode: TNode;
begin
  addSibling := true;
  if (s = nil) then begin
    addSibling := false;
  end
  else if (node.sibling = nil) then begin
    node.sibling := s;
    node.sibling.parent := node.parent;
    if (node.parent <> nil) then  //if not root (building forest)
      node.parent.outdegree := node.parent.outdegree + 1;
    node.size := node.size + node.sibling.size;
  end
  else begin
    currentNode := node.sibling;
    while (currentNode.sibling <> nil) do
      currentNode := node.sibling;
    addSibling := addSibling(currentNode,s);
  end;
end;

function TTree.calculateLevelsInSubTree(node: TNode):boolean;
begin
  result := preorderWalk(root,WF_level);
end;

function TTree.calculateHeightInSubTree(node: TNode):boolean;
begin
  result := postorderWalk(root,WF_height);
end;

function TTree.calculateSizeInSubTree(root: TNode; startnum: Integer): boolean;
var TempIndex: Integer;
  function calc(node: TNode; start: Integer): boolean;
  begin
    if (node <> nil) then begin
      repeat
        node.index := TempIndex;
        TempIndex := TempIndex + 1;
        result := calc(node.child,start);
        node.size := TempIndex - node.index;
        node := node.sibling;
      until ((node = nil) or not result);
    end
    else
      result := true;
  end;
begin
  TempIndex := startnum;
  result := calc(root,startnum);
end;

function TTree.destroyNode(node: TNode): boolean;
begin
  result := WF_destroyNode(node);
end;

function TTree.destroySubTree(root: TNode): boolean;
begin
  result := postorderSafeWalk(root,WF_destroyNode);//@TTree.destroyNode);
end;

function TTree.preorderWalk(root: TNode; func: TWalkFunction): boolean;
begin
  if (root <> nil) then begin
    repeat
        result := func(root);
        if (result) then
          result := preorderWalk(root.child,func);
        root := root.sibling;
    until ((root = nil) or not result);
  end
  else
    result := true;
end;

function TTree.postorderWalk(root: TNode; func: TWalkFunction): boolean;
begin
  if (root <> nil) then begin
    repeat
        result := postorderWalk(root.child,func);
        if (result) then
          result := func(root);
        root := root.sibling;
    until ((root = nil) or not result);
  end
  else
    result := true;
end;

function TTree.postorderSafeWalk(root: TNode; func: TWalkFunction): boolean;
var TempNode: TNode;
begin
  if (root <> nil) then begin
    repeat
        result := postorderSafeWalk(root.child,func);
        TempNode := root.sibling;
        if (result) then
          result := func(root);
        root := TempNode;
    until ((root = nil) or not result);
  end
  else
    result := true;
end;

function TTree.listNode(node: TNode): boolean;
begin
  result := WF_listNode(node);
end;

function TTree.listindentedNode(node: TNode): boolean;
begin
  result := WF_listindentedNode(node);
end;

function TTree.listSubTree(root: TNode): boolean;
begin
  listSubTree := preorderWalk(root,WF_listNode);//@TTree.listNode);
end;

function TTree.listindentedSubTree(root: TNode): boolean;
begin
  calculateLevelsInSubTree(root);
  listindentedSubTree := preorderWalk(root,WF_listindentedNode);//@TTree.listindentedNode);
end;

function TTree.preorderlistSubTreeInTreeView(root: TNode; view: TTreeView; viewroot: TTreeNode): boolean;
begin
  if (root <> nil) then begin
    repeat
        result := preorderlistSubTreeInTreeView(root.child,view,view.Items.AddChild(viewroot,root.toString));
        root := root.sibling;
    until ((root = nil) or not result);
  end
  else
    result := true;
end;

function TTree.preorderfillSubTreeToArray(root: TNode; var a: array of TNode): boolean;
var TempIndex: Integer;
    //b: array of TNode;
  function fill(node: TNode; var a: array of TNode): boolean;
  begin
    if (node <> nil) then begin
      repeat
        a[TempIndex] := node;    
        TempIndex := TempIndex + 1;
        result := fill(node.child,a);
        node := node.sibling;
      until ((node = nil) or not result);
    end
    else
      result := true
  end;
begin
  TempIndex := 0;
  result := fill(root,a);
end;

function TTree.getSize: Integer;
var TempNode: TNode;
begin
  calculateSizeInSubTree(root,0);
  result := 0;
  TempNode := root;
  repeat
    result := result + TempNode.size;
    TempNode := TempNode.sibling;
  until (TempNode = nil);
end;

end.
